From 2f996b9a1bddcf50b33d37690d8170135aebca71 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 18 Sep 1992 19:05:24 +0000 Subject: [PATCH] Implement new procedure X-GRAPHICS/DISCARD-EVENTS to discard mouse button events that are in the queue. --- v7/src/runtime/runtime.pkg | 3 ++- v7/src/runtime/x11graph.scm | 18 +++++++++++++++++- v8/src/runtime/runtime.pkg | 3 ++- 3 files changed, 21 insertions(+), 3 deletions(-) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 6d32c69e1..40dd7ca20 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.159 1992/08/18 02:56:23 cph Exp $ +$Id: runtime.pkg,v 14.160 1992/09/18 19:05:24 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -2126,6 +2126,7 @@ MIT in each case. |# x-graphics/draw-line x-graphics/draw-point x-graphics/draw-text + x-graphics/discard-events x-graphics/font-structure x-graphics/get-colormap x-graphics/get-default diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm index 4e0afa47d..65a8f7e8a 100644 --- a/v7/src/runtime/x11graph.scm +++ b/v7/src/runtime/x11graph.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.23 1992/07/20 20:12:21 arthur Exp $ +$Id: x11graph.scm,v 1.24 1992/09/18 19:05:15 cph Exp $ Copyright (c) 1989-92 Massachusetts Institute of Technology @@ -366,6 +366,19 @@ MIT in each case. |# (dequeue! queue))))) (lambda () (unlock-thread-mutex mutex))))) + +(define (discard-events display) + (let ((mutex (x-display/mutex display))) + (dynamic-wind + (lambda () + (lock-thread-mutex mutex)) + (lambda () + (let ((queue (x-display/event-queue display))) + (let loop () + (if (not (queue-empty? queue)) + (dequeue! queue))))) + (lambda () + (unlock-thread-mutex mutex))))) (define (process-event display event) (let ((handler (vector-ref event-handlers (vector-ref event 0)))) @@ -625,6 +638,9 @@ MIT in each case. |# (x-graphics-map-y-coordinate window (vector-ref event 3)) (vector-ref event 4))))) +(define (x-graphics/discard-events device) + (discard-events (x-graphics/display device))) + (define (x-graphics/starbase-filename device) (x-window-starbase-filename (x-graphics-device/xw device))) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index a53c65b58..40dd7ca20 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.159 1992/08/18 02:56:23 cph Exp $ +$Id: runtime.pkg,v 14.160 1992/09/18 19:05:24 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -2126,6 +2126,7 @@ MIT in each case. |# x-graphics/draw-line x-graphics/draw-point x-graphics/draw-text + x-graphics/discard-events x-graphics/font-structure x-graphics/get-colormap x-graphics/get-default -- 2.25.1