80 lines
2.4 KiB
Scheme
80 lines
2.4 KiB
Scheme
(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") |