From 31137869c82912290e729047f850e4f5d84b8b74 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 21 Oct 1991 23:40:56 +0000 Subject: [PATCH] Change command reader to preserve message across argument commands. Fix undo of self-insert characters. --- v7/src/edwin/argred.scm | 73 ++++++++++---------- v7/src/edwin/comred.scm | 144 ++++++++++++++++++++++------------------ v7/src/edwin/edwin.pkg | 5 +- 3 files changed, 120 insertions(+), 102 deletions(-) diff --git a/v7/src/edwin/argred.scm b/v7/src/edwin/argred.scm index 63ac39fa4..8cb012d5f 100644 --- a/v7/src/edwin/argred.scm +++ b/v7/src/edwin/argred.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/argred.scm,v 1.31 1991/08/06 15:39:54 arthur Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/argred.scm,v 1.32 1991/10/21 23:40:21 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology ;;; @@ -53,35 +53,51 @@ If no digits or minus sign follow, this command by itself provides 4 as argument Used more than once, this command multiplies the argument by 4 each time." "P" (lambda (argument) - (set-command-argument! (list (* (if (pair? argument) (car argument) 1) 4))) - (set-command-message! 'AUTO-ARGUMENT (key-name (last-command-key))))) + (set-command-argument! (list (* (if (pair? argument) (car argument) 1) 4)) + (key-name (last-command-key))))) (define-command digit-argument "Part of the numeric argument for the next command." "P" (lambda (argument) - (let ((key (last-command-key))) - (if (char? key) - (let ((digit (char->digit (char-base key)))) - (if digit - (begin - (set-command-argument! - (cond ((eq? '- argument) (- digit)) - ((not (number? argument)) digit) - ((negative? argument) (- (* 10 argument) digit)) - (else (+ (* 10 argument) digit)))) - (set-command-message! 'AUTO-ARGUMENT - (auto-argument-mode?))))))))) + (digit-argument argument (auto-argument-mode?)))) + +(define (digit-argument argument mode) + (let ((key (last-command-key))) + (if (char? key) + (let ((digit (char->digit (char-base key)))) + (if digit + (set-command-argument! + (cond ((eq? '- argument) (- digit)) + ((not (number? argument)) digit) + ((negative? argument) (- (* 10 argument) digit)) + (else (+ (* 10 argument) digit))) + mode)))))) (define-command negative-argument "Begin a negative numeric argument for the next command." "P" (lambda (argument) - (set-command-argument! - (cond ((eq? '- argument) false) - ((number? argument) (- argument)) - (else '-))) - (set-command-message! 'AUTO-ARGUMENT (auto-argument-mode?)))) + (negative-argument argument (auto-argument-mode?)))) + +(define (negative-argument argument mode) + (set-command-argument! (cond ((eq? '- argument) false) + ((number? argument) (- argument)) + (else '-)) + mode)) + +(define-command auto-argument + "Start a command argument. +Digits following this command become part of the argument." + "P" + (lambda (argument) + (let ((mode (if argument (auto-argument-mode?) true))) + (if (let ((key (last-command-key))) + (and (char? key) + (char=? #\- (char-base key)))) + (if (not (number? argument)) + (negative-argument argument mode)) + (digit-argument argument mode))))) (define-command auto-digit-argument "When reading a command argument, part of the numeric argument. @@ -101,20 +117,6 @@ Otherwise, the character inserts itself." (not (number? argument))) ((ref-command negative-argument) argument) ((ref-command self-insert-command) argument)))) - -(define-command auto-argument - "Start a command argument. -Digits following this command become part of the argument." - "P" - (lambda (argument) - (if (let ((key (last-command-key))) - (and (char? key) - (char=? #\- (char-base key)))) - (if (not (number? argument)) - ((ref-command negative-argument) argument)) - ((ref-command digit-argument) argument)) - (if (not argument) - (set-command-message! 'AUTO-ARGUMENT true)))) (define (command-argument-self-insert? command) (and (or (eq? command (ref-command-object auto-digit-argument)) @@ -122,9 +124,6 @@ Digits following this command become part of the argument." (not (number? (command-argument))))) (not (auto-argument-mode?)))) -(define (auto-argument-mode?) - (command-message-receive 'AUTO-ARGUMENT (lambda (x) x) (lambda () false))) - (define (command-argument-prompt) (let ((arg (command-argument))) (if (not arg) diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm index 4fe864eb9..0596dec41 100644 --- a/v7/src/edwin/comred.scm +++ b/v7/src/edwin/comred.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.87 1991/08/06 15:40:25 arthur Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.88 1991/10/21 23:40:40 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology ;;; @@ -49,6 +49,7 @@ (define *command-continuation*) ;Continuation of current command (define *command-key*) ;Key read to find current command (define *command*) ;The current command +(define *last-command*) ;The previous command, excluding arg commands (define *command-argument*) ;Argument from last command (define *next-argument*) ;Argument to next command (define *command-message*) ;Message from last command @@ -103,7 +104,7 @@ (lambda (continuation) (fluid-let ((*command-continuation* continuation) (*command-key* false) - (*command*) + (*command* false) (*next-argument* false) (*next-message* false)) (bind-condition-handler (list condition-type:editor-error) @@ -116,7 +117,7 @@ (set! *command-key* key) (clear-message) (set-command-prompt! - (if (not *command-argument*) + (if (not (command-argument)) (key-name key) (string-append-separated (command-argument-prompt) (key-name key)))) @@ -128,7 +129,8 @@ false))) (start-next-command)) - (fluid-let ((*command-argument*) + (fluid-let ((*last-command* false) + (*command-argument*) (*command-message*) (*non-undo-count* 0)) (if (and (not (default-object? initialization)) initialization) @@ -139,44 +141,18 @@ (command-reader-loop))) (define (reset-command-state!) + (set! *last-command* *command*) + (set! *command* false) (set! *command-argument* *next-argument*) (set! *next-argument* false) (set! *command-message* *next-message*) (set! *next-message* false) - (if *command-argument* + (if (command-argument) (set-command-prompt! (command-argument-prompt)) (reset-command-prompt!)) - (if *defining-keyboard-macro?* (keyboard-macro-finalize-keys))) + (if *defining-keyboard-macro?* + (keyboard-macro-finalize-keys))) -;;; The procedures for executing commands come in two flavors. The -;;; difference is that the EXECUTE-foo procedures reset the command -;;; state first, while the DISPATCH-ON-foo procedures do not. The -;;; latter should only be used by "prefix" commands such as C-X or -;;; C-4, since they want arguments, messages, etc. to be passed on. - -(define-integrable (execute-key comtab key) - (reset-command-state!) - (dispatch-on-key comtab key)) - -(define-integrable (execute-command command) - (reset-command-state!) - (%dispatch-on-command (current-window) command false)) - -(define (read-and-dispatch-on-key) - (dispatch-on-key (current-comtabs) - (with-editor-interrupts-disabled keyboard-read))) - -(define (dispatch-on-key comtab key) - (set! *command-key* key) - (set-command-prompt! - (string-append-separated (command-argument-prompt) (xkey->name key))) - (%dispatch-on-command (current-window) (comtab-entry comtab key) false)) - -(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) (*command-continuation* (if (default-object? value) 'ABORT value))) @@ -189,15 +165,28 @@ *command-key* (car (last-pair *command-key*)))) +(define (set-current-command! command) + (set! *command* command) + unspecific) + (define-integrable (current-command) *command*) -(define (set-command-argument! argument) - (set! *next-argument* argument) +(define-integrable (last-command) + *last-command*) + +(define (set-command-argument! argument mode) + (set! *next-argument* (cons argument mode)) + ;; Preserve message and last command. + (set! *next-message* *command-message*) + (set! *command* *last-command*) unspecific) (define-integrable (command-argument) - *command-argument*) + (and *command-argument* (car *command-argument*))) + +(define (auto-argument-mode?) + (and *command-argument* (cdr *command-argument*))) (define (set-command-message! tag . arguments) (set! *next-message* (cons tag arguments)) @@ -221,6 +210,35 @@ '() (loop history)))))) +;;; The procedures for executing commands come in two flavors. The +;;; difference is that the EXECUTE-foo procedures reset the command +;;; state first, while the DISPATCH-ON-foo procedures do not. The +;;; latter should only be used by "prefix" commands such as C-X or +;;; C-4, since they want arguments, messages, etc. to be passed on. + +(define-integrable (execute-key comtab key) + (reset-command-state!) + (dispatch-on-key comtab key)) + +(define-integrable (execute-command command) + (reset-command-state!) + (%dispatch-on-command (current-window) command false)) + +(define (read-and-dispatch-on-key) + (dispatch-on-key (current-comtabs) + (with-editor-interrupts-disabled keyboard-read))) + +(define (dispatch-on-key comtab key) + (set! *command-key* key) + (set-command-prompt! + (string-append-separated (command-argument-prompt) (xkey->name key))) + (%dispatch-on-command (current-window) (comtab-entry comtab key) false)) + +(define (dispatch-on-command command #!optional record?) + (%dispatch-on-command (current-window) + command + (if (default-object? record?) false record?))) + (define (%dispatch-on-command window command record?) (set! *command* command) (guarantee-command-loaded command) @@ -232,45 +250,43 @@ (set! *non-undo-count* 0) (undo-boundary! point) (apply procedure (interactive-arguments command record?))))) - (cond ((or *executing-keyboard-macro?* (command-argument)) + (cond ((or *executing-keyboard-macro?* *command-argument*) (set! *non-undo-count* 0) (apply procedure (interactive-arguments command record?))) ((window-needs-redisplay? window) (normal)) - ((eq? command (ref-command-object forward-char)) - (if (and (not (group-end? point)) - (char-graphic? (mark-right-char point)) - (< point-x (- (window-x-size window) 2))) - (window-direct-output-forward-char! window) - (normal))) - ((eq? command (ref-command-object backward-char)) - (if (and (not (group-start? point)) - (char-graphic? (mark-left-char point)) - (positive? point-x) - (< point-x (-1+ (window-x-size window)))) - (window-direct-output-backward-char! window) - (normal))) - ((and (not (special-key? *command-key*)) + ((and (char? *command-key*) (or (eq? command (ref-command-object self-insert-command)) (and (eq? command (ref-command-object auto-fill-space)) (not (auto-fill-break? point))) (command-argument-self-insert? command))) + (if (or (= *non-undo-count* 0) + (>= *non-undo-count* 20)) + (begin + (set! *non-undo-count* 0) + (undo-boundary! point))) + (set! *non-undo-count* (+ *non-undo-count* 1)) (let ((key *command-key*)) (if (let ((buffer (window-buffer window))) (and (buffer-auto-save-modified? buffer) (null? (cdr (buffer-windows buffer))) (line-end? point) (char-graphic? key) - (< point-x (-1+ (window-x-size window))))) - (begin - (if (or (zero? *non-undo-count*) - (>= *non-undo-count* 20)) - (begin - (set! *non-undo-count* 0) - (undo-boundary! point))) - (set! *non-undo-count* (1+ *non-undo-count*)) - (window-direct-output-insert-char! window key)) + (< point-x (- (window-x-size window) 1)))) + (window-direct-output-insert-char! window key) (region-insert-char! point key)))) + ((eq? command (ref-command-object forward-char)) + (if (and (not (group-end? point)) + (char-graphic? (mark-right-char point)) + (< point-x (- (window-x-size window) 2))) + (window-direct-output-forward-char! window) + (normal))) + ((eq? command (ref-command-object backward-char)) + (if (and (not (group-start? point)) + (char-graphic? (mark-left-char point)) + (< 0 point-x (- (window-x-size window) 1))) + (window-direct-output-backward-char! window) + (normal))) (else (normal)))))) @@ -305,13 +321,13 @@ (interactive-argument (string-ref specification index) (substring specification - (1+ index) + (+ index 1) (or newline end)))) (lambda (argument expression from-tty?) (with-values (lambda () (if newline - (loop (1+ newline)) + (loop (+ newline 1)) (values '() '() false))) (lambda (arguments expressions any-from-tty?) (values (cons argument arguments) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index 6ebabc1c5..1007af656 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.64 1991/10/11 18:33:57 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.65 1991/10/21 23:40:56 cph Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -452,6 +452,7 @@ MIT in each case. |# (parent (edwin)) (export (edwin) abort-current-command + auto-argument-mode? command-argument command-history-list command-message-receive @@ -466,10 +467,12 @@ MIT in each case. |# execute-command-history-entry initialize-command-reader! keyboard-keys-read + last-command last-command-key read-and-dispatch-on-key set-command-argument! set-command-message! + set-current-command! top-level-command-reader)) (define-package (edwin keyboard) -- 2.25.1