From 90016f5e001b94f878f26f3ca57b30a91ca9b6e3 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 21 Jul 2001 05:49:59 +0000 Subject: [PATCH] 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. --- v7/src/edwin/comred.scm | 73 +++++++++++++++++++------------------ v7/src/edwin/editor.scm | 3 +- v7/src/edwin/kmacro.scm | 81 ++++++++++++++++++++++------------------- v7/src/edwin/make.scm | 4 +- 4 files changed, 84 insertions(+), 77 deletions(-) diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm index f3743ca35..42eccac7c 100644 --- 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))))))))))))) (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?))) (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 304638d81..aacba616e 100644 --- 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 f2241b120..100bcbf92 100644 --- 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)) -(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 c6ded61e9..c5f83a723 100644 --- 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 -- 2.25.1