[Scsh-checkins] CVS: scx/scheme/xlib drawable.scm,1.1,1.2

[David Frese <frese@users.sourceforge.net>]

Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv21652

Modified Files:
        drawable.scm 
Log Message:
updated constructor-calls to specify wheather the X-Lib Objects
should be freed. implemented the use of XGetGeometry.


Index: drawable.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/drawable.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** drawable.scm        2001/06/25 11:43:11     1.1
--- drawable.scm        2001/07/19 15:14:29     1.2
***************
*** 1,22 ****
! ;(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)))))
  
! ;(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))
--- 1,25 ----
! ;; 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))
! 
!