(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) "scx_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) "scx_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) "scx_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) "scx_Get_Motion_Events")