From 1e1cac1d34af90119f120d130a01ed96b4efdfbc Mon Sep 17 00:00:00 2001
From: frese <frese>
Date: Mon, 30 Jul 2001 14:43:22 +0000
Subject: [PATCH] fixed typos and forgotten parameters etc. fixed
 display-after-function.

---
 scheme/xlib/color.scm         |  5 +++--
 scheme/xlib/colormap-type.scm |  2 +-
 scheme/xlib/colormap.scm      | 11 ++++++++---
 scheme/xlib/display-type.scm  | 12 +++++++++---
 scheme/xlib/display.scm       |  6 +++---
 scheme/xlib/drawable.scm      |  6 +++---
 scheme/xlib/font-type.scm     |  7 ++++++-
 scheme/xlib/gcontext.scm      |  3 ++-
 scheme/xlib/graphics.scm      | 18 +++++++++---------
 scheme/xlib/pixel-type.scm    | 16 ++++------------
 scheme/xlib/pixmap-type.scm   |  2 +-
 scheme/xlib/pixmap.scm        | 31 ++++++++++++++++---------------
 scheme/xlib/property.scm      |  3 +--
 scheme/xlib/text.scm          |  8 ++++----
 14 files changed, 70 insertions(+), 60 deletions(-)

diff --git a/scheme/xlib/color.scm b/scheme/xlib/color.scm
index 4dbae5a..77092c4 100644
--- a/scheme/xlib/color.scm
+++ b/scheme/xlib/color.scm
@@ -37,9 +37,10 @@
 
 (define (query-colors colormap pixels)
   (let ((res (%query-colors (colormap-Xcolormap colormap)
-			    (vector-map! pixel-Xpixel pixels))))
+			    (vector-map! pixel-Xpixel pixels)
+			    (display-Xdisplay (colormap-display colormap)))))
     (vector-map! (lambda (r-g-b)
-		   (apply make-color r-g-b))
+		   (apply create-color r-g-b))
 		 res)))
 
 (import-lambda-definition %query-colors (Xcolormap Xpixels Xdisplay)
diff --git a/scheme/xlib/colormap-type.scm b/scheme/xlib/colormap-type.scm
index e11e4d5..25a0d21 100644
--- a/scheme/xlib/colormap-type.scm
+++ b/scheme/xlib/colormap-type.scm
@@ -26,7 +26,7 @@
 	      colormap)))))
 
 (define (free-colormap colormap)
-  (let ((Xcolormap (colormap-Xcolormap)))
+  (let ((Xcolormap (colormap-Xcolormap colormap)))
     (if (integer? Xcolormap)
 	(begin
 	  (%free-colormap Xcolormap 
diff --git a/scheme/xlib/colormap.scm b/scheme/xlib/colormap.scm
index 610b404..ef8b638 100644
--- a/scheme/xlib/colormap.scm
+++ b/scheme/xlib/colormap.scm
@@ -23,9 +23,14 @@
   (let ((Xres (%alloc-named-color (colormap-Xcolormap colormap)
 				  (if (symbol? color-name)
 				      (symbol->string color-name)
-				      color-name))))
+				      color-name)
+				  (display-Xdisplay 
+				   (colormap-display colormap)))))
     (if Xres
 	(list (make-pixel (car Xres))
-	      (apply make-color (cadr Xres))
-	      (apply make-color (caddr Xres)))
+	      (apply create-color (cadr Xres))
+	      (apply create-color (caddr Xres)))
 	Xres)))
+
+(import-lambda-definition %alloc-named-color (Xcolormap name Xdisplay)
+  "Alloc_Named_Color")
\ No newline at end of file
diff --git a/scheme/xlib/display-type.scm b/scheme/xlib/display-type.scm
index 2520654..b2870a4 100644
--- a/scheme/xlib/display-type.scm
+++ b/scheme/xlib/display-type.scm
@@ -3,9 +3,14 @@
 (define-record-type display :display 
   (really-make-display after-function Xdisplay) 
   display? 
-  (after-function display-after-function display-set-after-function!) 
+  (after-function display-after-function real-display-set-after-function!) 
   (Xdisplay display-Xdisplay display-set-Xdisplay!))
 
+(define (display-set-after-function! display proc)
+  (let ((old (display-after-function display)))
+    (real-display-set-after-function! display proc)
+    old))
+
 (define (make-display Xdisplay finalize?)
   (let ((maybe-display (display-list-find Xdisplay)))
     (if maybe-display
@@ -26,9 +31,10 @@
   (let ((Xdisplay (display-Xdisplay display)))
     (if (integer? Xdisplay)
 	(begin
-	  ((display-after-function display) display)
+	  (if (display-after-function display)
+	      ((display-after-function display) display))
 	  (%close-display Xdisplay)
-	  (display-set-Xdisplay display 'already-closed)))))
+	  (display-set-Xdisplay! display 'already-closed)))))
 
 (import-lambda-definition %close-display (Xdisplay) "Close_Display")
 
diff --git a/scheme/xlib/display.scm b/scheme/xlib/display.scm
index 324a30c..ae94610 100644
--- a/scheme/xlib/display.scm
+++ b/scheme/xlib/display.scm
@@ -29,7 +29,7 @@
 (define (display-default-root-window display)
   (let* ((Xdisplay (display-Xdisplay display))
 	 (Xwindow (%default-root-window Xdisplay)))
-    (make-window Xwindow (make-display Xdisplay) #f)))
+    (make-window Xwindow (make-display Xdisplay #f) #f)))
 
 ;; for compatibility with Elk.
 (define display-root-window display-default-root-window)
@@ -234,7 +234,7 @@
   (%display-wait-output (display-Xdisplay display)
 			discard-events?))
 
-(import-lambda-definition %display-wait-ouput (Xdisplay discard)
+(import-lambda-definition %display-wait-output (Xdisplay discard)
   "Display_Wait_Output")
 
 ;; display-no-op sends a NoOperation protocol request to the X server, thereby
@@ -254,7 +254,7 @@
 
 (define (display-list-depths display screen-number)
   (%display-list-depths (display-Xdisplay display)
-			(check-screen-number screen-number)))
+			(check-screen-number display screen-number)))
 
 (import-lambda-definition %display-list-depths (Xdisplay scr)
   "List_Depths")
diff --git a/scheme/xlib/drawable.scm b/scheme/xlib/drawable.scm
index 6457e7f..f668f0f 100644
--- a/scheme/xlib/drawable.scm
+++ b/scheme/xlib/drawable.scm
@@ -3,9 +3,9 @@
   "Get_Geometry")
 
 (define (get-geometry drawable)
-  (let ((display (drawable-display drawable))
-	(v (%get-geometry (display-Xdisplay display)
-			  (drawable-Xobject 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))
diff --git a/scheme/xlib/font-type.scm b/scheme/xlib/font-type.scm
index 243acd0..0162ba4 100644
--- a/scheme/xlib/font-type.scm
+++ b/scheme/xlib/font-type.scm
@@ -2,10 +2,15 @@
   (really-make-font name Xfont Xfontstruct display)
   font?
   (name font-name font-set-name!)
-  (Xfont font-Xfont font-set-Xfont!)
+  (Xfont real-font-Xfont font-set-Xfont!)
   (Xfontstruct font-Xfontstruct font-set-Xfontstruct!)
   (display font-display font-set-display!))
 
+(define (font-Xfont font)
+  (if (none-resource? font)
+      0
+      (real-font-Xfont font)))
+
 ;; creates a font object. name can be #f. if Xfont is #f then it is obtained 
 ;; from the Xfontstruct.
 
diff --git a/scheme/xlib/gcontext.scm b/scheme/xlib/gcontext.scm
index 9350f9a..cebfa3f 100644
--- a/scheme/xlib/gcontext.scm
+++ b/scheme/xlib/gcontext.scm
@@ -107,6 +107,7 @@
 		       ((pixmap? value) (pixmap-Xpixmap value))
 		       ((font? value) (font-Xfont value)) ;;??
 		       ((pixel? value) (pixel-Xpixel value))
+		       ;; ??...
 		       (else value)))
 		    (map cdr alist)))))
     (%change-gcontext (gcontext-Xgcontext gcontext)
@@ -114,7 +115,7 @@
 		      prep-alist)))
 
 
-(import-lambda-definition %change-gcontext (Xgcontext Xdisplay)
+(import-lambda-definition %change-gcontext (Xgcontext Xdisplay args)
   "Change_Gc")
 
 (define (make-gcontext-setter name)
diff --git a/scheme/xlib/graphics.scm b/scheme/xlib/graphics.scm
index 1dcd298..fb35be6 100644
--- a/scheme/xlib/graphics.scm
+++ b/scheme/xlib/graphics.scm
@@ -3,7 +3,7 @@
 ;; last change   : 04/07/2001
 
 
-(define (clear-area window x y windth height exposures?)
+(define (clear-area window x y width height exposures?)
   (%clear-area (window-Xwindow window)
 	       (display-Xdisplay (window-display window))
 	       x y width height exposures?))
@@ -138,7 +138,7 @@
 
 (define (draw-rectangles drawable gcontext vector-of-rectangles)
   (%draw-rectangles (display-Xdisplay (drawable-display drawable))
-		    (drawable-object drawable)
+		    (drawable-Xobject drawable)
 		    (gcontext-Xgcontext gcontext)
 		    vector-of-rectangles))
 
@@ -149,7 +149,7 @@
 
 (define (fill-rectangles drawable gcontext vector-of-rectangles)
   (%fill-rectangles (display-Xdisplay (drawable-display drawable))
-		    (drawable-object drawable)
+		    (drawable-Xobject drawable)
 		    (gcontext-Xgcontext gcontext)
 		    vector-of-rectangles))
 
@@ -160,7 +160,7 @@
 
 (define (draw-arc drawable gcontext x y width height angle1 angle2)
   (%draw-arc (display-Xdisplay (drawable-display drawable))
-	     (drawable-object drawable)
+	     (drawable-Xobject drawable)
 	     (gcontext-Xgcontext gcontext)
 	     x y width height angle1 angle2))
 
@@ -169,9 +169,9 @@
    "Draw_Arc")
 
 
-(define (fill-arc drawable gcontext x y widht height angle1 angle2)
+(define (fill-arc drawable gcontext x y width height angle1 angle2)
   (%fill-arc (display-Xdisplay (drawable-display drawable))
-	     (drawable-object drawable)
+	     (drawable-Xobject drawable)
 	     (gcontext-Xgcontext gcontext)
 	     x y width height angle1 angle2))
 
@@ -181,7 +181,7 @@
 
 (define (draw-arcs drawable gcontext vector-of-data)
   (%draw-arcs (display-Xdisplay (drawable-display drawable))
-	      (drawable-object drawable)
+	      (drawable-Xobject drawable)
 	      (gcontext-Xgcontext gcontext)
 	      vector-of-data))
 
@@ -190,7 +190,7 @@
 
 (define (fill-arcs drawable gcontext vector-of-data)
   (%fill-arcs (display-Xdisplay (drawable-display drawable))
-	      (drawable-object drawable)
+	      (drawable-Xobject drawable)
 	      (gcontext-Xgcontext gcontext)
 	      vector-of-data))
 
@@ -199,7 +199,7 @@
 
 (define (fill-polygon drawable gcontext vector-of-points relative? shape)
   (%fill-polygon (display-Xdisplay (drawable-display drawable))
-		 (drawable-object drawable)
+		 (drawable-Xobject drawable)
 		 (gcontext-Xgcontext gcontext)
 		 vector-of-points relative? shape))
 
diff --git a/scheme/xlib/pixel-type.scm b/scheme/xlib/pixel-type.scm
index abf74cd..418a411 100644
--- a/scheme/xlib/pixel-type.scm
+++ b/scheme/xlib/pixel-type.scm
@@ -9,19 +9,10 @@
     (if maybe-pixel
 	maybe-pixel
 	(let ((pixel (really-make-pixel #f Xpixel)))
-	  (add-finalizer! pixel finalize-pixel)
+	  (add-finalizer! pixel pixel-list-delete!)
 	  (pixel-list-set! Xpixel pixel)
 	  pixel))))
 
-;; finalize-pixel is called, when the garbage collector removes the last
-;; reference to the pixel from the heap. Then we can savely close the 
-;; pixel and remove the weak-pointer from our list.
-
-(define (finalize-pixel pixel)
-  (let ((Xpixel (pixel-Xpixel pixel)))
-    (pixel-set-Xpixel! pixel 'already-destroyed)
-    (pixel-list-delete! Xpixel)))
-
 ;; All pixel records need to be saved in a weak-list, to have only one record
 ;; for the same XLib pixel
 
@@ -37,5 +28,6 @@
   (let ((p (make-weak-pointer pixel)))
     (table-set! *weak-pixel-list* Xpixel p)))
 
-(define (pixel-list-delete! Xpixel)
-  (table-set! *weak-pixel-list* Xpixel #f))
\ No newline at end of file
+(define (pixel-list-delete! pixel)
+  (table-set! *weak-pixel-list* 
+	      (pixel-Xpixel pixel) #f))
diff --git a/scheme/xlib/pixmap-type.scm b/scheme/xlib/pixmap-type.scm
index b3f71f2..b1e0387 100644
--- a/scheme/xlib/pixmap-type.scm
+++ b/scheme/xlib/pixmap-type.scm
@@ -55,4 +55,4 @@
 
 (define (pixmap-list-delete! pixmap)
   (table-set! *weak-pixmap-list* 
-	      (pixmap-Xpixmap pixmap) #f))
\ No newline at end of file
+	      (pixmap-Xpixmap pixmap) #f))
diff --git a/scheme/xlib/pixmap.scm b/scheme/xlib/pixmap.scm
index c77f415..a05f4eb 100644
--- a/scheme/xlib/pixmap.scm
+++ b/scheme/xlib/pixmap.scm
@@ -5,10 +5,11 @@
 ; ---
 
 (define (create-pixmap drawable width height depth)
-  (let ((display (drawable-display drawable))
-	(pixmap (%create-pixmap (display-Xdisplay display)
-				(drawable-Xdrawable) widht height depth)))
-  (make-pixmap pixmap display #t)))
+  (let* ((display (drawable-display drawable))
+	 (pixmap (%create-pixmap (display-Xdisplay display)
+				 (drawable-Xobject drawable) 
+				 width height depth)))
+    (make-pixmap pixmap display #t)))
 
 (import-lambda-definition %create-pixmap (Xdisplay Xdrawable w h depth)
   "Create_Pixmap")
@@ -16,10 +17,10 @@
 ; ---
 
 (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)))
+  (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)
@@ -29,11 +30,11 @@
 
 (define (create-pixmap-from-bitmap-data win data widht height 
 					foregrnd backgrnd depth)
-  (let ((display (window-display window))
-	(pixmap (create-pixmap-from-bitmap-data (display-Xdisplay display)
-						(window-Xwindow window)
-						data widht height foregrnd
-						backgrd depth)))
+  (let* ((display (window-display window))
+	 (pixmap (create-pixmap-from-bitmap-data (display-Xdisplay display)
+						 (window-Xwindow window)
+						 data widht height foregrnd
+						 backgrd depth)))
     (make-pixmap pixmap display #t)))
 
 
@@ -62,8 +63,8 @@
 		 ((null? (cdr coord)) 
 		  (error "zero or both coordinates must be defined"))
 		 (else coord))))
-	(%write-bitmap-file dpy filename pixmap widht height 
-			  (car xy-hot) (cadr xy-hot))))
+    (%write-bitmap-file dpy filename pixmap widht height 
+			(car xy-hot) (cadr xy-hot))))
 
 
 (import-lambda-definition %write-bitmap-file (Xdisplay file Xpixmap w h x y)
diff --git a/scheme/xlib/property.scm b/scheme/xlib/property.scm
index 5537b4c..a0235b7 100644
--- a/scheme/xlib/property.scm
+++ b/scheme/xlib/property.scm
@@ -110,10 +110,9 @@
    "Set_Selection_Owner")
 
 
-; --- (get-selection-owner instead of selection-owner)
 ; --- RETURN -> Window (s48 record)
 
-(define (get-selection-owner display selection)
+(define (selection-owner display selection)
   (make-window (%get-selection-owner (display-Xdisplay display)
 				     (atom-Xatom selection))
 	       display
diff --git a/scheme/xlib/text.scm b/scheme/xlib/text.scm
index 68117a1..879830c 100644
--- a/scheme/xlib/text.scm
+++ b/scheme/xlib/text.scm
@@ -30,8 +30,8 @@
 
 (define (change-format format)
   (cond ((symbol? format)
-	 (cond ((eq? '1-byte) 1)
-	       ((eq? '2-byte) 2)
+	 (cond ((eq? format '1-byte) 1)
+	       ((eq? format '2-byte) 2)
 	       (else (error "Wrong format-type" change-format))))
 	((number? format)
 	 (if  (or (= 1 format) (= 2 format))
@@ -105,11 +105,11 @@
 
 (define (draw-poly-text drawable gcontext x y text format)
   (let ((vec-text (transform-text text))
-	(int-format (change-format format))
+	(int-format (change-format format)))
     (if (check-format? vec-text int-format)
 	(%draw-poly-text (display-Xdisplay (drawable-display drawable))
 			 (drawable-Xobject drawable) (gcontext-Xgcontext gcontext)
-			 x y vec-text (change-format! format)))
+			 x y vec-text (change-format! format)))))
 
 (import-lambda-definition %draw-poly-text (Xdisplay Xdrawable Xgcontext
 						    x y text format)