From 2c91c73a1837b912c2a2595918dd11ef80c6d74d Mon Sep 17 00:00:00 2001 From: frese Date: Sun, 17 Mar 2002 15:44:45 +0000 Subject: [PATCH] - the xlib-internal event-queue was not respected in event-ready? and wait-event etc. --- c/xlib/event.c | 11 ++++- scheme/xlib/event.scm | 109 +++++++++++++++++++++++++++--------------- 2 files changed, 79 insertions(+), 41 deletions(-) diff --git a/c/xlib/event.c b/c/xlib/event.c index 40b8806..581a151 100644 --- a/c/xlib/event.c +++ b/c/xlib/event.c @@ -433,8 +433,8 @@ XEvent scx_extract_event(s48_value type, s48_value v) { e.xmap.override_redirect = S48_EXTRACT_BOOLEAN(REF(6)); } break; case MapRequest: { - e.xmaprequest.window = SCX_EXTRACT_WINDOW(REF(4)); - e.xmaprequest.parent = SCX_EXTRACT_WINDOW(REF(5)); + e.xmaprequest.parent = SCX_EXTRACT_WINDOW(REF(4)); + e.xmaprequest.window = SCX_EXTRACT_WINDOW(REF(5)); } break; case ReparentNotify: { e.xreparent.event = SCX_EXTRACT_WINDOW(REF(4)); @@ -603,6 +603,12 @@ s48_value scx_Peek_Event(s48_value Xdisplay) { return scx_enter_event(&e); } +s48_value scx_Events_Queued(s48_value Xdisplay, s48_value mode) { + int r = XEventsQueued(SCX_EXTRACT_DISPLAY(Xdisplay), + s48_extract_integer(mode)); + return s48_enter_integer(r); +} + s48_value scx_Events_Pending(s48_value Xdisplay) { return s48_enter_integer(XPending(SCX_EXTRACT_DISPLAY(Xdisplay))); } @@ -647,6 +653,7 @@ void scx_init_event(void) { S48_EXPORT_FUNCTION(scx_Send_Event); S48_EXPORT_FUNCTION(scx_Next_Event); S48_EXPORT_FUNCTION(scx_Peek_Event); + S48_EXPORT_FUNCTION(scx_Events_Queued); S48_EXPORT_FUNCTION(scx_Events_Pending); S48_EXPORT_FUNCTION(scx_Get_Motion_Events); S48_EXPORT_FUNCTION(scx_add_pending_channel); diff --git a/scheme/xlib/event.scm b/scheme/xlib/event.scm index b5bbfb3..a072a9f 100644 --- a/scheme/xlib/event.scm +++ b/scheme/xlib/event.scm @@ -1,7 +1,14 @@ +;; 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) ; needs ports, locks +(define (wait-event dpy) + (if (not (> (events-queued dpy (queued-mode after-flush)) 0)) + (block-on-message-inport dpy)) + (next-event dpy)) + +(define (block-on-message-inport dpy) ; needs ports, locks (let ((port (display-message-inport dpy))) (disable-interrupts!) (if (not (char-ready? port)) @@ -10,14 +17,69 @@ (add-pending-channel (port->channel port)) (wait-for-channel (port->channel port)) ;; enables interrupts (release-lock (port-lock port))) - (enable-interrupts!)) - (next-event dpy))) + (enable-interrupts!)))) + +;;; Only here until scsh provides us with select +(import-lambda-definition add-pending-channel (channel) + "scx_add_pending_channel") + +;; How to find out if there are events available ********************* (define (event-ready? display) - (char-ready? (display-message-inport display))) + (or (> (events-queued display (queued-mode already)) 0) + (char-ready? (display-message-inport display)))) -(define (send-event window propagate? event-mask event) - (let ((Xdisplay (display-Xdisplay (window-display window))) +(define (events-queued display mode) + (%events-queued (display-Xdisplay display) + (queued-mode->integer mode))) + +(import-lambda-definition %events-queued (Xdisplay mode) + "scx_Events_Queued") + +(define-enumerated-type queued-mode :queued-mode + queued-mode? queued-modes queued-mode-name queued-mode-index + (already after-reading after-flush)) + +(define (queued-mode->integer mode) + (queued-mode-index mode)) + +;; events-pending is identical to events-pending with after-flush +;; mode. + +(define (events-pending display) + (%events-pending (display-Xdisplay display))) + +(import-lambda-definition %events-pending (Xdisplay) + "scx_Events_Pending") + +;; Other event reading *********************************************** + +(define (next-event display) + (let ((r (%next-event (display-Xdisplay display)))) + (complete-event r))) + +(import-lambda-definition %next-event (Xdisplay) + "scx_Next_Event") + +(define (peek-event display) + (let ((r (%peek-event (display-Xdisplay display)))) + (complete-event r))) + +(import-lambda-definition %peek-event (Xdisplay) + "scx_Peek_Event") + +(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") + +;; Sending events **************************************************** + +(define (send-event display window propagate? event-mask event) + (let ((Xdisplay (display-Xdisplay display)) (Xwindow (window-Xwindow window)) (mask (event-mask->integer event-mask)) (v (any-event->vector event)) @@ -27,6 +89,8 @@ (import-lambda-definition %send-event (Xdisplay Xwindow propagate mask v type) "scx_Send_Event") +;; Auxiliaries ******************************************************* + ;; creates an event type (define (complete-event v) @@ -73,37 +137,4 @@ ;;event-type-0 event-type-1 ;; those are not defined -(define (next-event display) - (let ((r (%next-event (display-Xdisplay display)))) - (complete-event r))) -(import-lambda-definition %next-event (Xdisplay) - "scx_Next_Event") - -(define (peek-event display) - (let ((r (%peek-event (display-Xdisplay display)))) - (complete-event 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") - -;;; Only here until scsh provides us with select -(import-lambda-definition add-pending-channel (channel) - "scx_add_pending_channel")