- added wait-event

- event-args now returns an alist of the event fields.

scheme/xlib/event.scm

@@ -54,8 +54,63 @@
 	 (comp (+ sidx 0) make-atom)) ;;??
 	) ;; case end
 	 
+      (event-set-args! event (event-args->alist event))
       event)))
 
+(define (event-args->alist event)
+  (let ((type (event-type event)))
+    (map cons
+	 (append
+	  ;; these fields belong to all events
+	  '(serial send-event? display) ; the window is named differently
+	  (case type
+	    ((key-press key-release button-press button-release motion-notify)
+	     (append '(window root-window sub-window time x y x-root y-root 
+			      state)
+		     (case type
+		       ((key-press key-release) '(key-code))
+		       ((button-press button-release) '(button))
+		       ((motion-notify) '(is-hint?)))
+		     '(same-screen?)))
+	    ((enter-notify leave-notify)
+	     '(window root-window sub-window time x y x-root y-root cross-mode 
+		      cross-detail same-screen? focus? button-mask))
+	    ((focus-in focus-out) '(window cross-mode focus-detail))
+	    ((keymap-notify) '(window keymap))
+	    ((expose) '(window x y width height count))
+	    ((graphics-expose) '(window x y width height count major-code 
+					minor-code))
+	    ((no-expose) '(window major-code minor-code))
+	    ((visibility-notify) '(window visibility-state))
+	    ((create-notify) '(root-window window x y width height border-width 
+					   override-redirect?))
+	    ((destroy-notify) '(event-window window))
+	    ((unmap-notify) '(event-window window from-configure))
+	    ((map-notify) '(event-window window override-redirect?))
+	    ((map-request) '(parent-window window))
+	    ((reparent-notify) '(event-window parent-window window x y 
+					      override-redirect?))
+	    ((configure-notify) '(event-window window x y width height 
+					       border-width above-window 
+					       override-redirect?))
+	    ((configure-request) '(parent-window window x y width height 
+						 border-width above-window 
+						 override-redirect?))
+	    ((gravity-notify) '(event-window window x y))
+	    ((resize-request) '(window width height))
+	    ((circulate-notify) '(event-window window place))
+	    ((circulate-request) '(parent-window window place))
+	    ((property-notify) '(window atom time property-state))
+	    ((selection-clear) '(window selection-atom time))
+	    ((selection-request) '(owner-window requestor-window selection-atom 
+						target-atom property-atom time))
+	    ((selection-notify) '(requestor-window selection-atom target-atom 
+						   property-atom time))
+	    ((colormap-notify) '(window colormap new? colormap-installed?))
+	    ((client-message) '(window message-type message-data))
+	    ((mapping-notify) '(window request keycode count))))
+	 (vector->list (event-args event)))))
+
 (define (next-event display)
   (let ((r (%next-event (display-Xdisplay display))))
     (complete-event (make-event (car r)
@@ -88,3 +143,16 @@
 
 (import-lambda-definition %get-motion-events (Xdisplay Xwindow from to)
   "scx_Get_Motion_Events")
+
+;; wait-event blocks the current thread until an event is available,
+;; and then it returns this new event.
+;; In future releases this should be done with a select. But for now
+;; we just do a loop with event-ready? and next-event. On this machine
+;; that uses an acceptable amount of about 1% CPU-Time.
+
+(define (wait-event display)
+  (if (event-ready? display)
+      (next-event display)
+      (begin
+	(sleep 20) ; sleep for 20 ms
+	(wait-event display))))