Implement new procedure X-GRAPHICS/DISCARD-EVENTS to discard mouse

button events that are in the queue.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 6d32c69e193d73b6de9be5f5abf93c26276019e9..40dd7ca20ac9d72760792120af0f1c0ffb057785 100644 (file)
--- 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 4e0afa47d3b165398a923757ed17901a2213f4ce..65a8f7e8aed15e562a34043892d59640a74f8683 100644 (file)
--- 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)))))
 \f
 (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)))
 \f

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index a53c65b5877578b3fb501c27d183fa5df875534f..40dd7ca20ac9d72760792120af0f1c0ffb057785 100644 (file)
--- 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