scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added the finalize? parameter to the constructor definitions.

This commit is contained in:
frese 2001-07-19 15:21:09 +00:00
parent 2df0598273
commit 122b2b4397
6 changed files with 53 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scheme/xlib/colormap-type.scm
View File

@ -12,26 +12,19 @@
none-resource
(real-colormap-Xcolormap colormap)))
(define (make-colormap Xcolormap display)
(define (make-colormap Xcolormap display finalize?)
(if (none-resource? Xcolormap)
'none
(let ((maybe-colormap (colormap-list-find Xcolormap)))
(if maybe-colormap
maybe-colormap
(let ((colormap (really-make-colormap #f Xcolormap display)))
(add-finalizer! colormap finalize-colormap)
(add-finalizer! colormap colormap-list-delete!)
(if finalize?
(add-finalizer! colormap free-colormap))
(colormap-list-set! Xcolormap colormap)
colormap)))))
;; finalize-colormap is called, when the garbage collector removes the last
;; reference to the colormap from the heap. Then we can savely close the
;; colormap and remove the weak-pointer from our list.
(define (finalize-colormap colormap)
(let ((Xcolormap (colormap-Xcolormap colormap)))
(free-colormap colormap)
(colormap-list-delete! Xcolormap)))
(define (free-colormap colormap)
(let ((Xcolormap (colormap-Xcolormap)))
(if (integer? Xcolormap)
@ -58,6 +51,7 @@
(let ((p (make-weak-pointer colormap)))
(table-set! *weak-colormap-list* Xcolormap p)))
(define (colormap-list-delete! Xcolormap)
(table-set! *weak-colormap-list* Xcolormap #f))
(define (colormap-list-delete! colormap)
(table-set! *weak-colormap-list*
(colormap-Xcolormap colormap) #f))

20
scheme/xlib/display-type.scm
View File

@ -6,24 +6,17 @@
(after-function display-after-function display-set-after-function!)
(Xdisplay display-Xdisplay display-set-Xdisplay!))
(define (make-display Xdisplay)
(define (make-display Xdisplay finalize?)
(let ((maybe-display (display-list-find Xdisplay)))
(if maybe-display
maybe-display
(let ((display (really-make-display #f Xdisplay)))
(add-finalizer! display finalize-display)
(add-finalizer! display display-list-delete!)
(if finalize?
(add-finalizer! display close-display))
(display-list-set! Xdisplay display)
display))))
;; finalize-display is called, when the garbage collector removes the last
;; reference to the display from the heap. Then we can savely close the display
;; and remove the weak-pointer from our list.
(define (finalize-display display)
(let ((Xdisplay (display-Xdisplay display)))
(close-display display)
(display-list-delete! Xdisplay)))
;; close-display closes the corresponding Xlib-display struct, by calling a
;; c-function and marks the scheme-record to be invalid (with the
;; 'already-closed symbol). Calling close-display more than once has no
@ -54,8 +47,9 @@
(let ((p (make-weak-pointer display)))
(table-set! *weak-display-list* Xdisplay p)))
(define (display-list-delete! Xdisplay)
(table-set! *weak-display-list* Xdisplay #f))
(define (display-list-delete! display)
(table-set! *weak-display-list*
(display-Xdisplay display) #f))
;; The message port is used to efficiently check for pending messages, which
;; are then read normally with XNextEvent.

28
scheme/xlib/font-type.scm
View File

@ -9,17 +9,22 @@
;; creates a font object. name can be #f. if Xfont is #f then it is obtained
;; from the Xfontstruct.
(define (make-font name Xfont Xfontstruct display)
(define (make-font name Xfont Xfontstruct display finalize?)
(let ((maybe-font (font-list-find Xfontstruct)))
(if maybe-font
maybe-font
(let* ((Xfont (if Xfont Xfont
(%Get_Xfont Xfontstruct)))
(font (really-make-font name Xfont Xfontstruct display)))
(add-finalizer! font unload-font)
(add-finalizer! font font-list-delete!)
(if finalize?
(add-finalizer! font unload-font))
(font-list-set! Xfontstruct font)
font))))
(import-lambda-definition %Get_Xfont (Xfontstruct)
"Get_Xfont")
;; load-font loads a font by its name. See XLoadQueryFont.
(define (load-font display font-name)
@ -27,7 +32,7 @@
(if (symbol? font-name)
(symbol->string font-name)
font-name))))
(make-font font-name #f Xfontstruct display)))
(make-font font-name #f Xfontstruct display #t)))
(import-lambda-definition %load-font (Xdisplay font_name)
"Load_Font")
@ -45,8 +50,8 @@
(if (integer? Xfontstruct)
(%free-font Xdisplay Xfontstruct))
(font-set-Xfontstruct! font 'already-freed)
(font-set-Xfont! font 'already-freed)
(font-list-delete! Xfont)))
(font-set-Xfont! font 'already-freed)))
;; for compatibility with Elk:
(define close-font unload-font)
@ -63,15 +68,16 @@
(define *weak-font-list* (make-integer-table))
(define (font-list-find Xfont)
(let ((r (table-ref *weak-font-list* Xfont)))
(define (font-list-find Xfontstruct)
(let ((r (table-ref *weak-font-list* Xfontstruct)))
(if r
(weak-pointer-ref r)
r)))
(define (font-list-set! Xfont font)
(define (font-list-set! Xfontstruct font)
(let ((p (make-weak-pointer font)))
(table-set! *weak-font-list* Xfont p)))
(table-set! *weak-font-list* Xfontstruct p)))
(define (font-list-delete! Xfont)
(table-set! *weak-font-list* Xfont #f))
(define (font-list-delete! font)
(table-set! *weak-font-list*
(font-Xfontstruct font) #f))

20
scheme/xlib/gcontext-type.scm
View File

@ -10,26 +10,19 @@
0
(real-gcontext-Xgcontext gcontext)))
(define (make-gcontext Xgcontext display)
(define (make-gcontext Xgcontext display finalize?)
(if (= 0 Xgcontext)
none-resource
(let ((maybe-gcontext (gcontext-list-find Xgcontext)))
(if maybe-gcontext
maybe-gcontext
(let ((gcontext (really-make-gcontext #f Xgcontext display)))
(add-finalizer! gcontext finalize-gcontext)
(add-finalizer! gcontext gcontext-list-delete!)
(if finalize?
(add-finalizer! gcontext free-gcontext))
(gcontext-list-set! Xgcontext gcontext)
gcontext)))))
;; finalize-gcontext is called, when the garbage collector removes the last
;; reference to the gcontext from the heap. Then we can savely close the
;; gcontext and remove the weak-pointer from our list.
(define (finalize-gcontext gcontext)
(let ((Xgcontext (gcontext-Xgcontext gcontext)))
(gcontext-set-Xgcontext! gcontext 'already-freed)
(gcontext-list-delete! Xgcontext)))
;; to free the gcontext X-lib ressources call free-gcontext. if gcontext is
;; already freed, the function does nothing.
@ -59,5 +52,6 @@
(let ((p (make-weak-pointer gcontext)))
(table-set! *weak-gcontext-list* Xgcontext p)))
(define (gcontext-list-delete! Xgcontext)
(table-set! *weak-gcontext-list* Xgcontext #f))
(define (gcontext-list-delete! gcontext)
(table-set! *weak-gcontext-list*
(gcontext-Xgcontext gcontext) #f))

20
scheme/xlib/pixmap-type.scm
View File

@ -12,26 +12,19 @@
0
(real-pixmap-Xpixmap pixmap)))
(define (make-pixmap Xpixmap display)
(define (make-pixmap Xpixmap display finalize?)
(if (= 0 Xpixmap)
none-resource
(let ((maybe-pixmap (pixmap-list-find Xpixmap)))
(if maybe-pixmap
maybe-pixmap
(let ((pixmap (really-make-pixmap #f Xpixmap display)))
(add-finalizer! pixmap finalize-pixmap)
(add-finalizer! pixmap pixmap-list-delete!)
(if finalize?
(add-finalizer! pixmap free-pixmap))
(pixmap-list-set! Xpixmap pixmap)
pixmap)))))
;; finalize-pixmap is called, when the garbage collector removes the last
;; reference to the pixmap from the heap. Then we can savely close the pixmap
;; and remove the weak-pointer from our list.
(define (finalize-pixmap pixmap)
(let ((Xpixmap (pixmap-Xpixmap pixmap)))
(free-pixmap pixmap)
(pixmap-list-delete! Xpixmap)))
;; ...
(define (free-pixmap pixmap)
@ -60,5 +53,6 @@
(let ((p (make-weak-pointer pixmap)))
(table-set! *weak-pixmap-list* Xpixmap p)))
(define (pixmap-list-delete! Xpixmap)
(table-set! *weak-pixmap-list* Xpixmap #f))
(define (pixmap-list-delete! pixmap)
(table-set! *weak-pixmap-list*
(pixmap-Xpixmap pixmap) #f))

22
scheme/xlib/window-type.scm
View File

@ -12,28 +12,19 @@
0
(real-window-Xwindow window)))
(define (make-window Xwindow display)
(define (make-window Xwindow display finalize?)
(if (= 0 Xwindow)
none-resource
(let ((maybe-window (window-list-find Xwindow)))
(if maybe-window
maybe-window
(let ((window (really-make-window #f Xwindow display)))
(add-finalizer! window finalize-window)
(add-finalizer! window window-list-delete!)
(if finalize?
(add-finalizer! window destroy-window))
(window-list-set! Xwindow window)
window)))))
;; finalize-window is called, when the garbage collector removes the last
;; reference to the window from the heap. Then we can savely close the window
;; and remove the weak-pointer from our list.
(define (finalize-window window)
(let ((Xwindow (window-Xwindow window)))
(destroy-window window)
(window-list-delete! Xwindow)))
;; The destroy-window function destroys the specified window as well as all of
;; its subwindows and causes the X server to generate a destroy-notify event for
;; each window. See XDestroyWindow
@ -64,6 +55,7 @@
(let ((p (make-weak-pointer window)))
(table-set! *weak-window-list* Xwindow p)))
(define (window-list-delete! Xwindow)
(table-set! *weak-window-list* Xwindow #f))
(define (window-list-delete! window)
(table-set! *weak-window-list*
(window-Xwindow window) #f))