[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 5dc644a: Generalize the prefix-command machinery of
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 5dc644a: Generalize the prefix-command machinery of C-u |
|
Date: |
Wed, 02 Sep 2015 01:14:28 +0000 |
branch: master
commit 5dc644a6b01e2cf950ff617ab15be4bf1917c38c
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
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.
---
etc/NEWS | 4 +
lisp/emulation/cua-base.el | 53 +++++----
lisp/kmacro.el | 50 ++-------
lisp/simple.el | 80 ++++++++++++-
src/keyboard.c | 278 +++++++++++---------------------------------
5 files changed, 188 insertions(+), 277 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 3832ffa..e50e7a7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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 e91ce80..52e1647 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 9636a36..ddf3005 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 6f76d75..b8d4e74 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 d7a533b..a8b1e98 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);
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 5dc644a: Generalize the prefix-command machinery of C-u,
Stefan Monnier <=