From 892ed92b6141af5107fe2a2b20e8151a3dca3229 Mon Sep 17 00:00:00 2001 From: frese Date: Tue, 21 Aug 2001 14:51:22 +0000 Subject: [PATCH] changed the constructors and finalizers, so that only one finalizer is needed for each object. --- scheme/xlib/colormap-type.scm | 5 +++-- scheme/xlib/cursor-type.scm | 5 +++-- scheme/xlib/display-type.scm | 8 +++++--- scheme/xlib/font-type.scm | 8 +++++--- scheme/xlib/gcontext-type.scm | 5 +++-- scheme/xlib/pixmap-type.scm | 5 +++-- scheme/xlib/window-type.scm | 4 ++-- 7 files changed, 24 insertions(+), 16 deletions(-) diff --git a/scheme/xlib/colormap-type.scm b/scheme/xlib/colormap-type.scm index 1aa6a11..65237a5 100644 --- a/scheme/xlib/colormap-type.scm +++ b/scheme/xlib/colormap-type.scm @@ -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))))) diff --git a/scheme/xlib/cursor-type.scm b/scheme/xlib/cursor-type.scm index 2bf9063..f4e9c45 100644 --- a/scheme/xlib/cursor-type.scm +++ b/scheme/xlib/cursor-type.scm @@ -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))))) diff --git a/scheme/xlib/display-type.scm b/scheme/xlib/display-type.scm index fa12ae0..d987e96 100644 --- a/scheme/xlib/display-type.scm +++ b/scheme/xlib/display-type.scm @@ -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. diff --git a/scheme/xlib/font-type.scm b/scheme/xlib/font-type.scm index d6c01d0..3f90adf 100644 --- a/scheme/xlib/font-type.scm +++ b/scheme/xlib/font-type.scm @@ -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))) diff --git a/scheme/xlib/gcontext-type.scm b/scheme/xlib/gcontext-type.scm index a54c92a..910b7ff 100644 --- a/scheme/xlib/gcontext-type.scm +++ b/scheme/xlib/gcontext-type.scm @@ -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))))) diff --git a/scheme/xlib/pixmap-type.scm b/scheme/xlib/pixmap-type.scm index 353c911..f1bcfb9 100644 --- a/scheme/xlib/pixmap-type.scm +++ b/scheme/xlib/pixmap-type.scm @@ -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))))) diff --git a/scheme/xlib/window-type.scm b/scheme/xlib/window-type.scm index 953114e..b6d49b9 100644 --- a/scheme/xlib/window-type.scm +++ b/scheme/xlib/window-type.scm @@ -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)))))