changed the constructors and finalizers, so that only one finalizer is

needed for each object.
This commit is contained in:
frese 2001-08-21 14:51:22 +00:00
parent f1db98896b
commit 892ed92b61
7 changed files with 24 additions and 16 deletions

View File

@ -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)))))

View File

@ -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)))))

View File

@ -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.

View File

@ -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)))

View File

@ -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)))))

View File

@ -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)))))

View File

@ -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)))))