scx/scheme/xlib/event.scm

;; Thread-safe event reading *****************************************

;; wait-event blocks the current thread until an event is available,
;; and then it returns this new event.

(define (wait-event dpy)
  (if (> (events-queued dpy (queued-mode after-flush)) 0)
      (next-event dpy)
      (begin
	(really-wait-event dpy)
	(wait-event dpy))))

(define (really-wait-event dpy . maybe-timeout)
  ;; selects on the port to the X-server and on the internal wakeup
  ;; pipe. We get woke up, if a Xlib-call reads events and puts them
  ;; in the Xlib-internal event queue in our back. See
  ;; general-after-function.
  (let* ((message-port (display-message-inport dpy))
	 (wakeup-port (display-wakeup-inport dpy))
	 (l (select-port-channels (if (null? maybe-timeout)
				      #f
				      (car maybe-timeout))
				  message-port
				  wakeup-port)))
    ;; read all characters from the wakeup-port
    (if (member wakeup-port l)
	(let loop ()
	  (if (char-ready? wakeup-port)
	      (begin
		(read-char wakeup-port)
		(loop)))))
    (member message-port l)))

;; How to find out if there are events available *********************

(define-enumerated-type queued-mode :queued-mode
  queued-mode? queued-modes queued-mode-name queued-mode-index
  (already after-reading after-flush))

(define-exported-binding "scx-queued-mode" :queued-mode)

(import-lambda-definition events-queued (display mode)
  "scx_Events_Queued")

(define (event-ready? display)
  (or (> (events-queued display (queued-mode already)) 0)
      (char-ready? (display-message-inport display))))

;; events-pending is identical to events-queued with after-flush
;; mode.

(import-lambda-definition events-pending (display)
  "scx_Events_Pending")

;; Other event reading ***********************************************

(import-lambda-definition next-event (display)
  "scx_Next_Event")

(import-lambda-definition peek-event (display)
  "scx_Peek_Event")

;; returns a list of (time . (x . y)) elements
(import-lambda-definition get-motion-events (display window from to)
  "scx_Get_Motion_Events")

;; Sending events ****************************************************

(import-lambda-definition send-event (display window propagate mask event)
  "scx_Send_Event")