Add argument to `dispatch-on-command' to force recording of command in
authorChris Hanson <org/chris-hanson/cph>
Sun, 23 Apr 1989 23:19:11 +0000 (23:19 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sun, 23 Apr 1989 23:19:11 +0000 (23:19 +0000)
command-history.

v7/src/edwin/comred.scm

index 00f6e703be5e8069e048520f380709c870949f6c..7addf24a73464ed458e67475ed36e912e30722b6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.72 1989/04/15 00:47:54 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.73 1989/04/23 23:19:11 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -98,7 +98,8 @@
        (%dispatch-on-command window
                              (comtab-entry (buffer-comtabs
                                             (window-buffer window))
-                                           char))))
+                                           char)
+                             false)))
     (start-next-command))
 
   (fluid-let ((*command-message*)
 
 (define-integrable (execute-command command)
   (reset-command-state!)
-  (dispatch-on-command command))
+  (%dispatch-on-command (current-window) command false))
 
 (define-integrable (read-and-dispatch-on-char)  (dispatch-on-char (current-comtabs)
                    (with-editor-interrupts-disabled keyboard-read-char)))
 (define (dispatch-on-char comtab char)
   (set! *command-char* char)
   (set-command-prompt!
-   (string-append-separated (command-argument-prompt)
-                           (xchar->name char)))
-  (dispatch-on-command (comtab-entry comtab char)))
+   (string-append-separated (command-argument-prompt) (xchar->name char)))
+  (%dispatch-on-command (current-window) (comtab-entry comtab char) false))
 
-(define-integrable (dispatch-on-command command)
-  (%dispatch-on-command (current-window) command))
+(define (dispatch-on-command command #!optional record?)
+  (%dispatch-on-command (current-window)
+                       command
+                       (if (default-object? record?) false record?)))
 
 (define (abort-current-command #!optional value)
   (keyboard-macro-disable)
           (eq? (car *command-message*) tag))
       (apply if-received (cdr *command-message*))
       (if-not-received)))\f
-(define (%dispatch-on-command window command)
+(define (%dispatch-on-command window command record?)
   (set! *command* command)
   (guarantee-command-loaded command)
   (let ((procedure (command-procedure command)))
     (let ((normal
           (lambda ()
-            (apply procedure (interactive-arguments command false)))))
+            (apply procedure (interactive-arguments command record?)))))
       (if (or *executing-keyboard-macro?*
              (window-needs-redisplay? window)
              (command-argument-standard-value?))