- replaced the use of symbols 'none, 'parent-relative etc. by

functions that create special X-Objects. e.g. special-window:none,
  special-pixmap:copy-from-parent.

- added a discloser for windows (makes debugging easier).

- fixed bugs in gcontext-font, get-window-attributes and text-width

- added enumerated types for colormap-alloc in create-colormap and grab-mode

c/xlib/colormap.c

@@ -68,7 +68,7 @@ s48_value scx_Create_Colormap (s48_value Xdisplay, s48_value Xwindow,
   Colormap cm = XCreateColormap( SCX_EXTRACT_DISPLAY(Xdisplay),
 				 SCX_EXTRACT_WINDOW(Xwindow),
 				 SCX_EXTRACT_VISUAL(Xvisual),
-				 S48_FALSE_P(alloc) ? AllocNone : AllocAll );
+				 s48_extract_integer(alloc) );
   return SCX_ENTER_COLORMAP(cm);
 }
 

c/xlib/grab.c

@@ -1,21 +1,16 @@
 #include "xlib.h"
 
-int Get_Mode (s48_value m){
-  return S48_EXTRACT_BOOLEAN(m) ? GrabModeSync :GrabModeAsync;
-}
-
-
 s48_value scx_Grab_Pointer (s48_value dpy, s48_value win, 
 			    s48_value ownerp, s48_value events, 
-			    s48_value psyncp, s48_value ksyncp, 
+			    s48_value pmode, s48_value kmode, 
 			    s48_value confine_to, s48_value cursor, 
 			    s48_value time) {
   int res = XGrabPointer(SCX_EXTRACT_DISPLAY(dpy),
 			 SCX_EXTRACT_WINDOW(win),
 			 S48_EXTRACT_BOOLEAN(ownerp),
 			 s48_extract_integer(events),
-			 Get_Mode(psyncp), 
+			 s48_extract_integer(pmode), 
-			 Get_Mode(ksyncp),
+			 s48_extract_integer(kmode),
 			 SCX_EXTRACT_WINDOW(confine_to),
 			 SCX_EXTRACT_CURSOR(cursor),
 			 SCX_EXTRACT_TIME(time));
@@ -31,7 +26,7 @@ s48_value scx_Ungrab_Pointer (s48_value dpy, s48_value time) {
 
 s48_value scx_Grab_Button (s48_value dpy, s48_value win, s48_value button, 
 			   s48_value mods, s48_value ownerp, s48_value events,
-			   s48_value psyncp, s48_value  ksyncp, 
+			   s48_value pmode, s48_value  kmode, 
 			   s48_value confine_to, s48_value cursor){
   XGrabButton(SCX_EXTRACT_DISPLAY(dpy),
 	      s48_extract_integer(button),
@@ -39,7 +34,8 @@ s48_value scx_Grab_Button (s48_value dpy, s48_value win, s48_value button,
 	      SCX_EXTRACT_WINDOW(win),
 	      S48_EXTRACT_BOOLEAN(ownerp),
 	      s48_extract_integer(events),
-	      Get_Mode(psyncp), Get_Mode(ksyncp),
+	      s48_extract_integer(pmode),
+	      s48_extract_integer(kmode),
 	      SCX_EXTRACT_WINDOW(confine_to),
 	      SCX_EXTRACT_CURSOR(cursor));
   return S48_UNSPECIFIC;
@@ -67,13 +63,13 @@ s48_value scx_Change_Active_Pointer_Grab (s48_value Xdpy, s48_value events,
 
 
 s48_value scx_Grab_Keyboard (s48_value Xdpy, s48_value Xwin, s48_value ownerp, 
-			     s48_value psyncp, s48_value ksyncp,
+			     s48_value pmode, s48_value kmode,
 			     s48_value time){
   int res = XGrabKeyboard( SCX_EXTRACT_DISPLAY(Xdpy),
 			   SCX_EXTRACT_WINDOW(Xwin),
 			   S48_EXTRACT_BOOLEAN(ownerp),
-			   Get_Mode(psyncp),
+			   s48_extract_integer(pmode),
-			   Get_Mode (ksyncp),
+			   s48_extract_integer(kmode),
 			   SCX_EXTRACT_TIME(time));
   return s48_enter_integer(res);
 }
@@ -87,8 +83,8 @@ s48_value scx_Ungrab_Keyboard (s48_value Xdpy, s48_value time){
 
 
 s48_value scx_Grab_Key (s48_value Xdpy, s48_value Xwin, s48_value key,
-			s48_value mods, s48_value ownerp, s48_value psyncp,
+			s48_value mods, s48_value ownerp, s48_value pmode,
-			s48_value ksyncp, s48_value flag){
+			s48_value kmode, s48_value flag){
   int keycode = AnyKey;
   if (!S48_EXTRACT_BOOLEAN(flag))
     keycode = (int)s48_extract_integer(key);
@@ -97,8 +93,8 @@ s48_value scx_Grab_Key (s48_value Xdpy, s48_value Xwin, s48_value key,
 	    s48_extract_integer(mods),
 	    SCX_EXTRACT_WINDOW(Xwin),
 	    S48_EXTRACT_BOOLEAN(ownerp),
-	    Get_Mode(psyncp),
+	    s48_extract_integer(pmode),
-	    Get_Mode (ksyncp));
+	    s48_extract_integer(kmode));
   return S48_UNSPECIFIC;
 }
 

c/xlib/init.c

@@ -20,16 +20,7 @@ s48_value scx_Xlib_Release_6_Or_Later () {
 #endif
 }
 
-s48_value symbol_now_binding = S48_FALSE;
-
-s48_value symbol_now() {
-  return S48_SHARED_BINDING_REF(symbol_now_binding);
-}
-
 void scx_init_init(void) {
-  S48_GC_PROTECT_GLOBAL(symbol_now_binding);
-  // *symbol-now* is defined in helper.scm
-  symbol_now_binding = s48_get_imported_binding("*symbol-now*");
   S48_EXPORT_FUNCTION(scx_Xlib_Release_4_Or_Later);
   S48_EXPORT_FUNCTION(scx_Xlib_Release_5_Or_Later);
   S48_EXPORT_FUNCTION(scx_Xlib_Release_6_Or_Later);

c/xlib/xlib.h

@@ -21,8 +21,6 @@
 #define S48_FALSE_P(x) S48_EQ(x, S48_FALSE)
 #define S48_TRUE_P(x) S48_EQ(x, S48_TRUE)
 
-extern s48_value symbol_now(); // defined in init.c
-
 /* Extraction-Macros for the new types, from their s48_value wrapping.
  */
 
@@ -42,8 +40,8 @@ extern s48_value symbol_now(); // defined in init.c
 #define SCX_EXTRACT_DRAWABLE(x) (Drawable)s48_extract_integer(x)
 #define SCX_ENTER_ATOM(x) s48_enter_integer((long)x)
 #define SCX_EXTRACT_ATOM(x) (Atom)s48_extract_integer(x)
-#define SCX_ENTER_TIME(x) x == CurrentTime ? symbol_now() : s48_enter_integer(x)
+#define SCX_ENTER_TIME(x) s48_enter_integer(x)
-#define SCX_EXTRACT_TIME(x) S48_SYMBOL_P(x) ? CurrentTime : (int)s48_extract_integer(x)
+#define SCX_EXTRACT_TIME(x) (int)s48_extract_integer(x)
 #define SCX_EXTRACT_CURSOR(x) (Cursor)s48_extract_integer(x)
 #define SCX_ENTER_CURSOR(x) s48_enter_integer((long)x)
 #define SCX_ENTER_FONT(x) s48_enter_integer((long)x)

scheme/xlib/atom-type.scm

@@ -4,31 +4,25 @@
   (really-make-atom tag Xatom) 
   atom? 
   (tag atom-tag atom-set-tag!)
-  (Xatom real-atom-Xatom atom-set-Xatom!))
+  (Xatom atom-Xatom atom-set-Xatom!))
-
-(define (atom-Xatom atom)
-  (if (none-resource? atom)
-      0
-      (real-atom-Xatom atom)))
 
 (define (make-atom Xatom)
-  (if (= 0 Xatom)
-      none-resource
   (let ((maybe-atom (atom-list-find Xatom)))
     (if maybe-atom
 	maybe-atom
 	(let ((atom (really-make-atom #f Xatom)))
 	  (add-finalizer! atom finalize-atom)
 	  (atom-list-set! Xatom atom)
-	      atom)))))
+	  atom))))
 
+;; intern-atom returns an atom. if an atom of that name did not exist
+;; before, a new one is created. See XInternAtom.
 
 (define (intern-atom display name)
-  (let ((Xatom (%intern-atom (display-Xdisplay display)
+  (make-atom  (%intern-atom (display-Xdisplay display)
 			    (if (symbol? name)
 				(symbol->string name)
 				name))))
-    (make-atom Xatom)))
 
 (import-lambda-definition %intern-atom (Xdisplay name)
   "scx_Intern_Atom")
@@ -42,7 +36,6 @@
     ;(atom-set-Xatom! atom 'already-freed)
     (atom-list-delete! Xatom)))
 
-
 ;; All atom records need to be saved in a weak-list, to have only one record
 ;; for the same XLib atom
 
@@ -61,3 +54,6 @@
 (define (atom-list-delete! Xatom)
   (table-set! *weak-atom-list* Xatom #f))
  
+;; Special atom value
+
+(define special-atom:none (make-atom 0))

scheme/xlib/color-type.scm

@@ -9,8 +9,8 @@
 (define-record-discloser :color
   (lambda (c) 
     (let ((rgb (extract-rgb-values c)))
-      `(Color ,(/ (car rgb) 65535) ,(/ (cadr rgb) 65535) 
+      `(Color ,(/ (car rgb) 65535.) ,(/ (cadr rgb) 65535.) 
-	      ,(/ (caddr rgb) 65535)))))
+	      ,(/ (caddr rgb) 65535.)))))
 
 (define (internal-make-color Xcolor)
   (let ((maybe-color (color-list-find Xcolor)))

scheme/xlib/colormap-type.scm

@@ -4,17 +4,10 @@
   (really-make-colormap tag Xcolormap display) 
   colormap? 
   (tag colormap-tag colormap-set-tag!)
-  (Xcolormap real-colormap-Xcolormap colormap-set-Xcolormap!)
+  (Xcolormap colormap-Xcolormap colormap-set-Xcolormap!)
   (display colormap-display colormap-set-display!))
 
-(define (colormap-Xcolormap colormap)
-  (if (none-resource? colormap)
-      none-resource
-      (real-colormap-Xcolormap colormap)))
-
 (define (make-colormap Xcolormap display finalize?)
-  (if (none-resource? Xcolormap)
-      'none
   (let ((maybe-colormap (colormap-list-find Xcolormap)))
     (if maybe-colormap
 	maybe-colormap
@@ -23,7 +16,7 @@
 	      (add-finalizer! colormap free-colormap)
 	      (add-finalizer! colormap colormap-list-delete!))
 	  (colormap-list-set! Xcolormap colormap)
-	      colormap)))))
+	  colormap))))
 
 (define (free-colormap colormap)
   (let ((Xcolormap (colormap-Xcolormap colormap)))

scheme/xlib/colormap.scm

@@ -1,7 +1,13 @@
 ;; Author: David Frese
 
-;; alloc-color returns the pixel closest to the specified color supported by the
+;; special colormaps
-;; hardware. See XAllocColor. The color parameter is mutated!
+
+(define (special-colormap:none dpy)
+  (make-colormap 0 dpy #f))
+
+;; alloc-color returns the pixel closest to the specified color
+;; supported by the hardware. See XAllocColor. The color parameter is
+;; mutated!
 
 (define (alloc-color! colormap color)
   (let ((Xpixel (%alloc-color (colormap-Xcolormap colormap)
@@ -66,21 +72,26 @@
 
 ;; The create-colormap function creates a colormap of the specified
 ;; visual type for the screen on which the specified window resides.
-;; alloc can be 'none or 'all. See XCreateColormap.
+;; alloc can be (colormap-alloc none) or (colormap-alloc all). See
+;; XCreateColormap.
 
 (define (create-colormap window visual alloc)
   (let ((Xcolormap (%create-colormap (display-Xdisplay (window-display window))
 				     (window-Xwindow window)
 				     (visual-Xvisual visual)
-				     (if (eq? alloc 'none)
+				     (colormap-alloc->integer alloc))))
-					 #f
-					 #t) ; 'all
-				     )))
     (make-colormap Xcolormap (window-display window) #t)))
 
 (import-lambda-definition %create-colormap (Xdisplay Xwindow Xvisual alloc)
   "scx_Create_Colormap")
 
+(define-enumerated-type colormap-alloc :colormap-alloc
+  colormap-alloc? colormap-allocs colormap-alloc-name colormap-alloc-index
+  (none all))
+
+(define (colormap-alloc->integer v)
+  (colormap-alloc-index v))
+
 ;; The alloc-color-cells function allocates read/write color cells.
 ;; The number of colors must be positive and the number of planes
 ;; nonnegative, or a BadValue error results. See XAllocColorCells.

scheme/xlib/cursor-type.scm

@@ -2,17 +2,10 @@
   (really-make-cursor tag Xcursor display) 
   cursor? 
   (tag cursor-tag cursor-set-tag!)
-  (Xcursor real-cursor-Xcursor cursor-set-Xcursor!)
+  (Xcursor cursor-Xcursor cursor-set-Xcursor!)
   (display cursor-display cursor-set-display!))
 
-(define (cursor-Xcursor cursor)
-  (if (none-resource? cursor)
-      0
-      (real-cursor-Xcursor cursor)))
-
 (define (make-cursor Xcursor display finalize?)
-  (if (= 0 Xcursor)
-      none-resource
   (let ((maybe-cursor (cursor-list-find Xcursor)))
     (if maybe-cursor
 	maybe-cursor
@@ -21,7 +14,7 @@
 	      (add-finalizer! cursor free-cursor)
 	      (add-finalizer! cursor cursor-list-delete!))
 	  (cursor-list-set! Xcursor cursor)
-	      cursor)))))
+	  cursor))))
 
 ;; ...
 

scheme/xlib/cursor.scm

@@ -18,6 +18,11 @@
 (import-lambda-definition %create-pixmap-cursor (Xdisplay src mask x y f b)
   "scx_Create_Pixmap_Cursor")
 
+;; Special cursor values
+
+(define (special-cursor:none dpy)
+  (make-cursor 0 dpy #f))
+
 ;; create-glyph-cursor returns a cursor, that was build using the font
 ;; src, an integer src-char, a font mask, an integer mask-char, and
 ;; the colors foreground and background. See XCreateGlyphCursor.

scheme/xlib/display-type.scm

@@ -91,3 +91,7 @@
 
 (import-lambda-definition %display-message-fd (Xdisplay)
   "scx_Display_Message_fd")
+
+;; this can be used as a time argument. (a little bit misplaced here)
+
+(define special-time:current-time 0)

scheme/xlib/font-type.scm

@@ -2,15 +2,10 @@
   (really-make-font name Xfont Xfontstruct display)
   font?
   (name font-name font-set-name!)
-  (Xfont real-font-Xfont font-set-Xfont!)
+  (Xfont 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. Either Xfont or Xfontstruct
 ;; has to bes specified. if Xfont is #f then it is obtained from the
 ;; Xfontstruct. if Xfontstruct is #f it queried with XQueryFont - but
@@ -42,6 +37,11 @@
 (import-lambda-definition %font->fontstruct (Xdisplay Xfont)
   "scx_Font_ID_To_Font")
 
+;; Special font values
+
+(define (special-font:none dpy)
+  (make-font #f 0 #f dpy #f))
+
 ;; load-font loads a font by its name. See XLoadQueryFont.
 
 (define (load-font display font-name)
@@ -73,7 +73,6 @@
     (font-set-Xfontstruct! font 'already-freed)
     (font-set-Xfont! font 'already-freed)))
 
-
 ;; for compatibility with Elk:
 (define close-font unload-font)
 

scheme/xlib/gcontext-type.scm

@@ -2,17 +2,10 @@
   (really-make-gcontext tag Xgcontext display) 
   gcontext?
   (tag gcontext-tag gcontext-set-tag!)
-  (Xgcontext real-gcontext-Xgcontext gcontext-set-Xgcontext!)
+  (Xgcontext gcontext-Xgcontext gcontext-set-Xgcontext!)
   (display gcontext-display gcontext-set-display!))
 
-(define (gcontext-Xgcontext gcontext)
-  (if (none-resource? gcontext)
-      0
-      (real-gcontext-Xgcontext gcontext)))
-
 (define (make-gcontext Xgcontext display finalize?)
-  (if (= 0 Xgcontext)
-      none-resource
   (let ((maybe-gcontext (gcontext-list-find Xgcontext)))
     (if maybe-gcontext
 	maybe-gcontext
@@ -21,7 +14,12 @@
 	      (add-finalizer! gcontext free-gcontext)
 	      (add-finalizer! gcontext gcontext-list-delete!))
 	  (gcontext-list-set! Xgcontext gcontext)
-	      gcontext)))))
+	  gcontext))))
+
+;; special gcontext values
+
+(define (special-gcontext:none dpy)
+  (make-gcontext 0 dpy #f))
 
 ;; to free the gcontext X-lib ressources call free-gcontext. if gcontext is
 ;; already freed, the function does nothing.

scheme/xlib/grab.scm

@@ -12,20 +12,21 @@
 (define (integer->grab-status i)
   (vector-ref grab-states i))
 
-(define (grab-pointer window owner? events ptr-sync? kbd-sync?
+(define (grab-pointer window owner? events ptr-mode kbd-mode
 		      confine-to cursor time)
   (integer->grab-status
    (%grab-pointer (display-Xdisplay (window-display window))
 		  (window-Xwindow window)
 		  owner? 
 		  (event-mask->integer events)
-		  ptr-sync? kbd-sync?
+		  (grab-mode->integer ptr-mode)
+		  (grab-mode->integer kbd-mode)
 		  (window-Xwindow confine-to)
 		  (cursor-Xcursor cursor)
 		  time)))
 
 (import-lambda-definition %grab-pointer (Xdisplay Xwindow owner? events
-					 ptr-sync? kbd-sync?
+					 ptr-mode kbd-mode
 					 Xconfine-to Xcursor time)
   "scx_Grab_Pointer")
 
@@ -38,11 +39,20 @@
 (import-lambda-definition %ungrab-pointer (Xdisplay time)
   "scx_Ungrab_Pointer")
 
-
 ;; grab-button performs a grab-pointer depending on a corresponding
 ;; button press event. See XGrabButton.
 
-(define (grab-button window button mod owner? events ptr-sync? kbd-sync?
+(define-enumerated-type grab-mode :grab-mode
+  grab-mode? grab-modes grab-mode-name grab-mode-index
+  (sync async))
+
+(define (grab-mode->integer m)
+  (grab-mode-index m))
+
+(define (interger->grab-mode i)
+  (vector-ref grab-modes i))
+
+(define (grab-button window button mod owner? events ptr-mode kbd-mode
 		     confine-to cursor)
   (%grab-button (display-Xdisplay (window-display window))
 		(window-Xwindow window)
@@ -50,13 +60,14 @@
 		(state-set->integer mod)
 		owner?
 		(event-mask->integer events)
-		ptr-sync? kbd-sync?
+		(grab-mode->integer ptr-mode)
+		(grab-mode->integer kbd-mode)
 		(window-Xwindow confine-to)
 		(cursor-Xcursor cursor)))
 
 (import-lambda-definition %grab-button (Xdisplay Xwindow button
 						 mods ownerp events
-						 ptr-sync? kbd-sync?
+						 ptr-mode kbd-mode
 						 Xconfine-to Xcursor)
   "scx_Grab_Button")			   
 
@@ -94,14 +105,17 @@
 ;; client has it actively grabbed from either grab-keyboard or
 ;; grab-Key. See XGrabKeyboard and XUngrabKeyboard.
 		  
-(define (grab-keyboard window owner? ptr-sync? kbd-sync? time)
+(define (grab-keyboard window owner? ptr-mode kbd-mode time)
   (integer->grab-status
    (%grab-keyboard (display-Xdisplay (window-display window))
 		   (window-Xwindow window)
-		   owner? ptr-sync? kbd-sync? time)))
+		   owner?
+		   (grab-mode->integer ptr-mode)
+		   (grab-mode->integer kbd-mode)
+		   time)))
 
 (import-lambda-definition %grab-keyboard (Xdisplay Xwindow
-						   owner? ptr-sync? kbd-sync?
+						   owner? ptr-mode kbd-mode
 						   time)
   "scx_Grab_Keyboard")
 
@@ -118,15 +132,18 @@
 ;; grabbed. 
 ;; ungrab-key releases this passive grab. See XGrabKey and XUngrabKey.
 			  
-(define (grab-key window key mod owner? ptr-sync? kbd-sync?)
+(define (grab-key window key mod owner? ptr-mode kbd-mode)
   (%grab-key (display-Xdisplay (window-display window))
 	     (window-Xwindow window)
 	     key
 	     (state-set->integer mod)
-	     owner? ptr-sync? kbd-sync? (symbol? key)))
+	     owner?
+	     (grab-mode->integer ptr-mode)
+	     (grab-mode->integer kbd-mode)
+	     (symbol? key)))
 
 (import-lambda-definition %grab-key (Xdisplay xwindow key mod
-				     owner ptr-sync? kbd-sync? flag)
+				     owner ptr-mode kbd-mode flag)
   "scx_Grab_Key")
 
 (define (ungrab-key window key mod)

scheme/xlib/helper.scm

@@ -1,71 +1,3 @@
-;; make-enum-alist->vector creates a function that converts an
-;; association list, that maps from an enumerated type to some values,
-;; into a vector. The vector element i contains #f if the
-;; corresponding element i of the enumerated type was not defined in
-;; the alist, and the value ((converter i) value) otherwise. Be sure
-;; to convert boolean values to something else, if you want to know if
-;; a value was not defined, or defined as #f afterwards.
-
-(define (make-enum-alist->vector enum-vector index-fun converter)
-  (lambda (alist)
-    (let ((res (make-vector (vector-length enum-vector) #f)))
-      (for-each (lambda (a)
-		  (vector-set! res (index-fun (car a))
-			       a))
-		alist)
-      (let loop ((i 0))
-	(if (< i (vector-length res))
-	    (begin
-	      (if (vector-ref res i)
-		  (vector-set! res i
-			       ((converter i) (cdr (vector-ref res i)))))
-	      (loop (+ i 1)))))
-      res)))
-
-;; and the other way round...
-
-(define (make-vector->enum-alist enum-vector converter)
-  (lambda (vector extra-arg)
-    (let loop ((i 0))
-      (if (< i (vector-length vector))
-	  (begin
-	    (vector-set! vector
-			 i
-			 ((converter i extra-arg) (vector-ref vector i)))
-	    (loop (+ i 1)))
-	  (map cons
-	       (vector->list enum-vector)
-	       (vector->list vector))))))
-
-;;
-
-(define-exported-binding "*symbol-now*" 'now)
-
-
-;; alist-split returns multiple values. the first values are all associations 
-;; of the keys. and additionaly the "rest" of the alist as one value.
-
-(define (alist-split alist key-def-list)
-  (let ((keys (map car key-def-list)))
-    (let ((vals (map (lambda (key)
-		       (let ((v (assq key alist)))
-			 (cdr (if v v (assq key key-def-list)))))
-		     keys))
-	  (rest (fold-right (lambda (this rest)
-			      (if (memq (car this) keys)
-				  rest
-				  (cons this rest)))
-			    '()
-			    alist)))
-      (apply values (append vals (list rest))))))
-
-;; compagnion to the XLib constant "None" which is defined as "0L"
-
-(define (none-resource? obj)
-  (eq? obj none-resource))
-
-(define none-resource 'none)
-
 ;;
 
 (define (vector-map! f v)
@@ -76,3 +8,4 @@
 	    (vector-set! v i (f (vector-ref v i)))
 	    (loop (+ i 1)))
 	  v))))
+

scheme/xlib/pixmap-type.scm

@@ -4,17 +4,10 @@
   (really-make-pixmap tag Xpixmap display) 
   pixmap? 
   (tag pixmap-tag pixmap-set-tag!)
-  (Xpixmap real-pixmap-Xpixmap pixmap-set-Xpixmap!)
+  (Xpixmap pixmap-Xpixmap pixmap-set-Xpixmap!)
   (display pixmap-display pixmap-set-display!))
 
-(define (pixmap-Xpixmap pixmap)
-  (if (none-resource? pixmap)
-      0
-      (real-pixmap-Xpixmap pixmap)))
-
 (define (make-pixmap Xpixmap display finalize?)
-  (if (= 0 Xpixmap)
-      none-resource
   (let ((maybe-pixmap (pixmap-list-find Xpixmap)))
     (if maybe-pixmap
 	maybe-pixmap
@@ -23,9 +16,7 @@
 	      (add-finalizer! pixmap free-pixmap)
 	      (add-finalizer! pixmap pixmap-list-delete!))
 	  (pixmap-list-set! Xpixmap pixmap)
-	      pixmap)))))
+	  pixmap))))
-
-;; ...
 
 (define (free-pixmap pixmap)
   (let ((Xdisplay (display-Xdisplay (pixmap-display pixmap)))

scheme/xlib/pixmap.scm

@@ -14,6 +14,15 @@
 (import-lambda-definition %create-pixmap (Xdisplay Xdrawable w h depth)
   "scx_Create_Pixmap")
 
+;; Special pixmap values
+
+(define (special-pixmap:none dpy)
+  (make-pixmap 0 dpy #f))
+(define (special-pixmap:copy-from-parent dpy)
+  (make-pixmap 0 dpy #f))
+(define (special-pixmap:parent-relative dpy)
+  (make-pixmap 1 dpy #f))
+
 ;; create-bitmap-from-data creates a new pixmap, consisting of the
 ;; image found in data, which has to be a string. Such an image can be
 ;; generated with write-bitmap-file. See XCreateBitmapFromData.

scheme/xlib/text.scm

@@ -161,7 +161,7 @@
 			(not (list? text-or-font)))
 		   (cons (if (font? (car text-or-font))
 			     (font-Xfont (car text-or-font))
-			     'none)
+			     0)
 			 (cdr text-or-font)))
 		  (else (text->internal-text text-or-font
 					     format))))

scheme/xlib/types.scm

@@ -269,10 +269,11 @@
   set-window-attributes
   set-window-attribute-name
   set-window-attribute-index
-  ;; don't change the order of the attributes!
+  ;; don't change the order of the attributes!  background-pixmap can
-  ;; special values: background-pixmap can be a pixmap,
+  ;; be a pixmap including (special-pixmap:none dpy) and
-  ;; 'parent-relative or 'none. border-pixmap can be a pixmap or
+  ;; (special-pixmap:parent-relative dpy) border-pixmap can be a
-  ;; 'copy-from-parent.
+  ;; pixmap or (special-pixmap:copy-from-parent dpy)
+
   (background-pixmap background-pixel border-pixmap border-pixel
    bit-gravity gravity backing-store backing-planes backing-pixel
    override-redirect save-under event-mask do-not-propagate-mask colormap
@@ -293,19 +294,9 @@
    set-window-attribute-index
    (lambda (attr)
      (cond
-      ((eq? attr (set-window-attribute background-pixmap))
+      ((or (eq? attr (set-window-attribute background-pixmap))
-       (lambda (background)
+	   (eq? attr (set-window-attribute border-pixmap)))
-	 (cond
+       pixmap-Xpixmap)
-	  ((pixmap? background) (pixmap-Xpixmap background))
-	  ((eq? background 'parent-relative) 1)
-	  ((eq? background 'none) 0)
-	  (else (error "invalid background-pixmap" background)))))
-      ((eq? attr (set-window-attribute border-pixmap))
-       (lambda (border)
-	 (cond
-	  ((pixmap? border) (pixmap-Xpixmap border))
-	  ((eq? border 'copy-from-parent) 0)
-	  (else (error "invalid border-pixmap" border)))))
       ((or (eq? attr (set-window-attribute background-pixel))
 	   (eq? attr (set-window-attribute border-pixel))
 	   (eq? attr (set-window-attribute backing-pixel))

scheme/xlib/window-type.scm

@@ -8,13 +8,17 @@
   (display window-display window-set-display!))
 
 (define (window-Xwindow window)
-  (if (none-resource? window)
+  (real-window-Xwindow window))
-      0
+
-      (real-window-Xwindow window)))
+(define-record-discloser :window
+  (lambda (window)
+    (let ((tag (window-tag window))
+	  (ID (window-Xwindow window)))
+      (if tag
+	  `(Window ,tag)
+	  `(Window ,ID)))))
 
 (define (make-window Xwindow display finalize?)
-  (if (= 0 Xwindow)
-      none-resource
   (let ((maybe-window (window-list-find Xwindow)))
     (if maybe-window
 	maybe-window
@@ -23,11 +27,32 @@
 	      (add-finalizer! window destroy-window)
 	      (add-finalizer! window window-list-delete!))
 	  (window-list-set! Xwindow window)
-	      window)))))
+	  window))))
 
-;; The destroy-window function destroys the specified window as well as all of 
+;; Special windows that can be passed to some functions.
-;; its subwindows and causes the X server to generate a destroy-notify event for
+
-;; each window. See XDestroyWindow
+(define (special-window:none dpy) (make-window 0 dpy #f))
+(define (special-window:pointer-window dpy) (make-window 0 dpy #f))
+(define (special-window:input-focus dpy) (make-window 1 dpy #f))
+(define (special-window:pointer-root dpy) (make-window 1 dpy #f))
+
+; (define-syntax special-window ; (special-window none dpy)
+;   (lambda (form rename compare)
+;     (let ((id (cadr form))
+; 	  (dpy (caddr form))
+; 	  (%make-window (rename 'make-window))
+; 	  (%error (rename 'error)))
+;       (case id
+; 	((none) `(,%make-window 0 ,dpy #f))
+; 	((pointer-window) `(,%make-window 0 ,dpy #f))
+; 	((input-focus) `(,%make-window 1 ,dpy #f))
+; 	((pointer-root) `(,%make-window 1 ,dpy #f))
+; 	(else `(,%error "Undefined special-window identifier" ',id)))))
+;   (make-window error))
+
+;; The destroy-window function destroys the specified window as well
+;; as all of its subwindows and causes the X server to generate a
+;; destroy-notify event for each window. See XDestroyWindow
 
 (define (destroy-window window)
   (let ((Xdisplay (display-Xdisplay (window-display window)))

scheme/xlib/wm.scm

@@ -53,10 +53,7 @@
 
 (define (set-input-focus display window revert-to time)
   (%set-input-focus (display-Xdisplay display)
-		    (case window
+		    (window-Xwindow window)
-		      ((none) 0)
-		      ((pointer-root) 1)
-		      (else (window-Xwindow window)))
 		    (revert-to->integer revert-to)
 		    time))
 
@@ -100,22 +97,25 @@
 				    Xsrc-win src-x src-y src-width src-height)
   "scx_General_Warp_Pointer")
 
-;; warp-pointer calls general-warp-pointer with using 'none as the
+;; warp-pointer calls general-warp-pointer with using
-;; src-win and 0 for the src-* coordinates. The display is taken from
+;; (special-window:none dpy) as the src-win and 0 for the src-*
-;; dst-window.
+;; coordinates. The display is taken from dst-window.
 
 (define (warp-pointer dst-window dst-x dst-y)
   (general-warp-pointer (window-display dst-window)
 			dst-window dst-x dst-y
-			'none 0 0 0 0))
+			(special-window:none (window-display dst-window))
+			0 0 0 0))
 
 ;; warp-pointer-relative uses general-warp-pointer to move the pointer
 ;; by x-offset and y-offset away from it's current position.
 
 (define (warp-pointer-relative display x-offset y-offset)
   (general-warp-pointer display
-			'none x-offset y-offset
+			(special-window:none display)
-			'none 0 0 0 0))
+			x-offset y-offset
+			(special-window:none display)
+			0 0 0 0))
 
 ;; bell rings the bell on the keyboard on the specified display, if
 ;; possible. The optional percent argument specifies the volume in a