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

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