Add ability to specify "command suffixes" -- thunks that are executed

when the current command ends.

diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index d3b01c76efeead9186afb798ac005202416240e6..609e34127bff6380265a1875f2a0e07e9b808c9f 100644 (file)
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: comred.scm,v 1.117 2000/02/29 01:34:55 cph Exp $
+;;; $Id: comred.scm,v 1.118 2000/05/08 17:34:43 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -34,11 +34,13 @@
 (define command-history)
 (define command-history-limit 30)
 (define command-reader-override-queue)
+(define *command-suffixes*)
 
 (define (initialize-command-reader!)
   (set! keyboard-keys-read 0)
   (set! command-history (make-circular-list command-history-limit false))
   (set! command-reader-override-queue (make-queue))
+  (set! *command-suffixes* #f)
   unspecific)
 \f
 (define (top-level-command-reader init)
@@ -74,7 +76,7 @@
            (do () (false)
              (bind-abort-editor-command
               (lambda ()
-                (do () (false)
+                (do () (#f)
                   (reset-command-state!)
                   (if (queue-empty? command-reader-override-queue)
                       (let ((input (get-next-keyboard-char)))
@@ -206,6 +208,19 @@
          (if (eq? history command-history)
              '()
              (loop history))))))
+
+(define (add-command-suffix! suffix)
+  (if *command-suffixes*
+      (enqueue! *command-suffixes* suffix)
+      (suffix)))
+
+(define (maybe-add-command-suffix! suffix)
+  (if *command-suffixes*
+      (without-interrupts
+       (lambda ()
+        (if (not (queued?/unsafe *command-suffixes* suffix))
+            (enqueue!/unsafe *command-suffixes* suffix))))
+      (suffix)))
 \f
 ;;; The procedures for executing commands come in two flavors.  The
 ;;; difference is that the EXECUTE-foo procedures reset the command
@@ -259,7 +274,16 @@
             (set! *non-undo-count* 0)
             (if (not *command-argument*)
                 (undo-boundary! point))
-            (apply procedure (interactive-arguments command record?)))))
+            (fluid-let ((*command-suffixes* (make-queue)))
+              (let ((v
+                     (apply procedure
+                            (interactive-arguments command record?))))
+                (let loop ()
+                  (if (not (queue-empty? *command-suffixes*))
+                      (begin
+                        ((dequeue! *command-suffixes*))
+                        (loop))))
+                v)))))
       (cond ((or *executing-keyboard-macro?* *command-argument*)
             (normal))
            ((and (char? *command-key*)

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 8db30668b2c6c60fd6c66ae42a8c5d5ab67d950c..834cde203e33e1a1f40adaac8eb4bff702d2c510 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.255 2000/05/01 03:02:23 cph Exp $
+$Id: edwin.pkg,v 1.256 2000/05/08 17:34:51 cph Exp $
 
 Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
@@ -398,6 +398,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (parent (edwin))
   (export (edwin)
          abort-current-command
+         add-command-suffix!
          auto-argument-mode?
          command-argument
          command-history-list
@@ -415,6 +416,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          keyboard-keys-read
          last-command
          last-command-key
+         maybe-add-command-suffix!
          override-next-command!
          read-and-dispatch-on-key
          return-to-command-loop