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 make-display) ;; Display the event was read from
    (comp 3 (lambda (Xwin);; event-window it is reported relative to
	      (make-window Xwin (vector-ref args 2))))
    (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))))
      ;; 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) make-colormap)) ;;??
	((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")