diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2015-09-01 21:14:18 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2015-09-01 21:14:18 -0400 |
commit | 5dc644a6b01e2cf950ff617ab15be4bf1917c38c (patch) | |
tree | f5572fd4d2c5cc68ac54e48fbd7541bd8043fadc | |
parent | afe1cf00713847c1d8f3a9d95d4980d705ec39f1 (diff) | |
download | emacs-5dc644a6b01e2cf950ff617ab15be4bf1917c38c.tar.gz |
Generalize the prefix-command machinery of C-u
* lisp/simple.el (prefix-command-echo-keystrokes-functions)
(prefix-command-preserve-state-hook): New hooks.
(internal-echo-keystrokes-prefix): New function.
(prefix-command--needs-update, prefix-command--last-echo): New vars.
(prefix-command-update, prefix-command-preserve): New functions.
(reset-this-command-lengths): New compatibility definition.
(universal-argument--mode): Call prefix-command-update.
(universal-argument, universal-argument-more, negative-argument)
(digit-argument): Call prefix-command-preserve-state.
* src/keyboard.c: Call internal-echo-keystrokes-prefix to build
the "prefix argument" to echo.
(this_command_key_count_reset, before_command_key_count)
(before_command_echo_length): Delete variables.
(echo_add_key): Always add a space.
(echo_char): Remove.
(echo_dash): Don't give up when this_command_key_count is 0, since that
is now the case after a prefix command.
(echo_update): New function, extracted from echo_now.
(echo_now): Use it.
(add_command_key, read_char, record_menu_key): Remove old disabled code.
(command_loop_1): Don't refrain from pushing an undo boundary when
prefix-arg is set. Remove other prefix-arg special case, now handled
directly in the prefix commands instead. But call echo_now if there's
a prefix state to echo.
(read_char, record_menu_key): Use echo_update instead of echo_char.
(read_key_sequence): Use echo_now rather than echo_dash/echo_char.
(Freset_this_command_lengths): Delete function.
(syms_of_keyboard): Define Qinternal_echo_keystrokes_prefix.
(syms_of_keyboard): Don't defsubr Sreset_this_command_lengths.
* lisp/simple.el: Use those new hooks for C-u.
(universal-argument--description): New function.
(prefix-command-echo-keystrokes-functions): Use it.
(universal-argument--preserve): New function.
(prefix-command-preserve-state-hook): Use it.
(command-execute): Call prefix-command-update if needed.
* lisp/kmacro.el (kmacro-step-edit-prefix-commands)
(kmacro-step-edit-prefix-index): Delete variables.
(kmacro-step-edit-query, kmacro-step-edit-insert): Remove ad-hoc
support for prefix arg commands.
(kmacro-step-edit-macro): Don't bind kmacro-step-edit-prefix-index.
* lisp/emulation/cua-base.el (cua--prefix-override-replay)
(cua--shift-control-prefix): Use prefix-command-preserve-state.
Remove now unused arg `arg'.
(cua--prefix-override-handler, cua--prefix-repeat-handler)
(cua--shift-control-c-prefix, cua--shift-control-x-prefix):
Update accordingly.
(cua--prefix-override-timeout): Don't call reset-this-command-lengths
any more.
(cua--keep-active, cua-exchange-point-and-mark): Don't set mark-active
if the mark is not set.
-rw-r--r-- | etc/NEWS | 4 | ||||
-rw-r--r-- | lisp/emulation/cua-base.el | 53 | ||||
-rw-r--r-- | lisp/kmacro.el | 50 | ||||
-rw-r--r-- | lisp/simple.el | 80 | ||||
-rw-r--r-- | src/keyboard.c | 278 |
5 files changed, 188 insertions, 277 deletions
@@ -965,6 +965,10 @@ be updated accordingly. * Lisp Changes in Emacs 25.1 +** New hooks prefix-command-echo-keystrokes-functions and +prefix-command-preserve-state-hook, to allow the definition of prefix +commands other than the predefined C-u. + ** New functions `filepos-to-bufferpos' and `bufferpos-to-filepos'. ** The default value of `load-read-function' is now `read'. diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index e91ce80bbe2..52e1647ede7 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -685,7 +685,7 @@ a cons (TYPE . COLOR), then both properties are affected." (defvar cua--prefix-override-timer nil) (defvar cua--prefix-override-length nil) -(defun cua--prefix-override-replay (arg repeat) +(defun cua--prefix-override-replay (repeat) (let* ((keys (this-command-keys)) (i (length keys)) (key (aref keys (1- i)))) @@ -705,21 +705,23 @@ a cons (TYPE . COLOR), then both properties are affected." ;; Don't record this command (setq this-command last-command) ;; Restore the prefix arg - (setq prefix-arg arg) - (reset-this-command-lengths) + ;; This should make it so that exchange-point-and-mark gets the prefix when + ;; you do C-u C-x C-x C-x work (where the C-u is properly passed to the C-x + ;; C-x binding after the first C-x C-x was rewritten to just C-x). + (prefix-command-preserve-state) ;; Push the key back on the event queue (setq unread-command-events (cons key unread-command-events)))) -(defun cua--prefix-override-handler (arg) +(defun cua--prefix-override-handler () "Start timer waiting for prefix key to be followed by another key. Repeating prefix key when region is active works as a single prefix key." - (interactive "P") - (cua--prefix-override-replay arg 0)) + (interactive) + (cua--prefix-override-replay 0)) -(defun cua--prefix-repeat-handler (arg) +(defun cua--prefix-repeat-handler () "Repeating prefix key when region is active works as a single prefix key." - (interactive "P") - (cua--prefix-override-replay arg 1)) + (interactive) + (cua--prefix-override-replay 1)) (defun cua--prefix-copy-handler (arg) "Copy region/rectangle, then replay last key." @@ -742,7 +744,8 @@ Repeating prefix key when region is active works as a single prefix key." (when (= (length (this-command-keys)) cua--prefix-override-length) (setq unread-command-events (cons 'timeout unread-command-events)) (if prefix-arg - (reset-this-command-lengths) + nil + ;; FIXME: Why? (setq overriding-terminal-local-map nil)) (cua--select-keymaps))) @@ -755,8 +758,9 @@ Repeating prefix key when region is active works as a single prefix key." (call-interactively this-command)) (defun cua--keep-active () - (setq mark-active t - deactivate-mark nil)) + (when (mark t) + (setq mark-active t + deactivate-mark nil))) (defun cua--deactivate (&optional now) (if (not now) @@ -944,7 +948,7 @@ See also `exchange-point-and-mark'." (cond ((null cua-enable-cua-keys) (exchange-point-and-mark arg)) (arg - (setq mark-active t)) + (when (mark t) (setq mark-active t))) (t (let (mark-active) (exchange-point-and-mark) @@ -1212,25 +1216,28 @@ If ARG is the atom `-', scroll upward by nearly full screen." (defvar cua--keymaps-initialized nil) -(defun cua--shift-control-prefix (prefix arg) +(defun cua--shift-control-prefix (prefix) ;; handle S-C-x and S-C-c by emulating the fast double prefix function. ;; Don't record this command (setq this-command last-command) ;; Restore the prefix arg - (setq prefix-arg arg) - (reset-this-command-lengths) + ;; This should make it so that exchange-point-and-mark gets the prefix when + ;; you do C-u S-C-x C-x work (where the C-u is properly passed to the C-x + ;; C-x binding after the first S-C-x was rewritten to just C-x). + (prefix-command-preserve-state) ;; Activate the cua--prefix-repeat-keymap (setq cua--prefix-override-timer 'shift) ;; Push duplicate keys back on the event queue - (setq unread-command-events (cons prefix (cons prefix unread-command-events)))) + (setq unread-command-events + (cons prefix (cons prefix unread-command-events)))) -(defun cua--shift-control-c-prefix (arg) - (interactive "P") - (cua--shift-control-prefix ?\C-c arg)) +(defun cua--shift-control-c-prefix () + (interactive) + (cua--shift-control-prefix ?\C-c)) -(defun cua--shift-control-x-prefix (arg) - (interactive "P") - (cua--shift-control-prefix ?\C-x arg)) +(defun cua--shift-control-x-prefix () + (interactive) + (cua--shift-control-prefix ?\C-x)) (defun cua--init-keymaps () ;; Cache actual rectangle modifier key. diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 9636a36b1e2..ddf3005bab5 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -941,7 +941,6 @@ without repeating the prefix." (defvar kmacro-step-edit-inserting) ;; inserting into macro (defvar kmacro-step-edit-appending) ;; append to end of macro (defvar kmacro-step-edit-replace) ;; replace orig macro when done -(defvar kmacro-step-edit-prefix-index) ;; index of first prefix arg key (defvar kmacro-step-edit-key-index) ;; index of current key (defvar kmacro-step-edit-action) ;; automatic action on next pre-command hook (defvar kmacro-step-edit-help) ;; kmacro step edit help enabled @@ -976,11 +975,6 @@ This keymap is an extension to the `query-replace-map', allowing the following additional answers: `insert', `insert-1', `replace', `replace-1', `append', `append-end', `act-repeat', `skip-end', `skip-keep'.") -(defvar kmacro-step-edit-prefix-commands - '(universal-argument universal-argument-more universal-argument-minus - digit-argument negative-argument) - "Commands which build up a prefix arg for the current command.") - (defun kmacro-step-edit-prompt (macro index) ;; Show step-edit prompt (let ((keys (and (not kmacro-step-edit-appending) @@ -1084,21 +1078,13 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', ;; Handle prefix arg, or query user (cond (act act) ;; set above - ((memq this-command kmacro-step-edit-prefix-commands) - (unless kmacro-step-edit-prefix-index - (setq kmacro-step-edit-prefix-index kmacro-step-edit-key-index)) - (setq act 'universal-argument)) - ((eq this-command 'universal-argument-other-key) - (setq act 'universal-argument)) (t - (kmacro-step-edit-prompt macro (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)) + (kmacro-step-edit-prompt macro kmacro-step-edit-key-index) (setq act (lookup-key kmacro-step-edit-map (vector (with-current-buffer (current-buffer) (read-event)))))))) ;; Resume macro execution and perform the action (cond - ((eq act 'universal-argument) - nil) ((cond ((eq act 'act) t) @@ -1110,7 +1096,6 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (setq kmacro-step-edit-active 'ignore) nil) ((eq act 'skip) - (setq kmacro-step-edit-prefix-index nil) nil) ((eq act 'skip-keep) (setq this-command 'ignore) @@ -1123,12 +1108,11 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (setq act t) t) ((member act '(insert-1 insert)) - (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)) + (setq executing-kbd-macro-index kmacro-step-edit-key-index) (setq kmacro-step-edit-inserting (if (eq act 'insert-1) 1 t)) nil) ((member act '(replace-1 replace)) (setq kmacro-step-edit-inserting (if (eq act 'replace-1) 1 t)) - (setq kmacro-step-edit-prefix-index nil) (if (= executing-kbd-macro-index (length executing-kbd-macro)) (setq executing-kbd-macro (vconcat executing-kbd-macro [nil]) kmacro-step-edit-appending t)) @@ -1148,19 +1132,19 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (setq act t) t) ((eq act 'help) - (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)) + (setq executing-kbd-macro-index kmacro-step-edit-key-index) (setq kmacro-step-edit-help (not kmacro-step-edit-help)) nil) (t ;; Ignore unknown responses - (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)) + (setq executing-kbd-macro-index kmacro-step-edit-key-index) nil)) - (if (> executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)) + (if (> executing-kbd-macro-index kmacro-step-edit-key-index) (setq kmacro-step-edit-new-macro (vconcat kmacro-step-edit-new-macro (substring executing-kbd-macro - (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index) - (if (eq act t) nil executing-kbd-macro-index))) - kmacro-step-edit-prefix-index nil)) + kmacro-step-edit-key-index + (if (eq act t) nil + executing-kbd-macro-index))))) (if restore-index (setq executing-kbd-macro-index restore-index))) (t @@ -1175,12 +1159,10 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (executing-kbd-macro nil) (defining-kbd-macro nil) cmd keys next-index) - (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index) - kmacro-step-edit-prefix-index nil) + (setq executing-kbd-macro-index kmacro-step-edit-key-index) (kmacro-step-edit-prompt macro nil) ;; Now, we have read a key sequence from the macro, but we don't want ;; to execute it yet. So push it back and read another sequence. - (reset-this-command-lengths) (setq keys (read-key-sequence nil nil nil nil t)) (setq cmd (key-binding keys t nil)) (if (cond @@ -1201,25 +1183,12 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', unread-command-events nil))) (setq cmd 'ignore) nil) - ((memq cmd kmacro-step-edit-prefix-commands) - (reset-this-command-lengths) - nil) - ((eq cmd 'universal-argument-other-key) - (setq kmacro-step-edit-action t) - (reset-this-command-lengths) - (if (numberp kmacro-step-edit-inserting) - (setq kmacro-step-edit-inserting nil)) - nil) ((numberp kmacro-step-edit-inserting) (setq kmacro-step-edit-inserting nil) nil) ((equal keys "\C-j") (setq kmacro-step-edit-inserting nil) (setq kmacro-step-edit-action nil) - ;; Forget any (partial) prefix arg from next command - (setq kmacro-step-edit-prefix-index nil) - (reset-this-command-lengths) - (setq overriding-terminal-local-map nil) (setq next-index kmacro-step-edit-key-index) t) (t nil)) @@ -1278,7 +1247,6 @@ To customize possible responses, change the \"bindings\" in `kmacro-step-edit-ma (kmacro-step-edit-inserting nil) (kmacro-step-edit-appending nil) (kmacro-step-edit-replace t) - (kmacro-step-edit-prefix-index nil) (kmacro-step-edit-key-index 0) (kmacro-step-edit-action nil) (kmacro-step-edit-help nil) diff --git a/lisp/simple.el b/lisp/simple.el index 6f76d755292..b8d4e741775 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1711,9 +1711,13 @@ The argument SPECIAL, if non-nil, means that this command is executing a special event, so ignore the prefix argument and don't clear it." (setq debug-on-next-call nil) (let ((prefixarg (unless special + ;; FIXME: This should probably be done around + ;; pre-command-hook rather than here! (prog1 prefix-arg (setq current-prefix-arg prefix-arg) - (setq prefix-arg nil))))) + (setq prefix-arg nil) + (when current-prefix-arg + (prefix-command-update)))))) (if (and (symbolp cmd) (get cmd 'disabled) disabled-command-function) @@ -3626,6 +3630,73 @@ see other processes running on the system, use `list-system-processes'." (display-buffer buffer) nil) +;;;; Prefix commands + +(setq prefix-command--needs-update nil) +(setq prefix-command--last-echo nil) + +(defun internal-echo-keystrokes-prefix () + ;; BEWARE: Called directly from the C code. + (if (not prefix-command--needs-update) + prefix-command--last-echo + (setq prefix-command--last-echo + (let ((strs nil)) + (run-hook-wrapped 'prefix-command-echo-keystrokes-functions + (lambda (fun) (push (funcall fun) strs))) + (setq strs (delq nil strs)) + (when strs (mapconcat #'identity strs " ")))))) + +(defvar prefix-command-echo-keystrokes-functions nil + "Abnormal hook which constructs the description of the current prefix state. +Each function is called with no argument, should return a string or nil.") + +(defun prefix-command-update () + "Update state of prefix commands. +Call it whenever you change the \"prefix command state\"." + (setq prefix-command--needs-update t)) + +(defvar prefix-command-preserve-state-hook nil + "Normal hook run when a command needs to preserve the prefix.") + +(defun prefix-command-preserve-state () + "Pass the current prefix command state to the next command. +Should be called by all prefix commands. +Runs `prefix-command-preserve-state-hook'." + (run-hooks 'prefix-command-preserve-state-hook) + ;; If the current command is a prefix command, we don't want the next (real) + ;; command to have `last-command' set to, say, `universal-argument'. + (setq this-command last-command) + (setq real-this-command real-last-command) + (prefix-command-update)) + +(defun reset-this-command-lengths () + (declare (obsolete prefix-command-preserve-state "25.1")) + nil) + +;;;;; The main prefix command. + +;; FIXME: Declaration of `prefix-arg' should be moved here!? + +(add-hook 'prefix-command-echo-keystrokes-functions + #'universal-argument--description) +(defun universal-argument--description () + (when prefix-arg + (concat "C-u" + (pcase prefix-arg + (`(-) " -") + (`(,(and (pred integerp) n)) + (let ((str "")) + (while (and (> n 4) (= (mod n 4) 0)) + (setq str (concat str " C-u")) + (setq n (/ n 4))) + (if (= n 4) str (format " %s" prefix-arg)))) + (_ (format " %s" prefix-arg)))))) + +(add-hook 'prefix-command-preserve-state-hook + #'universal-argument--preserve) +(defun universal-argument--preserve () + (setq prefix-arg current-prefix-arg)) + (defvar universal-argument-map (let ((map (make-sparse-keymap)) (universal-argument-minus @@ -3664,7 +3735,8 @@ see other processes running on the system, use `list-system-processes'." "Keymap used while processing \\[universal-argument].") (defun universal-argument--mode () - (set-transient-map universal-argument-map)) + (prefix-command-update) + (set-transient-map universal-argument-map nil)) (defun universal-argument () "Begin a numeric argument for the following command. @@ -3677,6 +3749,7 @@ For some commands, just \\[universal-argument] by itself serves as a flag which is different in effect from any particular numeric argument. These commands include \\[set-mark-command] and \\[start-kbd-macro]." (interactive) + (prefix-command-preserve-state) (setq prefix-arg (list 4)) (universal-argument--mode)) @@ -3684,6 +3757,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." ;; A subsequent C-u means to multiply the factor by 4 if we've typed ;; nothing but C-u's; otherwise it means to terminate the prefix arg. (interactive "P") + (prefix-command-preserve-state) (setq prefix-arg (if (consp arg) (list (* 4 (car arg))) (if (eq arg '-) @@ -3695,6 +3769,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." "Begin a negative numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." (interactive "P") + (prefix-command-preserve-state) (setq prefix-arg (cond ((integerp arg) (- arg)) ((eq arg '-) nil) (t '-))) @@ -3704,6 +3779,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." "Part of the numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." (interactive "P") + (prefix-command-preserve-state) (let* ((char (if (integerp last-command-event) last-command-event (get last-command-event 'ascii-character))) diff --git a/src/keyboard.c b/src/keyboard.c index d7a533b80b7..a8b1e9828bf 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -107,10 +107,6 @@ static Lisp_Object recent_keys; Lisp_Object this_command_keys; ptrdiff_t this_command_key_count; -/* True after calling Freset_this_command_lengths. - Usually it is false. */ -static bool this_command_key_count_reset; - /* This vector is used as a buffer to record the events that were actually read by read_key_sequence. */ static Lisp_Object raw_keybuf; @@ -124,11 +120,6 @@ static int raw_keybuf_count; that precede this key sequence. */ static ptrdiff_t this_single_command_key_start; -/* Record values of this_command_key_count and echo_length () - before this command was read. */ -static ptrdiff_t before_command_key_count; -static ptrdiff_t before_command_echo_length; - #ifdef HAVE_STACK_OVERFLOW_HANDLING /* For longjmp to recover from C stack overflow. */ @@ -441,10 +432,12 @@ echo_add_key (Lisp_Object c) ptrdiff_t size = sizeof initbuf; char *buffer = initbuf; char *ptr = buffer; - Lisp_Object echo_string; + Lisp_Object echo_string = KVAR (current_kboard, echo_string); USE_SAFE_ALLOCA; - echo_string = KVAR (current_kboard, echo_string); + if (STRINGP (echo_string) && SCHARS (echo_string) > 0) + /* Add a space at the end as a separator between keys. */ + ptr++[0] = ' '; /* If someone has passed us a composite event, use its head symbol. */ c = EVENT_HEAD (c); @@ -486,48 +479,12 @@ echo_add_key (Lisp_Object c) ptr += len; } - /* Replace a dash from echo_dash with a space, otherwise add a space - at the end as a separator between keys. */ - AUTO_STRING (space, " "); - if (STRINGP (echo_string) && SCHARS (echo_string) > 1) - { - Lisp_Object last_char, prev_char, idx; - - idx = make_number (SCHARS (echo_string) - 2); - prev_char = Faref (echo_string, idx); - - idx = make_number (SCHARS (echo_string) - 1); - last_char = Faref (echo_string, idx); - - /* We test PREV_CHAR to make sure this isn't the echoing of a - minus-sign. */ - if (XINT (last_char) == '-' && XINT (prev_char) != ' ') - Faset (echo_string, idx, make_number (' ')); - else - echo_string = concat2 (echo_string, space); - } - else if (STRINGP (echo_string) && SCHARS (echo_string) > 0) - echo_string = concat2 (echo_string, space); - kset_echo_string (current_kboard, concat2 (echo_string, make_string (buffer, ptr - buffer))); SAFE_FREE (); } -/* Add C to the echo string, if echoing is going on. C can be a - character or a symbol. */ - -static void -echo_char (Lisp_Object c) -{ - if (current_kboard->immediate_echo) - { - echo_add_key (c); - echo_now (); - } -} - /* Temporarily add a dash to the end of the echo string if it's not empty, so that it serves as a mini-prompt for the very next character. */ @@ -539,9 +496,6 @@ echo_dash (void) if (NILP (KVAR (current_kboard, echo_string))) return; - if (this_command_key_count == 0) - return; - if (!current_kboard->immediate_echo && SCHARS (KVAR (current_kboard, echo_string)) == 0) return; @@ -574,39 +528,39 @@ echo_dash (void) echo_now (); } -/* Display the current echo string, and begin echoing if not already - doing so. */ - static void -echo_now (void) +echo_update (void) { - if (!current_kboard->immediate_echo) + if (current_kboard->immediate_echo) { ptrdiff_t i; - current_kboard->immediate_echo = true; + kset_echo_string (current_kboard, + call0 (Qinternal_echo_keystrokes_prefix)); for (i = 0; i < this_command_key_count; i++) { Lisp_Object c; - /* Set before_command_echo_length to the value that would - have been saved before the start of this subcommand in - command_loop_1, if we had already been echoing then. */ - if (i == this_single_command_key_start) - before_command_echo_length = echo_length (); - c = AREF (this_command_keys, i); if (! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) - echo_char (c); + echo_add_key (c); } - /* Set before_command_echo_length to the value that would - have been saved before the start of this subcommand in - command_loop_1, if we had already been echoing then. */ - if (this_command_key_count == this_single_command_key_start) - before_command_echo_length = echo_length (); + echo_now (); + } +} + +/* Display the current echo string, and begin echoing if not already + doing so. */ +static void +echo_now (void) +{ + if (!current_kboard->immediate_echo) + { + current_kboard->immediate_echo = true; + echo_update (); /* Put a dash at the end to invite the user to type more. */ echo_dash (); } @@ -666,20 +620,6 @@ echo_truncate (ptrdiff_t nchars) static void add_command_key (Lisp_Object key) { -#if 0 /* Not needed after we made Freset_this_command_lengths - do the job immediately. */ - /* If reset-this-command-length was called recently, obey it now. - See the doc string of that function for an explanation of why. */ - if (before_command_restore_flag) - { - this_command_key_count = before_command_key_count_1; - if (this_command_key_count < this_single_command_key_start) - this_single_command_key_start = this_command_key_count; - echo_truncate (before_command_echo_length_1); - before_command_restore_flag = 0; - } -#endif - if (this_command_key_count >= ASIZE (this_command_keys)) this_command_keys = larger_vector (this_command_keys, 1, -1); @@ -1285,10 +1225,6 @@ static void adjust_point_for_property (ptrdiff_t, bool); /* The last boundary auto-added to buffer-undo-list. */ Lisp_Object last_undo_boundary; -/* FIXME: This is wrong rather than test window-system, we should call - a new set-selection, which will then dispatch to x-set-selection, or - tty-set-selection, or w32-set-selection, ... */ - Lisp_Object command_loop_1 (void) { @@ -1306,7 +1242,6 @@ command_loop_1 (void) cancel_echoing (); this_command_key_count = 0; - this_command_key_count_reset = false; this_single_command_key_start = 0; if (NILP (Vmemory_full)) @@ -1394,9 +1329,6 @@ command_loop_1 (void) && !NILP (Ffboundp (Qrecompute_lucid_menubar))) call0 (Qrecompute_lucid_menubar); - before_command_key_count = this_command_key_count; - before_command_echo_length = echo_length (); - Vthis_command = Qnil; Vreal_this_command = Qnil; Vthis_original_command = Qnil; @@ -1424,7 +1356,6 @@ command_loop_1 (void) { cancel_echoing (); this_command_key_count = 0; - this_command_key_count_reset = false; this_single_command_key_start = 0; goto finalize; } @@ -1509,14 +1440,13 @@ command_loop_1 (void) } #endif - if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ - { - Lisp_Object undo = BVAR (current_buffer, undo_list); - Fundo_boundary (); - last_undo_boundary - = (EQ (undo, BVAR (current_buffer, undo_list)) - ? Qnil : BVAR (current_buffer, undo_list)); - } + { + Lisp_Object undo = BVAR (current_buffer, undo_list); + Fundo_boundary (); + last_undo_boundary + = (EQ (undo, BVAR (current_buffer, undo_list)) + ? Qnil : BVAR (current_buffer, undo_list)); + } call1 (Qcommand_execute, Vthis_command); #ifdef HAVE_WINDOW_SYSTEM @@ -1544,31 +1474,23 @@ command_loop_1 (void) safe_run_hooks (Qdeferred_action_function); - /* If there is a prefix argument, - 1) We don't want Vlast_command to be ``universal-argument'' - (that would be dumb), so don't set Vlast_command, - 2) we want to leave echoing on so that the prefix will be - echoed as part of this key sequence, so don't call - cancel_echoing, and - 3) we want to leave this_command_key_count non-zero, so that - read_char will realize that it is re-reading a character, and - not echo it a second time. - - If the command didn't actually create a prefix arg, - but is merely a frame event that is transparent to prefix args, - then the above doesn't apply. */ - if (NILP (KVAR (current_kboard, Vprefix_arg)) - || CONSP (last_command_event)) + kset_last_command (current_kboard, Vthis_command); + kset_real_last_command (current_kboard, Vreal_this_command); + if (!CONSP (last_command_event)) + kset_last_repeatable_command (current_kboard, Vreal_this_command); + + this_command_key_count = 0; + this_single_command_key_start = 0; + + if (current_kboard->immediate_echo + && !NILP (call0 (Qinternal_echo_keystrokes_prefix))) { - kset_last_command (current_kboard, Vthis_command); - kset_real_last_command (current_kboard, Vreal_this_command); - if (!CONSP (last_command_event)) - kset_last_repeatable_command (current_kboard, Vreal_this_command); - cancel_echoing (); - this_command_key_count = 0; - this_command_key_count_reset = false; - this_single_command_key_start = 0; + current_kboard->immediate_echo = false; + /* Refresh the echo message. */ + echo_now (); } + else + cancel_echoing (); if (!NILP (BVAR (current_buffer, mark_active)) && !NILP (Vrun_hooks)) @@ -2389,10 +2311,6 @@ read_char (int commandflag, Lisp_Object map, also_record = Qnil; -#if 0 /* This was commented out as part of fixing echo for C-u left. */ - before_command_key_count = this_command_key_count; - before_command_echo_length = echo_length (); -#endif c = Qnil; previous_echo_area_message = Qnil; @@ -2471,8 +2389,6 @@ read_char (int commandflag, Lisp_Object map, goto reread_for_input_method; } - this_command_key_count_reset = false; - if (!NILP (Vexecuting_kbd_macro)) { /* We set this to Qmacro; since that's not a frame, nobody will @@ -2570,7 +2486,7 @@ read_char (int commandflag, Lisp_Object map, (3) There's only one place in 20.x where ok_to_echo_at_next_pause is set to a non-null value. This is done in read_char and it is - set to echo_area_glyphs after a call to echo_char. That means + set to echo_area_glyphs. That means ok_to_echo_at_next_pause is either null or current_kboard->echobuf with the appropriate current_kboard at that time. @@ -2674,7 +2590,8 @@ read_char (int commandflag, Lisp_Object map, if (minibuf_level == 0 && !end_time && !current_kboard->immediate_echo - && this_command_key_count > 0 + && (this_command_key_count > 0 + || !NILP (call0 (Qinternal_echo_keystrokes_prefix))) && ! noninteractive && echo_keystrokes_p () && (/* No message. */ @@ -3018,7 +2935,6 @@ read_char (int commandflag, Lisp_Object map, { Lisp_Object keys; ptrdiff_t key_count; - bool key_count_reset; ptrdiff_t command_key_start; ptrdiff_t count = SPECPDL_INDEX (); @@ -3028,20 +2944,8 @@ read_char (int commandflag, Lisp_Object map, Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string); ptrdiff_t saved_echo_after_prompt = current_kboard->echo_after_prompt; -#if 0 - if (before_command_restore_flag) - { - this_command_key_count = before_command_key_count_1; - if (this_command_key_count < this_single_command_key_start) - this_single_command_key_start = this_command_key_count; - echo_truncate (before_command_echo_length_1); - before_command_restore_flag = 0; - } -#endif - /* Save the this_command_keys status. */ key_count = this_command_key_count; - key_count_reset = this_command_key_count_reset; command_key_start = this_single_command_key_start; if (key_count > 0) @@ -3051,7 +2955,6 @@ read_char (int commandflag, Lisp_Object map, /* Clear out this_command_keys. */ this_command_key_count = 0; - this_command_key_count_reset = false; this_single_command_key_start = 0; /* Now wipe the echo area. */ @@ -3075,7 +2978,6 @@ read_char (int commandflag, Lisp_Object map, /* Restore the saved echoing state and this_command_keys state. */ this_command_key_count = key_count; - this_command_key_count_reset = key_count_reset; this_single_command_key_start = command_key_start; if (key_count > 0) this_command_keys = keys; @@ -3141,28 +3043,23 @@ read_char (int commandflag, Lisp_Object map, goto retry; } - if ((! reread || this_command_key_count == 0 - || this_command_key_count_reset) + if ((! reread || this_command_key_count == 0) && !end_time) { /* Don't echo mouse motion events. */ - if (echo_keystrokes_p () - && ! (EVENT_HAS_PARAMETERS (c) - && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) - { - echo_char (c); - if (! NILP (also_record)) - echo_char (also_record); - /* Once we reread a character, echoing can happen - the next time we pause to read a new one. */ - ok_to_echo_at_next_pause = current_kboard; - } + if (! (EVENT_HAS_PARAMETERS (c) + && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) + /* Once we reread a character, echoing can happen + the next time we pause to read a new one. */ + ok_to_echo_at_next_pause = current_kboard; /* Record this character as part of the current key. */ add_command_key (c); if (! NILP (also_record)) add_command_key (also_record); + + echo_update (); } last_input_event = c; @@ -3218,23 +3115,13 @@ record_menu_key (Lisp_Object c) record_char (c); -#if 0 - before_command_key_count = this_command_key_count; - before_command_echo_length = echo_length (); -#endif - - /* Don't echo mouse motion events. */ - if (echo_keystrokes_p ()) - { - echo_char (c); - - /* Once we reread a character, echoing can happen - the next time we pause to read a new one. */ - ok_to_echo_at_next_pause = 0; - } + /* Once we reread a character, echoing can happen + the next time we pause to read a new one. */ + ok_to_echo_at_next_pause = NULL; /* Record this character as part of the current key. */ add_command_key (c); + echo_update (); /* Re-reading in the middle of a command. */ last_input_event = c; @@ -9120,11 +9007,12 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, { key = keybuf[t]; add_command_key (key); - if (echo_keystrokes_p () - && current_kboard->immediate_echo) + if (current_kboard->immediate_echo) { - echo_add_key (key); - echo_dash (); + /* Set immediate_echo to false so as to force echo_now to + redisplay (it will set immediate_echo right back to true). */ + current_kboard->immediate_echo = false; + echo_now (); } } @@ -9788,11 +9676,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, Better ideas? */ for (; t < mock_input; t++) - { - if (echo_keystrokes_p ()) - echo_char (keybuf[t]); - add_command_key (keybuf[t]); - } + add_command_key (keybuf[t]); + echo_update (); return t; } @@ -9819,7 +9704,6 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, if (NILP (continue_echo)) { this_command_key_count = 0; - this_command_key_count_reset = false; this_single_command_key_start = 0; } @@ -10076,33 +9960,6 @@ The value is always a vector. */) return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->contents); } -DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, - Sreset_this_command_lengths, 0, 0, 0, - doc: /* Make the unread events replace the last command and echo. -Used in `universal-argument-other-key'. - -`universal-argument-other-key' rereads the event just typed. -It then gets translated through `function-key-map'. -The translated event has to replace the real events, -both in the value of (this-command-keys) and in echoing. -To achieve this, `universal-argument-other-key' calls -`reset-this-command-lengths', which discards the record of reading -these events the first time. */) - (void) -{ - this_command_key_count = before_command_key_count; - if (this_command_key_count < this_single_command_key_start) - this_single_command_key_start = this_command_key_count; - - echo_truncate (before_command_echo_length); - - /* Cause whatever we put into unread-command-events - to echo as if it were being freshly read from the keyboard. */ - this_command_key_count_reset = true; - - return Qnil; -} - DEFUN ("clear-this-command-keys", Fclear_this_command_keys, Sclear_this_command_keys, 0, 1, 0, doc: /* Clear out the vector that `this-command-keys' returns. @@ -10113,7 +9970,6 @@ KEEP-RECORD is non-nil. */) int i; this_command_key_count = 0; - this_command_key_count_reset = false; if (NILP (keep_record)) { @@ -11210,6 +11066,7 @@ syms_of_keyboard (void) staticpro (&raw_keybuf); DEFSYM (Qcommand_execute, "command-execute"); + DEFSYM (Qinternal_echo_keystrokes_prefix, "internal-echo-keystrokes-prefix"); accent_key_syms = Qnil; staticpro (&accent_key_syms); @@ -11253,7 +11110,6 @@ syms_of_keyboard (void) defsubr (&Sthis_command_keys_vector); defsubr (&Sthis_single_command_keys); defsubr (&Sthis_single_command_raw_keys); - defsubr (&Sreset_this_command_lengths); defsubr (&Sclear_this_command_keys); defsubr (&Ssuspend_emacs); defsubr (&Sabort_recursive_edit); |