[Scsh-checkins] CVS: scx/scheme/xlib pixel-type.scm,1.2,1.3 pixel.scm,1.2,1.3

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

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

Modified Files:
        pixel-type.scm pixel.scm 
Log Message:
- added finalize? argument to make-pixel, so that allocated
color-cells (=pixels) are freed correctly.





Index: pixel-type.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/pixel-type.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** pixel-type.scm      2001/07/30 14:43:22     1.2
--- pixel-type.scm      2001/10/09 15:45:26     1.3
***************
*** 1,16 ****
  (define-record-type pixel :pixel
!   (really-make-pixel tag Xpixel) 
    pixel?
    (tag pixel-tag pixel-set-tag!)
!   (Xpixel pixel-Xpixel pixel-set-Xpixel!))
  
! (define (make-pixel Xpixel)
    (let ((maybe-pixel (pixel-list-find Xpixel)))
      (if maybe-pixel
!       maybe-pixel
!       (let ((pixel (really-make-pixel #f Xpixel)))
!         (add-finalizer! pixel pixel-list-delete!)
          (pixel-list-set! Xpixel pixel)
          pixel))))
  
  ;; All pixel records need to be saved in a weak-list, to have only one record
--- 1,35 ----
  (define-record-type pixel :pixel
!   (really-make-pixel tag Xpixel colormap) 
    pixel?
    (tag pixel-tag pixel-set-tag!)
!   (Xpixel pixel-Xpixel pixel-set-Xpixel!)
!   (colormap pixel-colormap pixel-set-colormap!))
  
! ;; Attention: colormap can be #f if finalize? is #f
! (define (make-pixel Xpixel colormap finalize?)
    (let ((maybe-pixel (pixel-list-find Xpixel)))
      (if maybe-pixel
!       (begin
!         ;; now free the Xpixel if it has been allocated
!         (if finalize?
!             (%free-pixel Xpixel 
!                          (display-Xdisplay (colormap-display colormap))
!                          (colormap-Xcolormap colormap)))
!         maybe-pixel)
!       (let ((pixel (really-make-pixel #f Xpixel colormap)))
!         (if finalize?
!             (add-finalizer! pixel free-pixel)
!             (add-finalizer! pixel pixel-list-delete!))
          (pixel-list-set! Xpixel pixel)
          pixel))))
+ 
+ (define (free-pixel pixel)
+   (%free-pixel (pixel-Xpixel pixel)
+              (display-Xdisplay (colormap-display (pixel-colormap pixel)))
+              (colormap-Xcolormap (pixel-colormap pixel)))
+   (pixel-list-delete! pixel))
+ 
+ (import-lambda-definition %free-pixel (Xpixel Xdisplay Xcolormap)
+   "scx_Free_Pixel")
  
  ;; All pixel records need to be saved in a weak-list, to have only one record

Index: pixel.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/pixel.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** pixel.scm   2001/07/31 14:54:53     1.2
--- pixel.scm   2001/10/09 15:45:26     1.3
***************
*** 2,6 ****
  
  (define (black-pixel display)
!   (make-pixel (%black-pixel (display-Xdisplay display))))
  
  (import-lambda-definition %black-pixel (Xdisplay)
--- 2,7 ----
  
  (define (black-pixel display)
!   (make-pixel (%black-pixel (display-Xdisplay display))
!             #f #f))
  
  (import-lambda-definition %black-pixel (Xdisplay)
***************
*** 8,12 ****
  
  (define (white-pixel display)
!   (make-pixel (%white-pixel (display-Xdisplay display))))
  
  (import-lambda-definition %white-pixel (Xdisplay)
--- 9,14 ----
  
  (define (white-pixel display)
!   (make-pixel (%white-pixel (display-Xdisplay display))
!             #f #f))
  
  (import-lambda-definition %white-pixel (Xdisplay)