Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv22876
Modified Files:
display.scm font.scm gcontext.scm pixmap.scm property.scm
window.scm
Log Message:
updated constructor calls to specify wheather the X-Lib Objects
should be freed.
Index: display.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/display.scm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** display.scm 2001/07/16 13:12:11 1.4
--- display.scm 2001/07/19 15:19:07 1.5
***************
*** 16,20 ****
(if (= Xdisplay 0)
(error "cannot open display" display-name)
! (make-display Xdisplay)))))
(import-lambda-definition %open-display (name) "Open_Display")
--- 16,20 ----
(if (= Xdisplay 0)
(error "cannot open display" display-name)
! (make-display Xdisplay #t)))))
(import-lambda-definition %open-display (name) "Open_Display")
***************
*** 30,34 ****
(let* ((Xdisplay (display-Xdisplay display))
(Xwindow (%default-root-window Xdisplay)))
! (make-window Xwindow (make-display Xdisplay))))
;; for compatibility with Elk.
--- 30,34 ----
(let* ((Xdisplay (display-Xdisplay display))
(Xwindow (%default-root-window Xdisplay)))
! (make-window Xwindow (make-display Xdisplay) #f)))
;; for compatibility with Elk.
***************
*** 44,48 ****
(let* ((Xdisplay (display-Xdisplay display))
(Xcolormap (%default-colormap Xdisplay)))
! (make-colormap Xcolormap display)))
;; for compatibility with Elk.
--- 44,48 ----
(let* ((Xdisplay (display-Xdisplay display))
(Xcolormap (%default-colormap Xdisplay)))
! (make-colormap Xcolormap display #f)))
;; for compatibility with Elk.
***************
*** 58,62 ****
(let* ((Xdisplay (display-Xdisplay display))
(Xgcontext (%default-gcontext Xdisplay)))
! (make-gcontext Xgcontext display)))
(import-lambda-definition %default-gcontext (Xdisplay)
--- 58,62 ----
(let* ((Xdisplay (display-Xdisplay display))
(Xgcontext (%default-gcontext Xdisplay)))
! (make-gcontext Xgcontext display #f)))
(import-lambda-definition %default-gcontext (Xdisplay)
Index: font.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/font.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** font.scm 2001/07/18 15:48:22 1.1
--- font.scm 2001/07/19 15:19:07 1.2
***************
*** 4,8 ****
(display-Xdisplay display)
(gcontext-Xgcontext gcontext))))
! (make-font #f #f Xfontstruct display)))
(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
--- 4,8 ----
(display-Xdisplay display)
(gcontext-Xgcontext gcontext))))
! (make-font #f #f Xfontstruct display #f)))
(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
***************
*** 27,31 ****
#f
(cdr name-Xfontstruct)
! display))
v))))
--- 27,32 ----
#f
(cdr name-Xfontstruct)
! display
! #t))
v))))
Index: gcontext.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/gcontext.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** gcontext.scm 2001/07/16 13:23:39 1.3
--- gcontext.scm 2001/07/19 15:19:07 1.4
***************
*** 17,21 ****
(Xobject (drawable-Xobject drawable)))
(let ((Xgcontext (%create-gcontext Xdisplay Xobject rest)))
! (make-gcontext Xgcontext display))))))
(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
--- 17,21 ----
(Xobject (drawable-Xobject drawable)))
(let ((Xgcontext (%create-gcontext Xdisplay Xobject rest)))
! (make-gcontext Xgcontext display #t))))))
(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
Index: pixmap.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/pixmap.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** pixmap.scm 2001/07/18 15:45:54 1.2
--- pixmap.scm 2001/07/19 15:19:07 1.3
***************
*** 9,13 ****
(pixmap (%create-pixmap (display-Xdisplay display)
(drawable-Xdrawable) widht height depth)))
! (make-pixmap pixmap display)))
(import-lambda-definition %create-pixmap (Xdisplay Xdrawable w h depth)
--- 9,13 ----
(pixmap (%create-pixmap (display-Xdisplay display)
(drawable-Xdrawable) widht height depth)))
! (make-pixmap pixmap display #t)))
(import-lambda-definition %create-pixmap (Xdisplay Xdrawable w h depth)
***************
*** 18,25 ****
(define (create-bitmap-from-data window data width height)
(let ((display (window-display window))
! (pixmap (%create-bitmap-from-data (display-Xdisplay display)
(window-Xwindow window)
data width height)))
! (make-pixmap pixmap display)))
(import-lambda-definition %create-bitmap-from-data (Xdisplay Xdrawable data w
h)
--- 18,25 ----
(define (create-bitmap-from-data window data width height)
(let ((display (window-display window))
! (Xpixmap (%create-bitmap-from-data (display-Xdisplay display)
(window-Xwindow window)
data width height)))
! (make-pixmap Xpixmap display #t)))
(import-lambda-definition %create-bitmap-from-data (Xdisplay Xdrawable data w
h)
***************
*** 35,39 ****
data widht height foregrnd
backgrd depth)))
! (make-pixmap pixmap display)))
--- 35,39 ----
data widht height foregrnd
backgrd depth)))
! (make-pixmap pixmap display #t)))
***************
*** 48,52 ****
(drawable-Xobject drawable)
filename)))
! (set-car! res (make-pixmap (drawable-display drawable) (car res)))))
(import-lambda-definition %read-bitmap-file (Xdisplay Xdrawable file)
--- 48,52 ----
(drawable-Xobject drawable)
filename)))
! (set-car! res (make-pixmap (drawable-display drawable) (car res) #t))))
(import-lambda-definition %read-bitmap-file (Xdisplay Xdrawable file)
Index: property.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/property.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** property.scm 2001/07/11 14:17:32 1.1
--- property.scm 2001/07/19 15:19:07 1.2
***************
*** 117,121 ****
(make-window (%get-selection-owner (display-Xdisplay display)
(atom-Xatom selection))
! display))
--- 117,122 ----
(make-window (%get-selection-owner (display-Xdisplay display)
(atom-Xatom selection))
! display
! #f))
Index: window.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/window.scm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** window.scm 2001/07/16 13:36:53 1.4
--- window.scm 2001/07/19 15:19:07 1.5
***************
*** 19,23 ****
(if (= Xwindow 0)
(error "cannot create window")
! (make-window Xwindow display))))))
(import-lambda-definition %create-window (Xdisplay Xparent x y width height
--- 19,23 ----
(if (= Xwindow 0)
(error "cannot create window")
! (make-window Xwindow display #t))))))
(import-lambda-definition %create-window (Xdisplay Xparent x y width height
***************
*** 90,95 ****
(comp 13 make-pixel) ;; backing-pixel
(comp 7 (lambda (Xwin) ;; root
! ;; really this Display ??
! (make-window Xwin (window-display window))))
;; font, visual ??
v))
--- 90,99 ----
(comp 13 make-pixel) ;; backing-pixel
(comp 7 (lambda (Xwin) ;; root
! (make-window Xwin (window-display window)
! #f)))
! (comp 15 (lambda (Xcolormap)
! (make-colormap Xcolormap
! (window-display window)
! #f)))
;; font, visual ??
v))
***************
*** 100,104 ****
map-installed map-state all-event-masks
your-event-mask do-not-propagate-mask
! override-redirect
; screen not supported
)
--- 104,108 ----
map-installed map-state all-event-masks
your-event-mask do-not-propagate-mask
! override-redirect screen
; screen not supported
)
***************
*** 266,273 ****
(res (%query-tree (window-Xwindow window)
(display-Xdisplay display))))
! (list (make-window (first res) display)
! (make-window (second res) display)
(vector-map! (lambda (Xwindow)
! (make-window Xwindow display))
(third res)))))
--- 270,277 ----
(res (%query-tree (window-Xwindow window)
(display-Xdisplay display))))
! (list (make-window (first res) display #f)
! (make-window (second res) display #f)
(vector-map! (lambda (Xwindow)
! (make-window Xwindow display #f))
(third res)))))
***************
*** 291,295 ****
(list (first res)
(second res)
! (make-window (third res) display))
#f)))
--- 295,299 ----
(list (first res)
(second res)
! (make-window (third res) display #f))
#f)))
***************
*** 311,318 ****
(second res)
(third res)
! (make-window (fourth res) display)
(fifth res)
(sixth res)
! (make-window (seventh res) display)
(eighth res))))
--- 315,322 ----
(second res)
(third res)
! (make-window (fourth res) display #f)
(fifth res)
(sixth res)
! (make-window (seventh res) display #f)
(eighth res))))
|