procyberian/emacs
2
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
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 * 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'. ** New functions `filepos-to-bufferpos' and `bufferpos-to-filepos'.
** The default value of `load-read-function' is now `read'. ** 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-timer nil)
(defvar cua--prefix-override-length 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)) (let* ((keys (this-command-keys))
(i (length keys)) (i (length keys))
(key (aref keys (1- i)))) (key (aref keys (1- i))))
@ -705,21 +705,23 @@ a cons (TYPE . COLOR), then both properties are affected."
;; Don't record this command ;; Don't record this command
(setq this-command last-command) (setq this-command last-command)
;; Restore the prefix arg ;; Restore the prefix arg
(setq prefix-arg arg) ;; This should make it so that exchange-point-and-mark gets the prefix when
(reset-this-command-lengths) ;; 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 ;; Push the key back on the event queue
(setq unread-command-events (cons key unread-command-events)))) (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. "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." Repeating prefix key when region is active works as a single prefix key."
(interactive "P") (interactive)
(cua--prefix-override-replay arg 0)) (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." "Repeating prefix key when region is active works as a single prefix key."
(interactive "P") (interactive)
(cua--prefix-override-replay arg 1)) (cua--prefix-override-replay 1))
(defun cua--prefix-copy-handler (arg) (defun cua--prefix-copy-handler (arg)
"Copy region/rectangle, then replay last key." "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) (when (= (length (this-command-keys)) cua--prefix-override-length)
(setq unread-command-events (cons 'timeout unread-command-events)) (setq unread-command-events (cons 'timeout unread-command-events))
(if prefix-arg (if prefix-arg
(reset-this-command-lengths) nil
;; FIXME: Why?
(setq overriding-terminal-local-map nil)) (setq overriding-terminal-local-map nil))
(cua--select-keymaps))) (cua--select-keymaps)))
@ -755,8 +758,9 @@ Repeating prefix key when region is active works as a single prefix key."
(call-interactively this-command)) (call-interactively this-command))
(defun cua--keep-active () (defun cua--keep-active ()
(setq mark-active t (when (mark t)
deactivate-mark nil)) (setq mark-active t
deactivate-mark nil)))
(defun cua--deactivate (&optional now) (defun cua--deactivate (&optional now)
(if (not now) (if (not now)
@ -944,7 +948,7 @@ See also `exchange-point-and-mark'."
(cond ((null cua-enable-cua-keys) (cond ((null cua-enable-cua-keys)
(exchange-point-and-mark arg)) (exchange-point-and-mark arg))
(arg (arg
(setq mark-active t)) (when (mark t) (setq mark-active t)))
(t (t
(let (mark-active) (let (mark-active)
(exchange-point-and-mark) (exchange-point-and-mark)
@ -1212,25 +1216,28 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(defvar cua--keymaps-initialized nil) (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. ;; handle S-C-x and S-C-c by emulating the fast double prefix function.
;; Don't record this command ;; Don't record this command
(setq this-command last-command) (setq this-command last-command)
;; Restore the prefix arg ;; Restore the prefix arg
(setq prefix-arg arg) ;; This should make it so that exchange-point-and-mark gets the prefix when
(reset-this-command-lengths) ;; 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 ;; Activate the cua--prefix-repeat-keymap
(setq cua--prefix-override-timer 'shift) (setq cua--prefix-override-timer 'shift)
;; Push duplicate keys back on the event queue ;; 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) (defun cua--shift-control-c-prefix ()
(interactive "P") (interactive)
(cua--shift-control-prefix ?\C-c arg)) (cua--shift-control-prefix ?\C-c))
(defun cua--shift-control-x-prefix (arg) (defun cua--shift-control-x-prefix ()
(interactive "P") (interactive)
(cua--shift-control-prefix ?\C-x arg)) (cua--shift-control-prefix ?\C-x))
(defun cua--init-keymaps () (defun cua--init-keymaps ()
;; Cache actual rectangle modifier key. ;; 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-inserting) ;; inserting into macro
(defvar kmacro-step-edit-appending) ;; append to end of 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-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-key-index) ;; index of current key
(defvar kmacro-step-edit-action) ;; automatic action on next pre-command hook (defvar kmacro-step-edit-action) ;; automatic action on next pre-command hook
(defvar kmacro-step-edit-help) ;; kmacro step edit help enabled (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', following additional answers: `insert', `insert-1', `replace', `replace-1',
`append', `append-end', `act-repeat', `skip-end', `skip-keep'.") `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) (defun kmacro-step-edit-prompt (macro index)
;; Show step-edit prompt ;; Show step-edit prompt
(let ((keys (and (not kmacro-step-edit-appending) (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 ;; Handle prefix arg, or query user
(cond (cond
(act act) ;; set above (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 (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 (setq act (lookup-key kmacro-step-edit-map
(vector (with-current-buffer (current-buffer) (read-event)))))))) (vector (with-current-buffer (current-buffer) (read-event))))))))
;; Resume macro execution and perform the action ;; Resume macro execution and perform the action
(cond (cond
((eq act 'universal-argument)
nil)
((cond ((cond
((eq act 'act) ((eq act 'act)
t) t)
@ -1110,7 +1096,6 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq kmacro-step-edit-active 'ignore) (setq kmacro-step-edit-active 'ignore)
nil) nil)
((eq act 'skip) ((eq act 'skip)
(setq kmacro-step-edit-prefix-index nil)
nil) nil)
((eq act 'skip-keep) ((eq act 'skip-keep)
(setq this-command 'ignore) (setq this-command 'ignore)
@ -1123,12 +1108,11 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq act t) (setq act t)
t) t)
((member act '(insert-1 insert)) ((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)) (setq kmacro-step-edit-inserting (if (eq act 'insert-1) 1 t))
nil) nil)
((member act '(replace-1 replace)) ((member act '(replace-1 replace))
(setq kmacro-step-edit-inserting (if (eq act 'replace-1) 1 t)) (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)) (if (= executing-kbd-macro-index (length executing-kbd-macro))
(setq executing-kbd-macro (vconcat executing-kbd-macro [nil]) (setq executing-kbd-macro (vconcat executing-kbd-macro [nil])
kmacro-step-edit-appending t)) kmacro-step-edit-appending t))
@ -1148,19 +1132,19 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq act t) (setq act t)
t) t)
((eq act 'help) ((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)) (setq kmacro-step-edit-help (not kmacro-step-edit-help))
nil) nil)
(t ;; Ignore unknown responses (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)) 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 (setq kmacro-step-edit-new-macro
(vconcat kmacro-step-edit-new-macro (vconcat kmacro-step-edit-new-macro
(substring executing-kbd-macro (substring executing-kbd-macro
(or kmacro-step-edit-prefix-index kmacro-step-edit-key-index) kmacro-step-edit-key-index
(if (eq act t) nil executing-kbd-macro-index))) (if (eq act t) nil
kmacro-step-edit-prefix-index nil)) executing-kbd-macro-index)))))
(if restore-index (if restore-index
(setq executing-kbd-macro-index restore-index))) (setq executing-kbd-macro-index restore-index)))
(t (t
@ -1175,12 +1159,10 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(executing-kbd-macro nil) (executing-kbd-macro nil)
(defining-kbd-macro nil) (defining-kbd-macro nil)
cmd keys next-index) cmd keys next-index)
(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)
kmacro-step-edit-prefix-index nil)
(kmacro-step-edit-prompt macro nil) (kmacro-step-edit-prompt macro nil)
;; Now, we have read a key sequence from the macro, but we don't want ;; 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. ;; 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 keys (read-key-sequence nil nil nil nil t))
(setq cmd (key-binding keys t nil)) (setq cmd (key-binding keys t nil))
(if (cond (if (cond
@ -1201,25 +1183,12 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
unread-command-events nil))) unread-command-events nil)))
(setq cmd 'ignore) (setq cmd 'ignore)
nil) 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) ((numberp kmacro-step-edit-inserting)
(setq kmacro-step-edit-inserting nil) (setq kmacro-step-edit-inserting nil)
nil) nil)
((equal keys "\C-j") ((equal keys "\C-j")
(setq kmacro-step-edit-inserting nil) (setq kmacro-step-edit-inserting nil)
(setq kmacro-step-edit-action 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) (setq next-index kmacro-step-edit-key-index)
t) t)
(t nil)) (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-inserting nil)
(kmacro-step-edit-appending nil) (kmacro-step-edit-appending nil)
(kmacro-step-edit-replace t) (kmacro-step-edit-replace t)
(kmacro-step-edit-prefix-index nil)
(kmacro-step-edit-key-index 0) (kmacro-step-edit-key-index 0)
(kmacro-step-edit-action nil) (kmacro-step-edit-action nil)
(kmacro-step-edit-help 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." a special event, so ignore the prefix argument and don't clear it."
(setq debug-on-next-call nil) (setq debug-on-next-call nil)
(let ((prefixarg (unless special (let ((prefixarg (unless special
;; FIXME: This should probably be done around
;; pre-command-hook rather than here!
(prog1 prefix-arg (prog1 prefix-arg
(setq current-prefix-arg 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) (if (and (symbolp cmd)
(get cmd 'disabled) (get cmd 'disabled)
disabled-command-function) disabled-command-function)
@ -3626,6 +3630,73 @@ see other processes running on the system, use `list-system-processes'."
(display-buffer buffer) (display-buffer buffer)
nil) 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 (defvar universal-argument-map
(let ((map (make-sparse-keymap)) (let ((map (make-sparse-keymap))
(universal-argument-minus (universal-argument-minus
@ -3664,7 +3735,8 @@ see other processes running on the system, use `list-system-processes'."
"Keymap used while processing \\[universal-argument].") "Keymap used while processing \\[universal-argument].")
(defun universal-argument--mode () (defun universal-argument--mode ()
(set-transient-map universal-argument-map)) (prefix-command-update)
(set-transient-map universal-argument-map nil))
(defun universal-argument () (defun universal-argument ()
"Begin a numeric argument for the following command. "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. which is different in effect from any particular numeric argument.
These commands include \\[set-mark-command] and \\[start-kbd-macro]." These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive) (interactive)
(prefix-command-preserve-state)
(setq prefix-arg (list 4)) (setq prefix-arg (list 4))
(universal-argument--mode)) (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 ;; 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. ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(interactive "P") (interactive "P")
(prefix-command-preserve-state)
(setq prefix-arg (if (consp arg) (setq prefix-arg (if (consp arg)
(list (* 4 (car arg))) (list (* 4 (car arg)))
(if (eq 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. "Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument." \\[universal-argument] following digits or minus sign ends the argument."
(interactive "P") (interactive "P")
(prefix-command-preserve-state)
(setq prefix-arg (cond ((integerp arg) (- arg)) (setq prefix-arg (cond ((integerp arg) (- arg))
((eq arg '-) nil) ((eq arg '-) nil)
(t '-))) (t '-)))
@ -3704,6 +3779,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
"Part of the numeric argument for the next command. "Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument." \\[universal-argument] following digits or minus sign ends the argument."
(interactive "P") (interactive "P")
(prefix-command-preserve-state)
(let* ((char (if (integerp last-command-event) (let* ((char (if (integerp last-command-event)
last-command-event last-command-event
(get last-command-event 'ascii-character))) (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; Lisp_Object this_command_keys;
ptrdiff_t this_command_key_count; 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 /* This vector is used as a buffer to record the events that were actually read
by read_key_sequence. */ by read_key_sequence. */
static Lisp_Object raw_keybuf; static Lisp_Object raw_keybuf;
@ -124,11 +120,6 @@ static int raw_keybuf_count;
that precede this key sequence. */ that precede this key sequence. */
static ptrdiff_t this_single_command_key_start; 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 #ifdef HAVE_STACK_OVERFLOW_HANDLING
/* For longjmp to recover from C stack overflow. */ /* For longjmp to recover from C stack overflow. */
@ -441,10 +432,12 @@ echo_add_key (Lisp_Object c)
ptrdiff_t size = sizeof initbuf; ptrdiff_t size = sizeof initbuf;
char *buffer = initbuf; char *buffer = initbuf;
char *ptr = buffer; char *ptr = buffer;
Lisp_Object echo_string; Lisp_Object echo_string = KVAR (current_kboard, echo_string);
USE_SAFE_ALLOCA; 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. */ /* If someone has passed us a composite event, use its head symbol. */
c = EVENT_HEAD (c); c = EVENT_HEAD (c);
@ -486,48 +479,12 @@ echo_add_key (Lisp_Object c)
ptr += len; 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 kset_echo_string
(current_kboard, (current_kboard,
concat2 (echo_string, make_string (buffer, ptr - buffer))); concat2 (echo_string, make_string (buffer, ptr - buffer)));
SAFE_FREE (); 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 /* 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 empty, so that it serves as a mini-prompt for the very next
character. */ character. */
@ -539,9 +496,6 @@ echo_dash (void)
if (NILP (KVAR (current_kboard, echo_string))) if (NILP (KVAR (current_kboard, echo_string)))
return; return;
if (this_command_key_count == 0)
return;
if (!current_kboard->immediate_echo if (!current_kboard->immediate_echo
&& SCHARS (KVAR (current_kboard, echo_string)) == 0) && SCHARS (KVAR (current_kboard, echo_string)) == 0)
return; return;
@ -574,6 +528,29 @@ echo_dash (void)
echo_now (); 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 /* Display the current echo string, and begin echoing if not already
doing so. */ doing so. */
@ -582,31 +559,8 @@ echo_now (void)
{ {
if (!current_kboard->immediate_echo) if (!current_kboard->immediate_echo)
{ {
ptrdiff_t i;
current_kboard->immediate_echo = true; current_kboard->immediate_echo = true;
echo_update ();
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 ();
/* Put a dash at the end to invite the user to type more. */ /* Put a dash at the end to invite the user to type more. */
echo_dash (); echo_dash ();
} }
@ -666,20 +620,6 @@ echo_truncate (ptrdiff_t nchars)
static void static void
add_command_key (Lisp_Object key) 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)) if (this_command_key_count >= ASIZE (this_command_keys))
this_command_keys = larger_vector (this_command_keys, 1, -1); 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. */ /* The last boundary auto-added to buffer-undo-list. */
Lisp_Object last_undo_boundary; 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 Lisp_Object
command_loop_1 (void) command_loop_1 (void)
{ {
@ -1306,7 +1242,6 @@ command_loop_1 (void)
cancel_echoing (); cancel_echoing ();
this_command_key_count = 0; this_command_key_count = 0;
this_command_key_count_reset = false;
this_single_command_key_start = 0; this_single_command_key_start = 0;
if (NILP (Vmemory_full)) if (NILP (Vmemory_full))
@ -1394,9 +1329,6 @@ command_loop_1 (void)
&& !NILP (Ffboundp (Qrecompute_lucid_menubar))) && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
call0 (Qrecompute_lucid_menubar); call0 (Qrecompute_lucid_menubar);
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
Vthis_command = Qnil; Vthis_command = Qnil;
Vreal_this_command = Qnil; Vreal_this_command = Qnil;
Vthis_original_command = Qnil; Vthis_original_command = Qnil;
@ -1424,7 +1356,6 @@ command_loop_1 (void)
{ {
cancel_echoing (); cancel_echoing ();
this_command_key_count = 0; this_command_key_count = 0;
this_command_key_count_reset = false;
this_single_command_key_start = 0; this_single_command_key_start = 0;
goto finalize; goto finalize;
} }
@ -1509,14 +1440,13 @@ command_loop_1 (void)
} }
#endif #endif
if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ {
{ Lisp_Object undo = BVAR (current_buffer, undo_list);
Lisp_Object undo = BVAR (current_buffer, undo_list); Fundo_boundary ();
Fundo_boundary (); last_undo_boundary
last_undo_boundary = (EQ (undo, BVAR (current_buffer, undo_list))
= (EQ (undo, BVAR (current_buffer, undo_list)) ? Qnil : BVAR (current_buffer, undo_list));
? Qnil : BVAR (current_buffer, undo_list)); }
}
call1 (Qcommand_execute, Vthis_command); call1 (Qcommand_execute, Vthis_command);
#ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_WINDOW_SYSTEM
@ -1544,31 +1474,23 @@ command_loop_1 (void)
safe_run_hooks (Qdeferred_action_function); safe_run_hooks (Qdeferred_action_function);
/* If there is a prefix argument, kset_last_command (current_kboard, Vthis_command);
1) We don't want Vlast_command to be ``universal-argument'' kset_real_last_command (current_kboard, Vreal_this_command);
(that would be dumb), so don't set Vlast_command, if (!CONSP (last_command_event))
2) we want to leave echoing on so that the prefix will be kset_last_repeatable_command (current_kboard, Vreal_this_command);
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, this_command_key_count = 0;
but is merely a frame event that is transparent to prefix args, this_single_command_key_start = 0;
then the above doesn't apply. */
if (NILP (KVAR (current_kboard, Vprefix_arg)) if (current_kboard->immediate_echo
|| CONSP (last_command_event)) && !NILP (call0 (Qinternal_echo_keystrokes_prefix)))
{ {
kset_last_command (current_kboard, Vthis_command); current_kboard->immediate_echo = false;
kset_real_last_command (current_kboard, Vreal_this_command); /* Refresh the echo message. */
if (!CONSP (last_command_event)) echo_now ();
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;
} }
else
cancel_echoing ();
if (!NILP (BVAR (current_buffer, mark_active)) if (!NILP (BVAR (current_buffer, mark_active))
&& !NILP (Vrun_hooks)) && !NILP (Vrun_hooks))
@ -2389,10 +2311,6 @@ read_char (int commandflag, Lisp_Object map,
also_record = Qnil; 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; c = Qnil;
previous_echo_area_message = Qnil; previous_echo_area_message = Qnil;
@ -2471,8 +2389,6 @@ read_char (int commandflag, Lisp_Object map,
goto reread_for_input_method; goto reread_for_input_method;
} }
this_command_key_count_reset = false;
if (!NILP (Vexecuting_kbd_macro)) if (!NILP (Vexecuting_kbd_macro))
{ {
/* We set this to Qmacro; since that's not a frame, nobody will /* 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 (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 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 ok_to_echo_at_next_pause is either null or
current_kboard->echobuf with the appropriate current_kboard at current_kboard->echobuf with the appropriate current_kboard at
that time. that time.
@ -2674,7 +2590,8 @@ read_char (int commandflag, Lisp_Object map,
if (minibuf_level == 0 if (minibuf_level == 0
&& !end_time && !end_time
&& !current_kboard->immediate_echo && !current_kboard->immediate_echo
&& this_command_key_count > 0 && (this_command_key_count > 0
|| !NILP (call0 (Qinternal_echo_keystrokes_prefix)))
&& ! noninteractive && ! noninteractive
&& echo_keystrokes_p () && echo_keystrokes_p ()
&& (/* No message. */ && (/* No message. */
@ -3018,7 +2935,6 @@ read_char (int commandflag, Lisp_Object map,
{ {
Lisp_Object keys; Lisp_Object keys;
ptrdiff_t key_count; ptrdiff_t key_count;
bool key_count_reset;
ptrdiff_t command_key_start; ptrdiff_t command_key_start;
ptrdiff_t count = SPECPDL_INDEX (); 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); Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
ptrdiff_t saved_echo_after_prompt = current_kboard->echo_after_prompt; 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. */ /* Save the this_command_keys status. */
key_count = this_command_key_count; key_count = this_command_key_count;
key_count_reset = this_command_key_count_reset;
command_key_start = this_single_command_key_start; command_key_start = this_single_command_key_start;
if (key_count > 0) if (key_count > 0)
@ -3051,7 +2955,6 @@ read_char (int commandflag, Lisp_Object map,
/* Clear out this_command_keys. */ /* Clear out this_command_keys. */
this_command_key_count = 0; this_command_key_count = 0;
this_command_key_count_reset = false;
this_single_command_key_start = 0; this_single_command_key_start = 0;
/* Now wipe the echo area. */ /* Now wipe the echo area. */
@ -3075,7 +2978,6 @@ read_char (int commandflag, Lisp_Object map,
/* Restore the saved echoing state /* Restore the saved echoing state
and this_command_keys state. */ and this_command_keys state. */
this_command_key_count = key_count; this_command_key_count = key_count;
this_command_key_count_reset = key_count_reset;
this_single_command_key_start = command_key_start; this_single_command_key_start = command_key_start;
if (key_count > 0) if (key_count > 0)
this_command_keys = keys; this_command_keys = keys;
@ -3141,28 +3043,23 @@ read_char (int commandflag, Lisp_Object map,
goto retry; goto retry;
} }
if ((! reread || this_command_key_count == 0 if ((! reread || this_command_key_count == 0)
|| this_command_key_count_reset)
&& !end_time) && !end_time)
{ {
/* Don't echo mouse motion events. */ /* Don't echo mouse motion events. */
if (echo_keystrokes_p () if (! (EVENT_HAS_PARAMETERS (c)
&& ! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
&& 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. */
echo_char (c); ok_to_echo_at_next_pause = current_kboard;
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;
}
/* Record this character as part of the current key. */ /* Record this character as part of the current key. */
add_command_key (c); add_command_key (c);
if (! NILP (also_record)) if (! NILP (also_record))
add_command_key (also_record); add_command_key (also_record);
echo_update ();
} }
last_input_event = c; last_input_event = c;
@ -3218,23 +3115,13 @@ record_menu_key (Lisp_Object c)
record_char (c); record_char (c);
#if 0 /* Once we reread a character, echoing can happen
before_command_key_count = this_command_key_count; the next time we pause to read a new one. */
before_command_echo_length = echo_length (); ok_to_echo_at_next_pause = NULL;
#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;
}
/* Record this character as part of the current key. */ /* Record this character as part of the current key. */
add_command_key (c); add_command_key (c);
echo_update ();
/* Re-reading in the middle of a command. */ /* Re-reading in the middle of a command. */
last_input_event = c; last_input_event = c;
@ -9120,11 +9007,12 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
{ {
key = keybuf[t]; key = keybuf[t];
add_command_key (key); add_command_key (key);
if (echo_keystrokes_p () if (current_kboard->immediate_echo)
&& current_kboard->immediate_echo)
{ {
echo_add_key (key); /* Set immediate_echo to false so as to force echo_now to
echo_dash (); 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? */ Better ideas? */
for (; t < mock_input; t++) for (; t < mock_input; t++)
{ add_command_key (keybuf[t]);
if (echo_keystrokes_p ()) echo_update ();
echo_char (keybuf[t]);
add_command_key (keybuf[t]);
}
return t; return t;
} }
@ -9819,7 +9704,6 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
if (NILP (continue_echo)) if (NILP (continue_echo))
{ {
this_command_key_count = 0; this_command_key_count = 0;
this_command_key_count_reset = false;
this_single_command_key_start = 0; 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); 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, DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
Sclear_this_command_keys, 0, 1, 0, Sclear_this_command_keys, 0, 1, 0,
doc: /* Clear out the vector that `this-command-keys' returns. doc: /* Clear out the vector that `this-command-keys' returns.
@ -10113,7 +9970,6 @@ KEEP-RECORD is non-nil. */)
int i; int i;
this_command_key_count = 0; this_command_key_count = 0;
this_command_key_count_reset = false;
if (NILP (keep_record)) if (NILP (keep_record))
{ {
@ -11210,6 +11066,7 @@ syms_of_keyboard (void)
staticpro (&raw_keybuf); staticpro (&raw_keybuf);
DEFSYM (Qcommand_execute, "command-execute"); DEFSYM (Qcommand_execute, "command-execute");
DEFSYM (Qinternal_echo_keystrokes_prefix, "internal-echo-keystrokes-prefix");
accent_key_syms = Qnil; accent_key_syms = Qnil;
staticpro (&accent_key_syms); staticpro (&accent_key_syms);
@ -11253,7 +11110,6 @@ syms_of_keyboard (void)
defsubr (&Sthis_command_keys_vector); defsubr (&Sthis_command_keys_vector);
defsubr (&Sthis_single_command_keys); defsubr (&Sthis_single_command_keys);
defsubr (&Sthis_single_command_raw_keys); defsubr (&Sthis_single_command_raw_keys);
defsubr (&Sreset_this_command_lengths);
defsubr (&Sclear_this_command_keys); defsubr (&Sclear_this_command_keys);
defsubr (&Ssuspend_emacs); defsubr (&Ssuspend_emacs);
defsubr (&Sabort_recursive_edit); defsubr (&Sabort_recursive_edit);