- added destroyed? component to the window-type for a better

recognition of window-destroyal. (should be done with all types)
This commit is contained in:
frese 2002-04-26 08:26:59 +00:00
parent 2db54b1c37
commit 0043252da4
1 changed files with 7 additions and 7 deletions

View File

@ -1,10 +1,11 @@
;; the window-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; the window-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type window :window (define-record-type window :window
(really-make-window tag Xwindow display) (really-make-window tag Xwindow display destroyed?)
window? window?
(tag window-tag window-set-tag!) (tag window-tag window-set-tag!)
(Xwindow real-window-Xwindow window-set-Xwindow!) (Xwindow real-window-Xwindow window-set-Xwindow!)
(destroyed? window-destroyed? window-set-destroyed?!)
(display window-display window-set-display!)) (display window-display window-set-display!))
(define (window-Xwindow window) (define (window-Xwindow window)
@ -22,7 +23,7 @@
(let ((maybe-window (window-list-find Xwindow))) (let ((maybe-window (window-list-find Xwindow)))
(if maybe-window (if maybe-window
maybe-window maybe-window
(let ((window (really-make-window #f Xwindow display))) (let ((window (really-make-window #f Xwindow display #f)))
(if finalize? (if finalize?
(add-finalizer! window destroy-window) (add-finalizer! window destroy-window)
(add-finalizer! window window-list-delete!)) (add-finalizer! window window-list-delete!))
@ -57,11 +58,10 @@
(define (destroy-window window) (define (destroy-window window)
(let ((Xdisplay (display-Xdisplay (window-display window))) (let ((Xdisplay (display-Xdisplay (window-display window)))
(Xwindow (window-Xwindow window))) (Xwindow (window-Xwindow window)))
(if (integer? Xwindow)
(begin
(window-list-delete! window) (window-list-delete! window)
(%destroy-window Xdisplay Xwindow) (if (not (window-destroyed? window))
(window-set-Xwindow! window 'already-destroyed))))) (%destroy-window Xdisplay Xwindow))
(window-set-destroyed?! window #t)))
(import-lambda-definition %destroy-window (Xdisplay Xwindow) (import-lambda-definition %destroy-window (Xdisplay Xwindow)
"scx_Destroy_Window") "scx_Destroy_Window")