procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Generalize the prefix-command machinery of C-u

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2015-09-01 21:14:18 -04:00
parent afe1cf0071
commit 5dc644a6b0
5 changed files with 193 additions and 282 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
etc/NEWS
View file

@ -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'.

53
lisp/emulation/cua-base.el
View file

@ -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.

50
lisp/kmacro.el
View file

@ -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)

80
lisp/simple.el
View file

@ -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)))

288
src/keyboard.c
View file

@ -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,6 +528,29 @@ echo_dash (void)
echo_now ();
}
static void
echo_update (void)
{
if (current_kboard->immediate_echo)
{
ptrdiff_t i;
kset_echo_string (current_kboard,
call0 (Qinternal_echo_keystrokes_prefix));
for (i = 0; i < this_command_key_count; i++)
{
Lisp_Object c;
c = AREF (this_command_keys, i);
if (! (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
echo_add_key (c);
}
echo_now ();
}
}
/* Display the current echo string, and begin echoing if not already
doing so. */
@ -582,31 +559,8 @@ echo_now (void)
{
if (!current_kboard->immediate_echo)
{
ptrdiff_t i;
current_kboard->immediate_echo = true;
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);
}
/* 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_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.
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);
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))
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);