diff --git a/scheme/xlib/display.scm b/scheme/xlib/display.scm index 1add966..a0e3676 100644 --- a/scheme/xlib/display.scm +++ b/scheme/xlib/display.scm @@ -26,38 +26,22 @@ (define-exported-binding "scx-display" :display) -;(define (wakeup-display dpy) -; (placeholder-set! dpy #t)) +(define (wakeup-display dpy) + (write-char #\x (cdr (display:wakeup dpy)))) -;(define (sleep-display dpy) -; (let ((ph (make-placeholder))) -; (set-display:wakeup! dpy ph) -; (placeholder-value ph))) +(define (display-wakeup-inport dpy) + (car (display:wakeup dpy))) (define (initialize-display dpy) -; (set-display:wakeup! dpy (make-placeholder)) -; ;; spawn a thread that weaks up a waiting wait-event call if the -; ;; inport has data available -; (spawn (lambda () -; (let loop () -; (block-on-message-inport dpy) -; (wakeup-display dpy) -; (loop)))) - ;; the after-function may also send a wakup - #t) + (call-with-values pipe + (lambda (r w) + (set-display:wakeup! dpy (cons r w))))) (define-exported-binding "scx-initialize-display" initialize-display) (define (display-message-inport display) (fdes->inport (display:connection-number display))) -(define (block-on-message-inport dpy . maybe-timeout) - (let ((port (display-message-inport dpy))) - (call-with-values - (lambda () (apply select (vector port) (vector) (vector) maybe-timeout)) - (lambda (ready-read ready-write ex) - (member port (vector->list ready-read)))))) - (define-enumerated-type byte-order :byte-order byte-order? byte-orders byte-order-name byte-order-index (lsb-first msb-first)) @@ -178,10 +162,10 @@ ((display:after-function display) display) ;; else the default behaviour ;; TODO: check if this is the real one (display-flush display)) - ) + ;; if events are in the queue now, then wakeup a wait-event call - ;;(if (> (events-queued display (queued-mode already)) 0) - ;; (wakeup-display display))) + (if (> (events-queued display (queued-mode already)) 0) + (wakeup-display display))) (define-exported-binding "scx-general-after-function" general-after-function) diff --git a/scheme/xlib/event.scm b/scheme/xlib/event.scm index 70243d5..05bf885 100644 --- a/scheme/xlib/event.scm +++ b/scheme/xlib/event.scm @@ -7,24 +7,29 @@ (if (> (events-queued dpy (queued-mode after-flush)) 0) (next-event dpy) (begin - ;;(sleep-display dpy) - (block-on-message-inport dpy 0.1) + (really-wait-event dpy) (wait-event dpy)))) -;(define (block-on-message-inport dpy) ; needs ports, locks -; (let ((port (display-message-inport dpy))) -; (disable-interrupts!) -; (if (not (char-ready? port)) -; (begin -; (obtain-lock (port-lock port)) -; (add-pending-channel (port->channel port)) -; (wait-for-channel (port->channel port)) ;; enables interrupts -; (release-lock (port-lock port))) -; (enable-interrupts!)))) - -;;; Only here until scsh provides us with select -;(import-lambda-definition add-pending-channel (channel) -; "scx_add_pending_channel") +(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 *********************