Fix problem: errors during keyboard-macro execution were leaving the

editor in the command reader that was spawned to execute the keyboard
macro, rather than returning to the reader that was in control when
the keyboard-macro execution was initiated.

Some of the keyboard-macro state was being mismanaged by unnecessary
calls to KEYBOARD-MACRO-DISABLE.  This was exacerbated because
KEYBOARD-MACRO-DISABLE was setting *KEYBOARD-MACRO-EXECUTING?* to #F
when it should have been left alone.

diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index f3743ca35e91f28cfa64723fa075b19d3cefeea8..42eccac7c7dcb3beeafb4dbc75cc0156e12afe3d 100644 (file)
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: comred.scm,v 1.121 2000/10/26 02:28:01 cph Exp $
+;;; $Id: comred.scm,v 1.122 2001/07/21 05:49:36 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,7 +16,8 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Command Reader
 
@@ -39,7 +40,7 @@
 (add-event-receiver! editor-initializations
   (lambda ()
     (set! keyboard-keys-read 0)
-    (set! command-history (make-circular-list command-history-limit false))
+    (set! command-history (make-circular-list command-history-limit #f))
     (set! command-reader-override-queue (make-queue))
     (set! *command-suffixes* #f)
     unspecific))
@@ -53,14 +54,14 @@
         (command-reader init))))))
 
 (define (command-reader #!optional initialization)
-  (fluid-let ((*last-command* false)
-             (*command* false)
+  (fluid-let ((*last-command* #f)
+             (*command* #f)
              (*command-argument*)
-             (*next-argument* false)
+             (*next-argument* #f)
              (*command-message*)
-             (*next-message* false)
+             (*next-message* #f)
              (*non-undo-count* 0)
-             (*command-key* false))
+             (*command-key* #f))
     (bind-condition-handler (list condition-type:editor-error)
        editor-error-handler
       (lambda ()
@@ -74,7 +75,7 @@
                 (lambda ()
                   (reset-command-state!)
                   (initialization))))
-           (do () (false)
+           (do () (#f)
              (bind-abort-editor-command
               (lambda ()
                 (do () (#f)
@@ -102,27 +103,29 @@
                                                       (window-buffer window))
                                                      input
                                                      (window-point window))
-                                 false)))))
+                                 #f)))))
                       ((dequeue! command-reader-override-queue)))))))))))))
 \f
 (define (bind-abort-editor-command thunk)
   (call-with-current-continuation
-   (lambda (continuation)
+   (lambda (k)
      (with-restart 'ABORT-EDITOR-COMMAND "Return to the editor command loop."
         (lambda (#!optional input)
-          (within-continuation continuation
-            (lambda ()
-              (if (and (not (default-object? input)) (input-event? input))
-                  (begin
-                    (reset-command-state!)
-                    (apply-input-event input))))))
+          (keyboard-macro-disable)
+          (if (and (not (default-object? input)) (input-event? input))
+              (within-continuation k
+                (lambda ()
+                  (reset-command-state!)
+                  (apply-input-event input)))
+              (begin
+                (abort-keyboard-macro)
+                (k unspecific))))
         values
        thunk))))
 
 (define (return-to-command-loop condition)
   (let ((restart (find-restart 'ABORT-EDITOR-COMMAND)))
     (if (not restart) (error "Missing ABORT-EDITOR-COMMAND restart."))
-    (keyboard-macro-disable)
     (invoke-restart restart
                    (and (condition/abort-current-command? condition)
                         (abort-current-command/input condition)))))
@@ -137,11 +140,11 @@
 (define (reset-command-state!)
   (unblock-thread-events)
   (set! *last-command* *command*)
-  (set! *command* false)
+  (set! *command* #f)
   (set! *command-argument* *next-argument*)
-  (set! *next-argument* false)
+  (set! *next-argument* #f)
   (set! *command-message* *next-message*)
-  (set! *next-message* false)
+  (set! *next-message* #f)
   (if (command-argument)
       (set-command-prompt! (command-argument-prompt))
       (reset-command-prompt!))
@@ -267,7 +270,7 @@
 
 (define-integrable (execute-command command)
   (reset-command-state!)
-  (%dispatch-on-command (current-window) command false))
+  (%dispatch-on-command (current-window) command #f))
 
 (define (execute-button-command screen button x y)
   (clear-message)
@@ -287,12 +290,12 @@
         (string-append-separated (command-argument-prompt) (xkey->name key)))
        (%dispatch-on-command (current-window)
                              (comtab-entry comtab key)
-                             false))))
+                             #f))))
 
 (define (dispatch-on-command command #!optional record?)
   (%dispatch-on-command (current-window)
                        command
-                       (if (default-object? record?) false record?)))
+                       (if (default-object? record?) #f record?)))
 \f
 (define (%dispatch-on-command window command record?)
   (set! *command* command)
@@ -407,12 +410,12 @@
                                   (lambda ()
                                     (if newline
                                         (loop (+ newline 1))
-                                        (values '() '() false)))
+                                        (values '() '() #f)))
                                 (lambda (arguments expressions any-from-tty?)
                                   (values (cons argument arguments)
                                           (cons expression expressions)
                                           (or from-tty? any-from-tty?)))))))
-                        (values '() '() false)))))
+                        (values '() '() #f)))))
             (lambda (arguments expressions any-from-tty?)
               (if (or record?
                       (and any-from-tty?
@@ -449,13 +452,13 @@
 (define (interactive-argument key prompt)
   (let ((prompting
         (lambda (value)
-          (values value (quotify-sexp value) true)))
+          (values value (quotify-sexp value) #t)))
        (prefix
         (lambda (prefix)
-          (values prefix (quotify-sexp prefix) false)))
+          (values prefix (quotify-sexp prefix) #f)))
        (varies
         (lambda (value expression)
-          (values value expression false))))
+          (values value expression #f))))
     (case key
       ((#\b)
        (prompting
@@ -469,21 +472,21 @@
       ((#\d)
        (varies (current-point) '(CURRENT-POINT)))
       ((#\D)
-       (prompting (prompt-for-directory prompt false)))
+       (prompting (prompt-for-directory prompt #f)))
       ((#\f)
-       (prompting (prompt-for-existing-file prompt false)))
+       (prompting (prompt-for-existing-file prompt #f)))
       ((#\F)
-       (prompting (prompt-for-file prompt false)))
+       (prompting (prompt-for-file prompt #f)))
       ((#\k)
        (prompting (prompt-for-key prompt (current-comtabs))))
       ((#\m)
        (varies (current-mark) '(CURRENT-MARK)))
       ((#\n)
-       (prompting (prompt-for-number prompt false)))
+       (prompting (prompt-for-number prompt #f)))
       ((#\N)
        (prefix
        (or (command-argument-value (command-argument))
-           (prompt-for-number prompt false))))
+           (prompt-for-number prompt #f))))
       ((#\p)
        (prefix (command-argument-numeric-value (command-argument))))
       ((#\P)

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 304638d8121975e107ee61736f41fcdf7852a266..aacba616e3fb3d356b3859d2673ba915da0dd8b6 100644 (file)
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: editor.scm,v 1.251 2001/05/31 19:56:37 cph Exp $
+;;; $Id: editor.scm,v 1.252 2001/07/21 05:49:45 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -403,7 +403,6 @@ TRANSCRIPT    messages appear in transcript buffer, if it is enabled;
        (if (not (or (not input) (input-event? input)))
            (error:wrong-type-argument input "input event"
                                       'ABORT-CURRENT-COMMAND))
-       (keyboard-macro-disable)
        (signaller input)))))
 
 (define-structure (input-event

diff --git a/v7/src/edwin/kmacro.scm b/v7/src/edwin/kmacro.scm
index f2241b12016ba146f7542723e6cc700db35d95d5..100bcbf92a40bec96fc961e1d45f8bc746e65454 100644 (file)
--- a/v7/src/edwin/kmacro.scm
+++ b/v7/src/edwin/kmacro.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: kmacro.scm,v 1.42 1999/01/28 03:59:55 cph Exp $
+;;; $Id: kmacro.scm,v 1.43 2001/07/21 05:49:25 cph Exp $
 ;;;
-;;; Copyright (c) 1985, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1985, 1989-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,68 +16,74 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Keyboard Macros
 
 (declare (usual-integrations))
 \f
-(define *defining-keyboard-macro?* false)
-(define *executing-keyboard-macro?* false)
+(define *defining-keyboard-macro?* #f)
+(define *executing-keyboard-macro?* #f)
 (define *keyboard-macro-position*)
-(define *keyboard-macro-continuation*)
-(define last-keyboard-macro false)
+(define last-keyboard-macro #f)
 (define keyboard-macro-buffer)
 (define keyboard-macro-buffer-end)
 (define named-keyboard-macros (make-string-table))
 
 (define (with-keyboard-macro-disabled thunk)
-  (fluid-let ((*executing-keyboard-macro?* false)
-             (*defining-keyboard-macro?* false))
+  (fluid-let ((*executing-keyboard-macro?* #f)
+             (*defining-keyboard-macro?* #f))
     (dynamic-wind keyboard-macro-event
                  thunk
                  keyboard-macro-event)))
 
 (define (keyboard-macro-disable)
-  (set! *defining-keyboard-macro?* false)
-  (set! *executing-keyboard-macro?* false)
+  (set! *defining-keyboard-macro?* #f)
   (keyboard-macro-event))
 
+(define (abort-keyboard-macro)
+  (if *executing-keyboard-macro?*
+      (*executing-keyboard-macro?* #f)))
+
 (define (keyboard-macro-event)
   (window-modeline-event! (current-window) 'KEYBOARD-MACRO-EVENT))
 
 (define (keyboard-macro-read-key)
-  (let ((key (keyboard-macro-peek-key)))
-    (set! *keyboard-macro-position* (cdr *keyboard-macro-position*))
-    key))
+  (if (pair? *keyboard-macro-position*)
+      (let ((key (car *keyboard-macro-position*)))
+       (set! *keyboard-macro-position* (cdr *keyboard-macro-position*))
+       key)
+      (*executing-keyboard-macro?* #t)))
 
 (define (keyboard-macro-peek-key)
-  (if (null? *keyboard-macro-position*)
-      (*keyboard-macro-continuation* true)
-      (car *keyboard-macro-position*)))
+  (if (pair? *keyboard-macro-position*)
+      (car *keyboard-macro-position*)
+      (*executing-keyboard-macro?* #t)))
 
 (define (keyboard-macro-write-key key)
-  (set! keyboard-macro-buffer (cons key keyboard-macro-buffer)))
+  (set! keyboard-macro-buffer (cons key keyboard-macro-buffer))
+  unspecific)
 
 (define (keyboard-macro-finalize-keys)
-  (set! keyboard-macro-buffer-end keyboard-macro-buffer))
+  (set! keyboard-macro-buffer-end keyboard-macro-buffer)
+  unspecific)
 
 (define (keyboard-macro-execute *macro repeat)
-  (fluid-let ((*executing-keyboard-macro?* true)
-             (*keyboard-macro-position*)
-             (*keyboard-macro-continuation*))
+  (fluid-let ((*executing-keyboard-macro?* *executing-keyboard-macro?*)
+             (*keyboard-macro-position*))
     (call-with-current-continuation
      (lambda (c)
        (let ((n repeat))
-        (set! *keyboard-macro-continuation*
+        (set! *executing-keyboard-macro?*
               (lambda (v)
-                (if (and v (positive? n))
+                (if (and v (> n 0))
                     (begin
                       (set! *keyboard-macro-position* *macro)
-                      (set! n (-1+ n))
+                      (set! n (- n 1))
                       (command-reader #f))
                     (c unspecific))))
-        (*keyboard-macro-continuation* #t))))))
+        (*executing-keyboard-macro?* #t))))))
 
 (define (keyboard-macro-define name *macro)
   (string-table-put! named-keyboard-macros name last-keyboard-macro)
@@ -105,13 +111,13 @@ With argument, append to last keyboard macro defined;
     (cond ((not argument)
           (set! keyboard-macro-buffer '())
           (set! keyboard-macro-buffer-end '())
-          (set! *defining-keyboard-macro?* true)
+          (set! *defining-keyboard-macro?* #t)
           (keyboard-macro-event)
           (message "Defining keyboard macro..."))
          ((not last-keyboard-macro)
           (editor-error "No keyboard macro has been defined"))
          (else
-          (set! *defining-keyboard-macro?* true)
+          (set! *defining-keyboard-macro?* #t)
           (keyboard-macro-event)
           (message "Appending to keyboard macro...")
           (keyboard-macro-execute last-keyboard-macro 1)))))
@@ -128,14 +134,13 @@ With numeric argument, repeat macro now that many times,
   (lambda (argument)
     (if *defining-keyboard-macro?*
        (begin
-         (set! *defining-keyboard-macro?* false)
-         (keyboard-macro-event)
+         (keyboard-macro-disable)
          (set! last-keyboard-macro (reverse keyboard-macro-buffer-end))
          (message "Keyboard macro defined")))
-    (cond ((zero? argument)
+    (cond ((= argument 0)
           (keyboard-macro-execute last-keyboard-macro 0))
          ((> argument 1)
-          (keyboard-macro-execute last-keyboard-macro (-1+ argument))))))
+          (keyboard-macro-execute last-keyboard-macro (- argument 1))))))
 
 (define-command call-last-kbd-macro
   "Call the last keyboard macro that you defined with \\[start-kbd-macro].
@@ -167,7 +172,7 @@ With argument, also record the keys it is bound to."
   (lambda (argument)
     (let ((name
           (prompt-for-string-table-name "Write keyboard macro"
-                                        false
+                                        #f
                                         named-keyboard-macros
                                         'DEFAULT-TYPE 'NO-DEFAULT
                                         'REQUIRE-MATCH #t)))
@@ -176,7 +181,7 @@ With argument, also record the keys it is bound to."
                                                 name
                                                 " to file")
                                  #f))
-           (buffer (temporary-buffer "*Write-Keyboard-Macro-temp*")))
+           (buffer (temporary-buffer "*write-keyboard-macro-temp*")))
        (call-with-output-mark (buffer-point buffer)
          (lambda (port)
            (pretty-print
@@ -192,7 +197,7 @@ With argument, also record the keys it is bound to."
                            (name->command name)))
                      '()))
             port
-            true)))
+            #t)))
        (set-buffer-pathname! buffer pathname)
        (write-buffer buffer)
        (kill-buffer buffer)))))
@@ -234,14 +239,14 @@ Without argument, reads a character.  Your options are:
                       ((test-for #\space)
                        unspecific)
                       ((test-for #\rubout)
-                       (*keyboard-macro-continuation* true))
+                       (*executing-keyboard-macro?* #t))
                       ((test-for #\C-d)
-                       (*keyboard-macro-continuation* false))
+                       (*executing-keyboard-macro?* #f))
                       ((test-for #\C-r)
                        (with-keyboard-macro-disabled enter-recursive-edit)
                        (loop))
                       ((test-for #\C-l)
-                       ((ref-command recenter) false)
+                       ((ref-command recenter) #f)
                        (loop))
                       (else
                        (editor-beep)

diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index c6ded61e9060168157b223ef4b2711b05fd54070..c5f83a7232663041a1efd0abccaabe3973e2a3d9 100644 (file)
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 3.108 2001/03/21 19:28:07 cph Exp $
+$Id: make.scm,v 3.109 2001/07/21 05:49:59 cph Exp $
 
 Copyright (c) 1989-2001 Massachusetts Institute of Technology
 
@@ -46,4 +46,4 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
                                     ((UNIX) "edwinunx")
                                     (else "edwinunk"))))))
        'QUERY)))))
-(add-identification! "Edwin" 3 109)
\ No newline at end of file
+(add-identification! "Edwin" 3 110)
\ No newline at end of file