changed the constructors and finalizers, so that only one finalizer is
needed for each object.
This commit is contained in:
parent
f1db98896b
commit
892ed92b61
|
@ -19,9 +19,9 @@
|
|||
(if maybe-colormap
|
||||
maybe-colormap
|
||||
(let ((colormap (really-make-colormap #f Xcolormap display)))
|
||||
(add-finalizer! colormap colormap-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! colormap free-colormap))
|
||||
(add-finalizer! colormap free-colormap)
|
||||
(add-finalizer! colormap colormap-list-delete!))
|
||||
(colormap-list-set! Xcolormap colormap)
|
||||
colormap)))))
|
||||
|
||||
|
@ -29,6 +29,7 @@
|
|||
(let ((Xcolormap (colormap-Xcolormap colormap)))
|
||||
(if (integer? Xcolormap)
|
||||
(begin
|
||||
(colormap-list-delete! colormap)
|
||||
(%free-colormap Xcolormap
|
||||
(display-Xdisplay (colormap-display colormap)))
|
||||
(colormap-set-Xcolormap! colormap 'already-freed)))))
|
||||
|
|
|
@ -17,9 +17,9 @@
|
|||
(if maybe-cursor
|
||||
maybe-cursor
|
||||
(let ((cursor (really-make-cursor #f Xcursor display)))
|
||||
(add-finalizer! cursor cursor-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! cursor free-cursor))
|
||||
(add-finalizer! cursor free-cursor)
|
||||
(add-finalizer! cursor cursor-list-delete!))
|
||||
(cursor-list-set! Xcursor cursor)
|
||||
cursor)))))
|
||||
|
||||
|
@ -30,6 +30,7 @@
|
|||
(Xcursor (cursor-Xcursor cursor)))
|
||||
(if (integer? Xcursor)
|
||||
(begin
|
||||
(cursor-list-delete! cursor)
|
||||
(%free-cursor Xdisplay Xcursor)
|
||||
(cursor-set-Xcursor! cursor 'already-destroyed)))))
|
||||
|
||||
|
|
|
@ -16,9 +16,9 @@
|
|||
(if maybe-display
|
||||
maybe-display
|
||||
(let ((display (really-make-display #f Xdisplay)))
|
||||
(add-finalizer! display display-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! display close-display))
|
||||
(add-finalizer! display close-display)
|
||||
(add-finalizer! display display-list-delete!))
|
||||
(display-list-set! Xdisplay display)
|
||||
display))))
|
||||
|
||||
|
@ -33,10 +33,12 @@
|
|||
(begin
|
||||
(if (display-after-function display)
|
||||
((display-after-function display) display))
|
||||
(display-list-delete! display)
|
||||
(%close-display Xdisplay)
|
||||
(display-set-Xdisplay! display 'already-closed)))))
|
||||
|
||||
(import-lambda-definition %close-display (Xdisplay) "Close_Display")
|
||||
(import-lambda-definition %close-display (Xdisplay)
|
||||
"scx_Close_Display")
|
||||
|
||||
;; All display records need to be saved in a weak-list, to have only one record
|
||||
;; for the same Xlib display-structure in the heap.
|
||||
|
|
|
@ -21,9 +21,9 @@
|
|||
(let* ((Xfont (if Xfont Xfont
|
||||
(%Get_Xfont Xfontstruct)))
|
||||
(font (really-make-font name Xfont Xfontstruct display)))
|
||||
(add-finalizer! font font-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! font unload-font))
|
||||
(add-finalizer! font unload-font)
|
||||
(add-finalizer! font font-list-delete!))
|
||||
(font-list-set! Xfontstruct font)
|
||||
font))))
|
||||
|
||||
|
@ -53,7 +53,9 @@
|
|||
(let ((Xfontstruct (font-Xfontstruct font))
|
||||
(Xdisplay (display-Xdisplay (font-display font))))
|
||||
(if (integer? Xfontstruct)
|
||||
(%free-font Xdisplay Xfontstruct))
|
||||
(begin
|
||||
(font-list-delete! font)
|
||||
(%free-font Xdisplay Xfontstruct)))
|
||||
(font-set-Xfontstruct! font 'already-freed)
|
||||
(font-set-Xfont! font 'already-freed)))
|
||||
|
||||
|
|
|
@ -17,9 +17,9 @@
|
|||
(if maybe-gcontext
|
||||
maybe-gcontext
|
||||
(let ((gcontext (really-make-gcontext #f Xgcontext display)))
|
||||
(add-finalizer! gcontext gcontext-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! gcontext free-gcontext))
|
||||
(add-finalizer! gcontext free-gcontext)
|
||||
(add-finalizer! gcontext gcontext-list-delete!))
|
||||
(gcontext-list-set! Xgcontext gcontext)
|
||||
gcontext)))))
|
||||
|
||||
|
@ -30,6 +30,7 @@
|
|||
(let ((Xgcontext (gcontext-Xgcontext gcontext)))
|
||||
(if (integer? Xgcontext)
|
||||
(begin
|
||||
(gcontext-list-delete! gcontext)
|
||||
(%free-gcontext Xgcontext
|
||||
(display-Xdisplay (gcontext-display gcontext)))
|
||||
(gcontext-set-Xgcontext! gcontext 'already-freed)))))
|
||||
|
|
|
@ -19,9 +19,9 @@
|
|||
(if maybe-pixmap
|
||||
maybe-pixmap
|
||||
(let ((pixmap (really-make-pixmap #f Xpixmap display)))
|
||||
(add-finalizer! pixmap pixmap-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! pixmap free-pixmap))
|
||||
(add-finalizer! pixmap free-pixmap)
|
||||
(add-finalizer! pixmap pixmap-list-delete!))
|
||||
(pixmap-list-set! Xpixmap pixmap)
|
||||
pixmap)))))
|
||||
|
||||
|
@ -32,6 +32,7 @@
|
|||
(Xpixmap (pixmap-Xpixmap pixmap)))
|
||||
(if (integer? Xpixmap)
|
||||
(begin
|
||||
(pixmap-list-delete! pixmap)
|
||||
(%free-pixmap Xdisplay Xpixmap)
|
||||
(pixmap-set-Xpixmap! pixmap 'already-destroyed)))))
|
||||
|
||||
|
|
|
@ -19,9 +19,9 @@
|
|||
(if maybe-window
|
||||
maybe-window
|
||||
(let ((window (really-make-window #f Xwindow display)))
|
||||
(add-finalizer! window window-list-delete!)
|
||||
(if finalize?
|
||||
(add-finalizer! window destroy-window))
|
||||
(add-finalizer! window destroy-window)
|
||||
(add-finalizer! window window-list-delete!))
|
||||
(window-list-set! Xwindow window)
|
||||
window)))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue