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

updated constructor-calls to specify wheather the X-Lib Objects 

should be freed. implemented the use of XGetGeometry.
This commit is contained in:
frese 2001-07-19 15:14:29 +00:00
parent f1d4077123
commit 536e355a45
1 changed files with 23 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
scheme/xlib/drawable.scm
View File

@ -1,22 +1,25 @@
;(define (drawable-abstraction pixmap-fun window-fun)
; (lambda (drawable)
; (cond
; ((pixmap? drawable) (pixmap-fun drawable))
; ((window? drawable) (window-fun drawable))
; (else (error "expected a drawable object" drawable)))))
;; defined in window.c
(import-lambda-definition %get-geometry (Xdisplay Xdrawable)
"Get_Geometry")
(define (get-geometry drawable)
(let ((display (drawable-display drawable))
(v (%get-geometry (display-Xdisplay display)
(drawable-Xobject drawable))))
;; wrap the root-window
(vector-set! v 0 (make-window (vector-ref v 0) display #f))
v))
(define (make-geometry-getter num)
(lambda (drawable)
(vector-ref (get-geometry drawable) num)))
(define drawable-root (make-geometry-getter 0))
(define drawable-x (make-geometry-getter 1))
(define drawable-y (make-geometry-getter 2))
(define drawable-width (make-geometry-getter 3))
(define drawable-height (make-geometry-getter 4))
(define drawable-border-width (make-geometry-getter 5))
(define drawable-depth (make-geometry-getter 6))
;(define drawable-display (drawable-abstraction pixmap-display window-display))
;(define drawable-Xobject (drawable-abstraction pixmap-Xpixmap window-Xwindow))
;; not so sure with pixmap-root, not found in Elk.
(define drawable-root (drawable-abstraction (lambda (pixm)
(display-default-root-window
(pixmap-display pixm)))
window-root))
(define drawable-x (drawable-abstraction pixmap-x window-x))
(define drawable-y (drawable-abstraction pixmap-y window-y))
(define drawable-width (drawable-abstraction pixmap-width window-width))
(define drawable-height (drawable-abstraction pixmap-height window-height))
(define drawable-border-width (drawable-abstraction pixmap-border-width
window-border-width))
(define drawable-depth (drawable-abstraction pixmap-depth window-depth))