From 536e355a45679a6b72bfa00c76826cdace4184b3 Mon Sep 17 00:00:00 2001 From: frese Date: Thu, 19 Jul 2001 15:14:29 +0000 Subject: [PATCH] updated constructor-calls to specify wheather the X-Lib Objects should be freed. implemented the use of XGetGeometry. --- scheme/xlib/drawable.scm | 43 +++++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/scheme/xlib/drawable.scm b/scheme/xlib/drawable.scm index 1b907d0..6457e7f 100644 --- a/scheme/xlib/drawable.scm +++ b/scheme/xlib/drawable.scm @@ -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))