From: Matt Birkholz Date: Fri, 29 Jul 2016 06:16:06 +0000 (-0700) Subject: x11: Fix x-display-process-events to return #f when all events read. X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~15 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9d087bd97afca21c9d2a44a3887d19205a83466f;p=mit-scheme.git x11: Fix x-display-process-events to return #f when all events read. The plugin's version of x_display_process_events will return any keypress even though some do not translate into any input (e.g. when it IsModifier). X-display-process-events would return #f in that case and preview-events think all events were read. Now x-display-process- events returns #t and preview-events disregards it, continuing to read events. Many callers must disregard these non-events. Punt property-notify events in the previewer; do not queue them. --- diff --git a/src/runtime/x11graph.scm b/src/runtime/x11graph.scm index cdf9985bf..2f92dc188 100644 --- a/src/runtime/x11graph.scm +++ b/src/runtime/x11graph.scm @@ -304,7 +304,8 @@ USA. (x-display-process-events (x-display/xd display) 2))) (if event - (begin (process-event display event) + (begin (if (not (eq? #t event)) + (process-event display event)) (loop)))))))))))) (set-x-display/previewer-registration! display registration))) @@ -328,7 +329,7 @@ USA. #t 'READ)) (x-display-process-events (x-display/xd display) 1))))) - (if event + (if (and event (not (eq? #t event))) (process-event display event)))) (define (discard-events display) @@ -341,7 +342,8 @@ USA. ((x-display-process-events (x-display/xd display) 2) => (lambda (event) - (process-event display event) + (if (not (eq? #t event)) + (process-event display event)) (loop)))))))) (with-thread-events-blocked loop))) diff --git a/src/x11-screen/x11-screen.scm b/src/x11-screen/x11-screen.scm index f5b244b60..f1cff4602 100644 --- a/src/x11-screen/x11-screen.scm +++ b/src/x11-screen/x11-screen.scm @@ -525,7 +525,8 @@ USA. (let loop () (let ((event (x-display-process-events x-display-data 2))) (if event - (begin (preview-event event x-display-events) + (begin (if (not (eq? #t event)) + (preview-event event x-display-events)) (loop)))))) (register!)))) @@ -545,7 +546,9 @@ USA. (if event (if (and (vector? event) (predicate event)) (or (process-event event) (loop)) - (begin (preview-event event x-display-events) (loop))) + (begin (if (not (eq? #t event)) + (preview-event event x-display-events)) + (loop))) ;; Busy loop! (and (< (real-time-clock) timeout) (loop))))))) @@ -565,6 +568,12 @@ USA. ((and (vector? event) (fix:= event-type:expose (vector-ref event 0))) (process-expose-event event)) + ((and (vector? event) + (fix:= event-type:property-notify (vector-ref event 0))) + ;; These events are only used inside wait-for-event, in the + ;; previewer, with events blocked, though many more are sent + ;; and needn't be queued. + unspecific) ((and (vector? event) (or (fix:= event-type:map (vector-ref event 0)) (fix:= event-type:unmap (vector-ref event 0)) diff --git a/src/x11/x11-shim.h b/src/x11/x11-shim.h index b9095d46d..7b47aeee0 100644 --- a/src/x11/x11-shim.h +++ b/src/x11/x11-shim.h @@ -51,8 +51,9 @@ extern void x_close_window (struct xwindow * xw); extern int x_set_default_font (struct xdisplay * xd, const char * name); extern int x_display_descriptor (struct xdisplay * xd); extern long x_max_request_size (struct xdisplay * xd); -extern struct xwindow * x_display_process_events (struct xdisplay * xd, - XEvent * event); +extern int x_display_process_events (struct xdisplay * xd, + XEvent * event, + struct xwindow ** xw_ret); extern void x_select_input (struct xdisplay * xd, Window window, long mask); extern long x_window_event_mask (struct xwindow * xw); extern int x_window_set_event_mask (struct xwindow * xw, long mask); diff --git a/src/x11/x11.cdecl b/src/x11/x11.cdecl index 639eab7b4..1209092c7 100644 --- a/src/x11/x11.cdecl +++ b/src/x11/x11.cdecl @@ -344,10 +344,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. x_max_request_size (xd (* (struct xdisplay)))) -(extern (* (struct xwindow)) +(extern int x_display_process_events (xd (* (struct xdisplay))) - (event (* XEvent))) + (event (* XEvent)) + (xw_ret (* (* (struct xwindow))))) (extern void x_select_input diff --git a/src/x11/x11base.c b/src/x11/x11base.c index d36c4b545..e187a4147 100644 --- a/src/x11/x11base.c +++ b/src/x11/x11base.c @@ -1109,13 +1109,16 @@ ping_server (struct xdisplay * xd) } } -static struct xwindow * -xd_process_events (struct xdisplay * xd, XEvent * result) +static int +xd_process_events (struct xdisplay * xd, XEvent * result, + struct xwindow ** xw_ret) { Display * display = (XD_DISPLAY (xd)); unsigned int events_queued; XEvent event; - struct xwindow * retval = NULL; + struct xwindow * xw = NULL; + int done_p = 1; + if (x_debug > 1) { fprintf (stderr, "Enter xd_process_events\n"); @@ -1125,7 +1128,6 @@ xd_process_events (struct xdisplay * xd, XEvent * result) events_queued = (XEventsQueued (display, QueuedAfterReading)); while (0 < events_queued) { - struct xwindow * xw; events_queued -= 1; XNextEvent (display, (&event)); if ((event.type) == KeymapNotify) @@ -1140,16 +1142,17 @@ xd_process_events (struct xdisplay * xd, XEvent * result) if (xw_process_event (xw, (&event))) continue; memcpy (result, &event, sizeof (XEvent)); - retval = xw; + *xw_ret = xw; + done_p = 0; break; } if (x_debug > 1) { - fprintf (stderr, "Return from xd_process_events: 0x%lx\n", - ((unsigned long) retval)); + fprintf (stderr, "Return from xd_process_events: %d 0x%lx\n", + done_p, ((unsigned long) xw)); fflush (stderr); } - return (retval); + return (done_p); } /* Open/Close Primitives */ @@ -1255,10 +1258,11 @@ x_max_request_size (struct xdisplay * xd) return (XMaxRequestSize (display)); } -struct xwindow * -x_display_process_events (struct xdisplay * xd, XEvent * event) +int +x_display_process_events (struct xdisplay * xd, XEvent * event, + struct xwindow **xw_ret) { - return (xd_process_events (xd, event)); + return (xd_process_events (xd, event, xw_ret)); } void diff --git a/src/x11/x11base.scm b/src/x11/x11base.scm index 5a3596e84..52ce079e7 100644 --- a/src/x11/x11base.scm +++ b/src/x11/x11base.scm @@ -24,7 +24,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. |# ;;;; X11 interface -;;; package: (x11) +;;; package: (x11 base) ;;; ;;; These were once primitives created by x11base.c in umodule prx11. @@ -101,13 +101,16 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-display-process-events display how) (declare (ignore how)) (guarantee-xdisplay display 'x-display-process-events) - (let* ((event (malloc (C-sizeof "XEvent") '|XEvent|)) - (window (C-call "x_display_process_events" - (make-alien '(struct |xwindow|)) - display event))) - (let ((obj (if (alien-null? window) - #f - (make-event-object window event)))) + (let ((event (malloc (C-sizeof "XEvent") '|XEvent|)) + (xw (malloc (C-sizeof "* struct xwindow") '(* (struct |xwindow|))))) + (let* ((done-p (C-call "x_display_process_events" + display event xw)) + (window (C-> xw "* xwindow" (make-alien '(struct |xwindow|)))) + (obj (if (= done-p 1) + #f + (or (make-event-object window event) + #t)))) + (free xw) (free event) obj))) diff --git a/src/x11/x11device.scm b/src/x11/x11device.scm index 3ffadbbb8..1c6a20cbd 100644 --- a/src/x11/x11device.scm +++ b/src/x11/x11device.scm @@ -211,8 +211,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (x-display-process-events (x-display/xd display) 2))) (if event - (begin (process-event display event) - (loop)))))))))))) + (begin + (if (not (eq? #t event)) + (process-event display event)) + (loop)))))))))))) (set-x-display/previewer-registration! display registration))) (define (read-event display) @@ -235,7 +237,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. #t 'READ)) (x-display-process-events (x-display/xd display) 1))))) - (if event + (if (and event (not (eq? #t event))) (process-event display event)))) (define (discard-events display) @@ -248,7 +250,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ((x-display-process-events (x-display/xd display) 2) => (lambda (event) - (process-event display event) + (if (not (eq? #t event)) + (process-event display event)) (loop)))))))) (with-thread-events-blocked loop)))