- fixed some small bugs and typos

- changed error and after-function handling a bit
- added screen caching
- added timeout in wait-event implementation (did not work with multiple threads)

c/xlib/client.c

@@ -131,7 +131,7 @@ s48_value scx_Set_Wm_Class(s48_value dpy, s48_value w, s48_value name,
 #define scx_enter_initial_state(x) S48_ENTER_ENUM(x, "scx-initial-states")
 
 #define scx_extract_wm_hint(x) S48_EXTRACT_ENUM(x, "scx-wm-hint")
-#define scx_enter_wm_hint(x) S48_ENTER_ENUM(x, "scx-wm-hint")
+#define scx_enter_wm_hint(x) S48_ENTER_ENUM(x, "scx-wm-hints")
 
 s48_value scx_enter_wm_hint_alist(XWMHints* p) {
   s48_value res = S48_NULL, t = S48_FALSE;

c/xlib/display.c

@@ -22,6 +22,8 @@ s48_value scx_enter_screen(Screen* scr) {
     S48_DECLARE_GC_PROTECT(1);
     s = s48_make_record(scx_screen);
     S48_GC_PROTECT_1(s);
+    scx_struct_cache_set(scr, &scx_screen_list, s);
+
     S48_RECORD_SET(s, 0, s48_enter_integer((long)scr));
     S48_RECORD_SET(s, 1, scx_enter_display(DisplayOfScreen(scr)));
     S48_RECORD_SET(s, 2, scx_enter_window(RootWindowOfScreen(scr)));
@@ -34,10 +36,10 @@ s48_value scx_enter_screen(Screen* scr) {
     S48_RECORD_SET(s, 9, scx_enter_visual(DefaultVisualOfScreen(scr)));
     S48_RECORD_SET(s, 10, scx_enter_gc(DefaultGCOfScreen(scr)));
     S48_RECORD_SET(s, 11, scx_enter_colormap(DefaultColormapOfScreen(scr)));
-    S48_RECORD_SET(s, 12, scx_enter_pixel(BlackPixelOfScreen(scr)));
+    S48_RECORD_SET(s, 12, scx_enter_pixel(WhitePixelOfScreen(scr)));
-    S48_RECORD_SET(s, 13, scx_enter_pixel(WhitePixelOfScreen(scr)));
+    S48_RECORD_SET(s, 13, scx_enter_pixel(BlackPixelOfScreen(scr)));
-    S48_RECORD_SET(s, 14, s48_enter_integer(MinCmapsOfScreen(scr)));
+    S48_RECORD_SET(s, 14, s48_enter_integer(MaxCmapsOfScreen(scr)));
-    S48_RECORD_SET(s, 15, s48_enter_integer(MaxCmapsOfScreen(scr)));
+    S48_RECORD_SET(s, 15, s48_enter_integer(MinCmapsOfScreen(scr)));
     S48_RECORD_SET(s, 16, scx_enter_backing_store(DoesBackingStore(scr)));
     S48_RECORD_SET(s, 17, S48_ENTER_BOOLEAN(DoesSaveUnders(scr)));
     S48_RECORD_SET(s, 18, scx_enter_event_mask(EventMaskOfScreen(scr)));
@@ -50,7 +52,8 @@ s48_value scx_display_list = S48_NULL;
 
 static int scx_after_function_wrapper(Display* dpy) {
   s48_value display = scx_enter_display(dpy);
-  s48_value fun = SCX_DISPLAY_AFTER_FUNCTION(display);
+  s48_value fun = S48_SHARED_BINDING_REF(
+		   s48_get_imported_binding("scx-general-after-function"));
   s48_call_scheme(fun, 1, display);
   return 0;
 }
@@ -84,10 +87,11 @@ s48_value scx_enter_display(Display* dpy) {
     for (i = ScreenCount(dpy)-1; i >= 0; i--)
       l = s48_cons(scx_enter_screen(ScreenOfDisplay(dpy, i)), l);
     S48_RECORD_SET(d, 13, l);
-    S48_RECORD_SET(d, 14, S48_SHARED_BINDING_REF(
+    S48_RECORD_SET(d, 14, S48_FALSE);
-      s48_get_imported_binding("scx-default-after-function")));
     XSetAfterFunction(dpy, &scx_after_function_wrapper);
-
+    S48_RECORD_SET(d, 15, S48_FALSE); // wakeup placeholder
+    s48_call_scheme(S48_SHARED_BINDING_REF(s48_get_imported_binding(
+      "scx-initialize-display")), 1, d);
     S48_GC_UNPROTECT();
   }
   return d;

c/xlib/error.c

@@ -56,43 +56,21 @@ extern int _XDefaultError();
 static s48_value internal_x_error_handler_binding = S48_FALSE;
 
 static int error_handler_wrapper(Display* dpy, XErrorEvent* e) {
+  char handled = 0;
   if ((internal_x_error_handler_binding != S48_FALSE) &&
-      (S48_SHARED_BINDING_REF(internal_x_error_handler_binding) != S48_FALSE))
+      (S48_SHARED_BINDING_REF(internal_x_error_handler_binding) != S48_FALSE)){
-    s48_call_scheme(S48_SHARED_BINDING_REF(internal_x_error_handler_binding),
+    s48_value v =
-		    2,
+      s48_call_scheme(S48_SHARED_BINDING_REF(internal_x_error_handler_binding),
-		    scx_enter_display(dpy),
+		      2,
-		    scx_enter_x_error(e));
+		      scx_enter_display(dpy),
-  else
+		      scx_enter_x_error(e));
+    handled = (v != S48_FALSE);
+  }
+  if (!handled)
     _XDefaultError(dpy, e);
   return 0;
 }
 
-/*
-s48_value scx_Set_Error_Handler(s48_value fun) {
-  s48_value maybe_previous = internal_error_handler_binding;
-  int (*previous)() = NULL;
-  if (S48_POINTER_P(fun))
-    previous = XSetErrorHandler(S48_EXTRACT_POINTER(fun));
-  else if (S48_CLOSURE_P(fun)) {
-    previous = XSetErrorHandler(&error_handler_wrapper);
-    internal_error_handler_binding = fun;
-  } // TODO else error
-  if (previous == &error_handler_wrapper)
-    return maybe_previous;
-  else
-    return S48_ENTER_POINTER(previous);
-}
-
-s48_value scx_Call_C_Error_Handler(s48_value pointer, s48_value display,
-				   s48_value event) {
-  int (*procedure)() = S48_EXTRACT_POINTER(pointer);
-  XErrorEvent ev; int result;
-  scx_extract_x_error(event, &ev);
-  result = procedure(scx_extract_display(display), &ev);
-  return s48_enter_integer(result);
-}
-*/
-
 s48_value scx_Get_Error_Text(s48_value display, s48_value code) {
   char buf[1024];
   XGetErrorText(scx_extract_display(display), scx_extract_error_code(code),
@@ -135,11 +113,8 @@ void scx_init_error() {
   S48_GC_PROTECT_GLOBAL(internal_x_error_handler_binding);
   S48_GC_PROTECT_GLOBAL(internal_x_fatal_error_handler_binding);
 
-  //S48_EXPORT_FUNCTION(scx_Set_Error_Handler);
-  //S48_EXPORT_FUNCTION(scx_Call_C_Error_Handler);
   S48_EXPORT_FUNCTION(scx_Get_Error_Text);
   S48_EXPORT_FUNCTION(scx_Get_Error_Database_Text);
-  //S48_EXPORT_FUNCTION(scx_Set_IO_Error_Handler);
 
   internal_x_fatal_error_handler_binding =
     s48_get_imported_binding("internal-x-fatal-error-handler");

c/xlib/event-types.c

@@ -27,7 +27,7 @@ s48_value scx_enter_key_event(XKeyEvent* xe) {
   EENTER(9, y, s48_enter_integer);
   EENTER(10, x_root, s48_enter_integer);
   EENTER(11, y_root, s48_enter_integer);
-  EENTER(12, state, scx_enter_state);
+  EENTER(12, state, scx_enter_state_set);
   EENTER(13, keycode, scx_enter_keycode);
   EENTER(14, same_screen, S48_ENTER_BOOLEAN);
   EENTER_END();
@@ -43,7 +43,7 @@ s48_value scx_enter_button_event(XButtonEvent* xe) {
   EENTER(9, y, s48_enter_integer);
   EENTER(10, x_root, s48_enter_integer);
   EENTER(11, y_root, s48_enter_integer);
-  EENTER(12, state, scx_enter_state);
+  EENTER(12, state, scx_enter_state_set);
   EENTER(13, button, scx_enter_button);
   EENTER(14, same_screen, S48_ENTER_BOOLEAN);
   EENTER_END();
@@ -59,7 +59,7 @@ s48_value scx_enter_motion_event(XMotionEvent* xe) {
   EENTER(9, y, s48_enter_integer);
   EENTER(10, x_root, s48_enter_integer);
   EENTER(11, y_root, s48_enter_integer);
-  EENTER(12, state, scx_enter_state);
+  EENTER(12, state, scx_enter_state_set);
   EENTER(13, is_hint, S48_ENTER_BOOLEAN);
   EENTER(14, same_screen, S48_ENTER_BOOLEAN);
   EENTER_END();
@@ -79,7 +79,7 @@ s48_value scx_enter_crossing_event(XCrossingEvent* xe) {
   EENTER(13, detail, scx_enter_notify_detail);
   EENTER(14, same_screen, S48_ENTER_BOOLEAN);
   EENTER(15, focus, S48_ENTER_BOOLEAN);
-  EENTER(16, state, scx_enter_state);
+  EENTER(16, state, scx_enter_state_set);
   EENTER_END();
 }
 
@@ -406,7 +406,7 @@ void scx_extract_key_event(s48_value e, XKeyEvent* xe) {
   EEXTRACT(9, y, s48_extract_integer);
   EEXTRACT(10, x_root, s48_extract_integer);
   EEXTRACT(11, y_root, s48_extract_integer);
-  EEXTRACT(12, state, scx_extract_state);
+  EEXTRACT(12, state, scx_extract_state_set);
   EEXTRACT(13, keycode, scx_extract_keycode);
   EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
   EEXTRACT_END();
@@ -422,7 +422,7 @@ void scx_extract_button_event(s48_value e, XButtonEvent* xe) {
   EEXTRACT(9, y, s48_extract_integer);
   EEXTRACT(10, x_root, s48_extract_integer);
   EEXTRACT(11, y_root, s48_extract_integer);
-  EEXTRACT(12, state, scx_extract_state);
+  EEXTRACT(12, state, scx_extract_state_set);
   EEXTRACT(13, button, scx_extract_button);
   EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
   EEXTRACT_END();
@@ -438,7 +438,7 @@ void scx_extract_motion_event(s48_value e, XMotionEvent* xe) {
   EEXTRACT(9, y, s48_extract_integer);
   EEXTRACT(10, x_root, s48_extract_integer);
   EEXTRACT(11, y_root, s48_extract_integer);
-  EEXTRACT(12, state, scx_extract_state);
+  EEXTRACT(12, state, scx_extract_state_set);
   EEXTRACT(13, is_hint, S48_EXTRACT_BOOLEAN);
   EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
   EEXTRACT_END();
@@ -458,7 +458,7 @@ void scx_extract_crossing_event(s48_value e, XCrossingEvent* xe) {
   EEXTRACT(13, detail, scx_extract_notify_detail);
   EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
   EEXTRACT(15, focus, S48_EXTRACT_BOOLEAN);
-  EEXTRACT(16, state, scx_extract_state);
+  EEXTRACT(16, state, scx_extract_state_set);
   EEXTRACT_END();
 }
 

c/xlib/gcontext.c

@@ -41,8 +41,7 @@ s48_value scx_enter_charstruct(XCharStruct* cs) {
 s48_value scx_enter_fontstruct(XFontStruct* fs) {
   int i;
   s48_value plist = S48_NULL, t = S48_NULL;
-  s48_value res =
+  s48_value res = s48_make_record(scx_fontstruct);
-    s48_make_record(s48_get_imported_binding("scx-font-struct"));
   S48_DECLARE_GC_PROTECT(3);
   S48_GC_PROTECT_3(res, plist, t);
   S48_RECORD_SET(res, 0, S48_ENTER_POINTER(fs));

c/xlib/property.c

@@ -129,14 +129,17 @@ s48_value scx_enter_property(Atom type, int format, char* data,
   switch (format) {
   case 8:
     S48_RECORD_SET(p, 2, s48_enter_substring(data, nelements));
+    break;
   case 16:
     for (i = nelements-1; i >= 0; i--)
       l = s48_cons(s48_enter_integer(((short*)data)[i]), l);
     S48_RECORD_SET(p, 2, l);
+    break;
   case 32:
     for (i = nelements-1; i >= 0; i--)
       l = s48_cons(s48_enter_integer(((long*)data)[i]), l);
     S48_RECORD_SET(p, 2, l);
+    break;
   }
   S48_GC_UNPROTECT();
   return p;

c/xlib/text.c

@@ -115,16 +115,18 @@ s48_value scx_Draw_Text_16(s48_value display, s48_value drawable,
 
 s48_value scx_Text_Extents(s48_value font_struct, s48_value string) {
   XCharStruct overall;
+  int dir, ascent, descent;
   XTextExtents(scx_extract_fontstruct(font_struct),
 	       s48_extract_string(string),
 	       S48_STRING_LENGTH(string),
-	       NULL, NULL, NULL,
+	       &dir, &ascent, &descent,
 	       &overall);
   return scx_enter_charstruct(&overall);
 }
 
 s48_value scx_Text_Extents_16(s48_value font_struct, s48_value string) {
   XCharStruct overall;
+  int dir, ascent, descent;
   int i, len = s48_list_length(string);
   XChar2b chars[len];
   for (i = 0; i < len; i++) {
@@ -134,7 +136,7 @@ s48_value scx_Text_Extents_16(s48_value font_struct, s48_value string) {
   }
   XTextExtents16(scx_extract_fontstruct(font_struct),
 		 chars, len,
-		 NULL, NULL, NULL,
+		 &dir, &ascent, &descent,
 		 &overall);
   return scx_enter_charstruct(&overall);
 }

c/xlib/types.c

@@ -52,8 +52,9 @@ void scx_struct_cache_set(void* cpointer, s48_value* l, s48_value v) {
 
   // remove all empty and duplicate entries
   while (list != S48_NULL) {
-    s48_value entry = S48_WEAK_POINTER_REF(S48_CDR(S48_CAR(list)));
+    s48_value entry = S48_CAR(list);
-    if ((entry == S48_FALSE) || (S48_EXTRACT_POINTER(entry) == cpointer))
+    if ((S48_WEAK_POINTER_REF(S48_CDR(entry)) == S48_FALSE) ||
+	(S48_EXTRACT_POINTER(S48_CAR(entry)) == cpointer))
       S48_SET_CDR(previous, S48_CDR(list));
     else
       previous = list;

c/xlib/window.c

@@ -184,10 +184,9 @@ s48_value scx_Configure_Window(s48_value display, s48_value window,
   return S48_UNSPECIFIC;
 }
 
-s48_value scx_window_attributes;
-
 s48_value scx_enter_window_attributes(XWindowAttributes* WA) {
-  s48_value v = s48_make_record(scx_window_attributes);
+  s48_value v = s48_make_record(
+    s48_get_imported_binding("scx-window-attributes"));
   S48_DECLARE_GC_PROTECT(1);
   S48_GC_PROTECT_1(v);
   S48_RECORD_SET(v, 0, s48_enter_integer(WA->x));
@@ -340,7 +339,7 @@ s48_value scx_Clear_Window(s48_value display, s48_value window) {
   return S48_UNSPECIFIC;
 }
 
-s48_value scx_Query_Tree(s48_value Xwindow, s48_value Xdisplay) {
+s48_value scx_Query_Tree(s48_value display, s48_value window) {
   Window root, parent, *children;
   int i;
   unsigned n;
@@ -348,8 +347,8 @@ s48_value scx_Query_Tree(s48_value Xwindow, s48_value Xdisplay) {
   s48_value c = S48_NULL, res = S48_NULL;
   S48_DECLARE_GC_PROTECT(2);
   
-  if (! XQueryTree (scx_extract_display(Xdisplay),
+  if (! XQueryTree (scx_extract_display(display),
-		    scx_extract_window(Xwindow), 
+		    scx_extract_window(window), 
 		    &root, &parent, &children, &n))
     return S48_FALSE;
 

scheme/xlib/colormap.scm

@@ -23,6 +23,8 @@
   colormap-alloc? colormap-allocs colormap-alloc-name colormap-alloc-index
   (none all))
 
+(define-exported-binding "scx-colormap-alloc" :colormap-alloc)
+
 (import-lambda-definition create-colormap (display window visual alloc)
   "scx_Create_Colormap")
 

scheme/xlib/display.scm

@@ -5,7 +5,7 @@
   (make-display cpointer connection-number protocol-version protocol-revision
 		server-vendor image-byte-order bitmap-unit bitmap-pad
 		bitmap-bit-order vendor-release queue-length name
-		default-screen screens after-function)
+		default-screen screens after-function wakeup)
   display?
   (cpointer display:cpointer)
   (connection-number display:connection-number)
@@ -21,13 +21,43 @@
   (name display:name)
   (default-screen display:default-screen)
   (screens display:screens)
-  (after-function display:after-function set-display:after-function!))
+  (after-function display:after-function set-display:after-function!)
+  (wakeup display:wakeup set-display:wakeup!))
 
 (define-exported-binding "scx-display" :display)
 
+;(define (wakeup-display dpy)
+;  (placeholder-set! dpy #t))
+
+;(define (sleep-display dpy)
+;  (let ((ph (make-placeholder)))
+;    (set-display:wakeup! dpy ph)
+;    (placeholder-value ph)))
+
+(define (initialize-display dpy)
+;  (set-display:wakeup! dpy (make-placeholder))
+;  ;; spawn a thread that weaks up a waiting wait-event call if the
+;  ;; inport has data available
+;  (spawn (lambda ()
+;	   (let loop ()
+;	     (block-on-message-inport dpy)
+;	     (wakeup-display dpy)
+;	     (loop))))
+  ;; the after-function may also send a wakup
+  #t)
+
+(define-exported-binding "scx-initialize-display" initialize-display)
+
 (define (display-message-inport display)
   (fdes->inport (display:connection-number display)))
 
+(define (block-on-message-inport dpy . maybe-timeout)
+  (let ((port (display-message-inport dpy)))
+    (call-with-values
+     (lambda () (apply select (vector port) (vector) (vector) maybe-timeout))
+     (lambda (ready-read ready-write ex)
+       (member port (vector->list ready-read))))))
+
 (define-enumerated-type byte-order :byte-order
   byte-order? byte-orders byte-order-name byte-order-index
   (lsb-first msb-first))
@@ -133,19 +163,27 @@
 
 ;; *** enable or disable synchronization *****************************
 
-(define (synchronize display on?)
+(define (synchronize dpy on?)
   (if on?
-      (set-after-function! display
+      (set-after-function! dpy
-			   (lambda (display) (display-sync display #f)))
+			   (lambda (dpy)
-      (set-after-function! display default-after-function)))
+			     (display-sync dpy #f)))
+      (set-after-function! dpy #f)))
 
 ;; returns the previous after-function. An after-function is called
 ;; with the display object.
 
-(define (default-after-function display) ;; TODO: check if this is the real one
+(define (general-after-function display)
-  (display-flush display))
+  (if (display:after-function display)
+      ((display:after-function display) display)
+      ;; else the default behaviour ;; TODO: check if this is the real one
+      (display-flush display))
+  )
+  ;; if events are in the queue now, then wakeup a wait-event call
+  ;;(if (> (events-queued display (queued-mode already)) 0)
+  ;;    (wakeup-display display)))
 
-(define-exported-binding "scx-default-after-function" default-after-function)
+(define-exported-binding "scx-general-after-function" general-after-function)
 
 (define (set-after-function! display fun)
   (let ((prev (display:after-function display)))

scheme/xlib/error.scm

@@ -211,7 +211,11 @@
 ;; *** default error handlers ****************************************
 
 (define *x-error-handler* #f)
-(define-exported-binding "internal-x-error-handler" *x-error-handler*)
+(define (internal-x-error-handler display error)
+  (if *x-error-handler*
+      (*x-error-handler* display error)
+      #f))
+(define-exported-binding "internal-x-error-handler" internal-x-error-handler)
 
 (define (set-error-handler! handler)
   (let ((old-handler *x-error-handler*))
@@ -241,8 +245,12 @@
 ;  "scx_Set_IO_Error_Handler")
 
 (define *x-fatal-error-handler* #f)
+(define (internal-x-fatal-error-handler display)
+  (if *x-fatal-error-handler*
+      (*x-fatal-error-handler* display)
+      #f))
 (define-exported-binding "internal-x-fatal-error-handler"
-  *x-fatal-error-handler*)
+  internal-x-fatal-error-handler)
 
 (define (set-fatal-error-handler! handler)
   (let ((old-handler *x-fatal-error-handler*))

scheme/xlib/event-types.scm

@@ -392,7 +392,8 @@
 
 (define-record-type graphics-expose-event :graphics-expose-event
   (create-graphics-expose-event type serial send-event? display drawable
-				     x y width height major-code minor-code)
+				     x y width height count major-code
+				     minor-code)
   graphics-expose-event?
   (type graphics-expose-event-type)
   (serial graphics-expose-event-serial)
@@ -403,6 +404,7 @@
   (y graphics-expose-event-y)
   (width graphics-expose-event-width)
   (height graphics-expose-event-height)
+  (count graphics-expose-event-count)
   (major-code graphics-expose-event-major-code)
   (minor-code graphics-expose-event-minor-code))
 

scheme/xlib/event.scm

@@ -4,17 +4,12 @@
 ;; and then it returns this new event.
 
 (define (wait-event dpy)
-  (if (not (> (events-queued dpy (queued-mode after-flush)) 0))
+  (if (> (events-queued dpy (queued-mode after-flush)) 0)
-      (block-on-message-inport dpy))
+      (next-event dpy)
-  (next-event dpy))  
+      (begin
-
+	;;(sleep-display dpy)
-(define (block-on-message-inport dpy)
+	(block-on-message-inport dpy)
-  (let ((port (display-message-inport dpy)))
+	(wait-event dpy))))
-    (call-with-values
-     (lambda () (select (vector port) (vector) (vector)))
-     (lambda (ready-read ready-write ex)
-       (if (not (member port (vector->list ready-read)))
-	   (block-on-message-inport dpy))))))
 
 ;(define (block-on-message-inport dpy) ; needs ports, locks
 ;  (let ((port (display-message-inport dpy)))
@@ -27,7 +22,7 @@
 ;	  (release-lock (port-lock port)))
 ;	(enable-interrupts!))))
 
-;;;; Only here until scsh provides us with select
+;;; Only here until scsh provides us with select
 ;(import-lambda-definition add-pending-channel (channel)
 ;  "scx_add_pending_channel")
 

scheme/xlib/font.scm

@@ -44,7 +44,7 @@
   (ascent font-struct:ascent)
   (descent font-struct:descent))
 
-(define-exported-binding "scx-font-struct" :font-struct)
+(define-exported-binding "scx-fontstruct" :font-struct)
 
 ;; *** load or unload fonts ******************************************
 

scheme/xlib/graphics.scm

@@ -61,6 +61,11 @@
   (width rectangle:width set-rectangle:width!)
   (height rectangle:height set-rectangle:height!))
 
+(define-record-discloser :rectangle
+  (lambda (r)
+    `(Rectangle ,(rectangle:x r) ,(rectangle:y r)
+		,(rectangle:width r) ,(rectangle:height r))))
+
 (define-exported-binding "scx-rectangle" :rectangle)
 
 (import-lambda-definition draw-rectangles (display drawable gc rectangles)

scheme/xlib/sync-event.scm

@@ -29,11 +29,11 @@
 (define *most-recent-sync-x-event* (make-sync-x-event 'no-event))
 (define *most-recent-lock* (make-lock))
 
-(define (init-sync-x-events display)
+(define (init-sync-x-events dpy)
   (spawn
    (lambda ()
      (let lp ()
-       (let ((next (wait-event display)))
+       (let ((next (wait-event dpy)))
 	 (with-lock *most-recent-lock*
 		    (lambda ()
 		      (set-next-sync-x-event! *most-recent-sync-x-event*
@@ -93,8 +93,9 @@
 	   (lambda (same rest)
 	     (let ((mask (event-masks-union (map request:event-mask
 						 (cons r same)))))
-	       (display-select-input (request:display r) (request:window r)
+	       (if (window-exists? (request:display r) (request:window r))
-				     mask))
+		   (display-select-input (request:display r) (request:window r)
+					 mask)))
 	     (loop rest)))))))
 
 (define (call-with-event-channel display window event-mask fun)
@@ -195,36 +196,36 @@
     (eq? type (event-type resize-request)))
    ((eq? mask-item (event-mask-item structure-notify))
     (or (and (eq? type (event-type circulate-notify))
-	     (eq? window (circulate-event-window event)))
+	     (eq? window (circulate-event-event event)))
 	(and (eq? type (event-type configure-notify))
-	     (eq? window (configure-event-window event)))
+	     (eq? window (configure-event-event event)))
 	(and (eq? type (event-type destroy-notify))
-	     (eq? window (destroy-window-event-window event)))
+	     (eq? window (destroy-window-event-event event)))
 	(and (eq? type (event-type gravity-notify))
-	     (eq? window (gravity-event-window event)))
+	     (eq? window (gravity-event-event event)))
 	(and (eq? type (event-type map-notify))
-	     (eq? window (map-event-window event)))
+	     (eq? window (map-event-event event)))
 	(and (eq? type (event-type reparent-notify))
-	     (eq? window (reparent-event-window event)))
+	     (eq? window (reparent-event-event event)))
 	(and (eq? type (event-type unmap-notify))
-	     (eq? window (unmap-event-window event)))))
+	     (eq? window (unmap-event-event event)))))
    ((eq? mask-item (event-mask-item substructure-notify))
     (or (and (eq? type (event-type circulate-notify))
-	     (not (eq? window (circulate-event-window event))))
+	     (eq? window (circulate-event-event event)))
 	(and (eq? type (event-type configure-notify))
-	     (not (eq? window (configure-event-window event))))
+	     (eq? window (configure-event-event event)))
 	(and (eq? type (event-type create-notify))
-	     (not (eq? window (create-window-event-window event))))
+	     (eq? window (create-window-event-parent event)))
 	(and (eq? type (event-type destroy-notify))
-	     (not (eq? window (destroy-window-event-window event))))
+	     (eq? window (destroy-window-event-event event)))
 	(and (eq? type (event-type gravity-notify))
-	     (not (eq? window (gravity-event-window event))))
+	     (eq? window (gravity-event-event event)))
 	(and (eq? type (event-type map-notify))
-	     (not (eq? window (map-event-window event))))
+	     (eq? window (map-event-event event)))
 	(and (eq? type (event-type reparent-notify))
-	     (not (eq? window (reparent-event-window event))))
+	     (eq? window (reparent-event-event event)))
 	(and (eq? type (event-type unmap-notify))
-	     (not (eq? window (unmap-event-window event))))))
+	     (eq? window (unmap-event-event event)))))
    ((eq? mask-item (event-mask-item substructure-redirect))
     (or (eq? type (event-type circulate-request))
 	(eq? type (event-type configure-request))

scheme/xlib/window.scm

@@ -129,8 +129,8 @@
   "scx_Configure_Window")
 
 (define (make-win-configurer change)
-  (lambda (window value)
+  (lambda (display window value)
-    (configure-window window (list (cons change value)))))
+    (configure-window display window (list (cons change value)))))
 
 (define set-window-x! (make-win-configurer (window-change x)))
 (define set-window-y! (make-win-configurer (window-change y)))
@@ -205,6 +205,8 @@
   (override-redirect window-attribute:override-redirect)
   (screen window-attribute:screen))
 
+(define-exported-binding "scx-window-attributes" :window-attributes)
+
 (import-lambda-definition get-window-attributes (display window)
   "scx_Get_Window_Attributes")
 
@@ -335,3 +337,19 @@
 				    ;; the pointer or None
 	       (vector-ref q 4)     ;; x and y coordinates
 	       (vector-ref q 5))))) ;; relative to window
+
+;; *** convenience functions *****************************************
+
+(define (window-exists? dpy window)
+  (let ((pe (use-x-error-warnings!)))
+    (let ((result
+	   (call-with-current-continuation
+	    (lambda (return)
+	      (with-handler (lambda (condition punt)
+			      (return #f))
+			    (lambda ()
+			      (query-tree dpy window)
+			      (display-sync dpy #f)
+			      #t))))))
+      (set-error-handler! pe)
+      result)))

scheme/xlib/xlib-interfaces.scm

@@ -45,9 +45,9 @@
 
    display:last-request-read
    default-root-window
+   white-pixel black-pixel
    next-request
    synchronize
-   default-after-function
    set-after-function!
    display-flush
    display-sync
@@ -126,6 +126,8 @@
    query-pointer-state
    query-pointer
 
+   window-exists?
+
    ;; colormap.scm ***************************************************
    make-color color? color:pixel set-color:pixel!
    color:red set-color:red! color:green set-color:green!
@@ -201,6 +203,15 @@
    ;; event-types.scm ************************************************
    (event-type :enumeration)
    (event-mask :syntax)
+
+   (notify-mode :enumeration)
+   (notify-detail :enumeration)
+   (visibility-state :enumeration)
+   (place :enumeration)
+   (property-state :enumeration)
+   (property-format :enumeration)
+   (mapping-request :enumeration)
+
    any-event-type
    any-event-serial
    any-event-send-event?

scheme/xlib/xlib-packages.scm

@@ -19,7 +19,7 @@
 	scheme
 	list-lib
 	srfi-13 ;; strings
-	signals
+	signals handle
 	bitwise
 	external-calls
 	define-record-types