scx/scheme/xlib/event.scm

(define (event-ready? display)
  (char-ready? (display-message-inport display)))

(define (complete-event event)
  (let* ((type (event-type event))
	 (args (event-args event))
	 (comp (lambda (idx func)
		 (vector-set! args idx
			      (func (vector-ref args idx))))))
    ;; for all types
    (comp 2 (lambda (Xdisplay) ;; Display the event was read from
	      (make-display Xdisplay #f)))
    (comp 3 (lambda (Xwin) ;; event-window it is reported relative to
	      (make-window Xwin (vector-ref args 2) #f)))
    (let* ((display (vector-ref args 2))
	   (window (vector-ref args 3))
	   (sidx 4) ;; start index of event-dependand fields
	   (make-window* (lambda (Xwindow)
			   (make-window Xwindow display #f))))
      ;; special entries
      (case type
	((key-press key-release button-press button-release motion-notify) 
	 ;; root window that the event occured on
	 (comp (+ sidx 0) make-window*)
	 ;; child window
	 (comp (+ sidx 1) make-window*))
	 ;; time in milliseconds ?? ...
	((enter-notify leave-notify)
	 (comp (+ sidx 0) make-window*) ;; root window
	 (comp (+ sidx 1) make-window*));; subwindow
	 ;; time??
	((create-notify destroy-notify unmap-notify map-notify map-request 
	  gravity-notify circulate-request)
	 (comp (+ sidx 0) make-window*))
	((reparent-notify configure-request)
	 (comp (+ sidx 0) make-window*)
	 (comp (+ sidx 1) make-window*))
	((property-notify selection-clear)
	 (comp (+ sidx 0) make-atom)) ;;??
	 ;; time??
	((selection-request)
	 (comp (+ sidx 0) make-window*)
	 (comp (+ sidx 1) make-atom) ;;??
	 (comp (+ sidx 2) make-atom)
	 (comp (+ sidx 3) make-atom))
	((selection-notify)
	 (comp (+ sidx 0) make-atom)
	 (comp (+ sidx 1) make-atom)
	 (comp (+ sidx 2) make-atom))
	((colormap-notify) ;;??
	 (comp (+ sidx 0) (lambda (Xcolormap)
			    (make-colormap Xcolormap #f))))
	((client-message)
	 (comp (+ sidx 0) make-atom)) ;;??
	) ;; case end
	 
      event)))

(define (next-event display)
  (let ((r (%next-event (display-Xdisplay display))))
    (complete-event (make-event (car r)
				(cdr r)))))

(import-lambda-definition %next-event (Xdisplay)
  "Next_Event")

(define (peek-event display)
  (let ((r (%peek-event (display-Xdisplay display))))
    (complete-event (make-event (car r)
				(cdr r)))))

(import-lambda-definition %peek-event (Xdisplay)
  "Peek_Event")

(define (events-pending display)
  (%events-pending (display-Xdisplay display)))
;  (if (event-ready? display)
;      (%events-pending (display-Xdisplay display))
;      0))

(import-lambda-definition %events-pending (Xdisplay)
  "Events_Pending")

(define (get-motion-events window from-time to-time)
  (%get-motion-events (display-Xdisplay (window-display window))
		      (window-Xwindow window)
		      from-time to-time))

(import-lambda-definition %get-motion-events (Xdisplay Xwindow from to)
  "Get_Motion_Events")