updated constructor calls to specify wheather the X-Lib Objects

should be freed.
This commit is contained in:
frese 2001-07-19 15:19:07 +00:00
parent 0a81d851b1
commit 2df0598273
6 changed files with 29 additions and 23 deletions

View File

@ -15,7 +15,7 @@
(let ((Xdisplay (%open-display display-name)))
(if (= Xdisplay 0)
(error "cannot open display" display-name)
(make-display Xdisplay)))))
(make-display Xdisplay #t)))))
(import-lambda-definition %open-display (name) "Open_Display")
@ -29,7 +29,7 @@
(define (display-default-root-window display)
(let* ((Xdisplay (display-Xdisplay display))
(Xwindow (%default-root-window Xdisplay)))
(make-window Xwindow (make-display Xdisplay))))
(make-window Xwindow (make-display Xdisplay) #f)))
;; for compatibility with Elk.
(define display-root-window display-default-root-window)
@ -43,7 +43,7 @@
(define (display-default-colormap display)
(let* ((Xdisplay (display-Xdisplay display))
(Xcolormap (%default-colormap Xdisplay)))
(make-colormap Xcolormap display)))
(make-colormap Xcolormap display #f)))
;; for compatibility with Elk.
(define display-colormap display-default-colormap)
@ -57,7 +57,7 @@
(define (display-default-gcontext display)
(let* ((Xdisplay (display-Xdisplay display))
(Xgcontext (%default-gcontext Xdisplay)))
(make-gcontext Xgcontext display)))
(make-gcontext Xgcontext display #f)))
(import-lambda-definition %default-gcontext (Xdisplay)
"Display_Default_Gcontext")

View File

@ -3,7 +3,7 @@
(Xfontstruct (%gcontext-font
(display-Xdisplay display)
(gcontext-Xgcontext gcontext))))
(make-font #f #f Xfontstruct display)))
(make-font #f #f Xfontstruct display #f)))
(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
"GContext_Font")
@ -26,7 +26,8 @@
(make-font (car name-Xfontstruct)
#f
(cdr name-Xfontstruct)
display))
display
#t))
v))))
(import-lambda-definition %list-fonts (Xdisplay pattern)

View File

@ -16,7 +16,7 @@
(Xdisplay (display-Xdisplay display))
(Xobject (drawable-Xobject drawable)))
(let ((Xgcontext (%create-gcontext Xdisplay Xobject rest)))
(make-gcontext Xgcontext display))))))
(make-gcontext Xgcontext display #t))))))
(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
"Create_Gc")

View File

@ -8,7 +8,7 @@
(let ((display (drawable-display drawable))
(pixmap (%create-pixmap (display-Xdisplay display)
(drawable-Xdrawable) widht height depth)))
(make-pixmap pixmap display)))
(make-pixmap pixmap display #t)))
(import-lambda-definition %create-pixmap (Xdisplay Xdrawable w h depth)
"Create_Pixmap")
@ -17,10 +17,10 @@
(define (create-bitmap-from-data window data width height)
(let ((display (window-display window))
(pixmap (%create-bitmap-from-data (display-Xdisplay display)
(Xpixmap (%create-bitmap-from-data (display-Xdisplay display)
(window-Xwindow window)
data width height)))
(make-pixmap pixmap display)))
(make-pixmap Xpixmap display #t)))
(import-lambda-definition %create-bitmap-from-data (Xdisplay Xdrawable data w h)
"Create_Bitmap_From_Data")
@ -34,7 +34,7 @@
(window-Xwindow window)
data widht height foregrnd
backgrd depth)))
(make-pixmap pixmap display)))
(make-pixmap pixmap display #t)))
(import-lambda-definition %create-pixmap-from-bitmap-data
@ -47,7 +47,7 @@
(let ((res (%read-bitmap-file (display-Xdisplay (drawable-display drawable))
(drawable-Xobject drawable)
filename)))
(set-car! res (make-pixmap (drawable-display drawable) (car res)))))
(set-car! res (make-pixmap (drawable-display drawable) (car res) #t))))
(import-lambda-definition %read-bitmap-file (Xdisplay Xdrawable file)
"Read_Bitmap_File")

View File

@ -116,7 +116,8 @@
(define (get-selection-owner display selection)
(make-window (%get-selection-owner (display-Xdisplay display)
(atom-Xatom selection))
display))
display
#f))
(import-lambda-definition %get-selection-owner (Xdisplay Xatom_s)

View File

@ -18,7 +18,7 @@
change-win-attr-list)))
(if (= Xwindow 0)
(error "cannot create window")
(make-window Xwindow display))))))
(make-window Xwindow display #t))))))
(import-lambda-definition %create-window (Xdisplay Xparent x y width height
border-width attrAlist)
@ -89,8 +89,12 @@
(mod-v (begin
(comp 13 make-pixel) ;; backing-pixel
(comp 7 (lambda (Xwin) ;; root
;; really this Display ??
(make-window Xwin (window-display window))))
(make-window Xwin (window-display window)
#f)))
(comp 15 (lambda (Xcolormap)
(make-colormap Xcolormap
(window-display window)
#f)))
;; font, visual ??
v))
(alist (map cons
@ -99,7 +103,7 @@
backing-planes backing-pixel save-under colormap
map-installed map-state all-event-masks
your-event-mask do-not-propagate-mask
override-redirect
override-redirect screen
; screen not supported
)
(vector->list mod-v))))
@ -265,10 +269,10 @@
(let* ((display (window-display window))
(res (%query-tree (window-Xwindow window)
(display-Xdisplay display))))
(list (make-window (first res) display)
(make-window (second res) display)
(list (make-window (first res) display #f)
(make-window (second res) display #f)
(vector-map! (lambda (Xwindow)
(make-window Xwindow display))
(make-window Xwindow display #f))
(third res)))))
(import-lambda-definition %query-tree (Xwindow Xdisplay)
@ -290,7 +294,7 @@
(if res
(list (first res)
(second res)
(make-window (third res) display))
(make-window (third res) display #f))
#f)))
(import-lambda-definition %translate-coordinates (Xdisplay srcXwindow x y
@ -310,10 +314,10 @@
(list (first res)
(second res)
(third res)
(make-window (fourth res) display)
(make-window (fourth res) display #f)
(fifth res)
(sixth res)
(make-window (seventh res) display)
(make-window (seventh res) display #f)
(eighth res))))
(import-lambda-definition %query-pointer (Xdisplay Xwindow)