diff options
| author | Stefan Monnier | 2015-09-01 21:14:18 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2015-09-01 21:14:18 -0400 |
| commit | 5dc644a6b01e2cf950ff617ab15be4bf1917c38c (patch) | |
| tree | f5572fd4d2c5cc68ac54e48fbd7541bd8043fadc /lisp/emulation | |
| parent | afe1cf00713847c1d8f3a9d95d4980d705ec39f1 (diff) | |
| download | emacs-5dc644a6b01e2cf950ff617ab15be4bf1917c38c.tar.gz emacs-5dc644a6b01e2cf950ff617ab15be4bf1917c38c.zip | |
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.
Diffstat (limited to 'lisp/emulation')
| -rw-r--r-- | lisp/emulation/cua-base.el | 53 |
1 files changed, 30 insertions, 23 deletions
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index e91ce80bbe2..52e1647ede7 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el | |||
| @@ -685,7 +685,7 @@ a cons (TYPE . COLOR), then both properties are affected." | |||
| 685 | (defvar cua--prefix-override-timer nil) | 685 | (defvar cua--prefix-override-timer nil) |
| 686 | (defvar cua--prefix-override-length nil) | 686 | (defvar cua--prefix-override-length nil) |
| 687 | 687 | ||
| 688 | (defun cua--prefix-override-replay (arg repeat) | 688 | (defun cua--prefix-override-replay (repeat) |
| 689 | (let* ((keys (this-command-keys)) | 689 | (let* ((keys (this-command-keys)) |
| 690 | (i (length keys)) | 690 | (i (length keys)) |
| 691 | (key (aref keys (1- i)))) | 691 | (key (aref keys (1- i)))) |
| @@ -705,21 +705,23 @@ a cons (TYPE . COLOR), then both properties are affected." | |||
| 705 | ;; Don't record this command | 705 | ;; Don't record this command |
| 706 | (setq this-command last-command) | 706 | (setq this-command last-command) |
| 707 | ;; Restore the prefix arg | 707 | ;; Restore the prefix arg |
| 708 | (setq prefix-arg arg) | 708 | ;; This should make it so that exchange-point-and-mark gets the prefix when |
| 709 | (reset-this-command-lengths) | 709 | ;; you do C-u C-x C-x C-x work (where the C-u is properly passed to the C-x |
| 710 | ;; C-x binding after the first C-x C-x was rewritten to just C-x). | ||
| 711 | (prefix-command-preserve-state) | ||
| 710 | ;; Push the key back on the event queue | 712 | ;; Push the key back on the event queue |
| 711 | (setq unread-command-events (cons key unread-command-events)))) | 713 | (setq unread-command-events (cons key unread-command-events)))) |
| 712 | 714 | ||
| 713 | (defun cua--prefix-override-handler (arg) | 715 | (defun cua--prefix-override-handler () |
| 714 | "Start timer waiting for prefix key to be followed by another key. | 716 | "Start timer waiting for prefix key to be followed by another key. |
| 715 | Repeating prefix key when region is active works as a single prefix key." | 717 | Repeating prefix key when region is active works as a single prefix key." |
| 716 | (interactive "P") | 718 | (interactive) |
| 717 | (cua--prefix-override-replay arg 0)) | 719 | (cua--prefix-override-replay 0)) |
| 718 | 720 | ||
| 719 | (defun cua--prefix-repeat-handler (arg) | 721 | (defun cua--prefix-repeat-handler () |
| 720 | "Repeating prefix key when region is active works as a single prefix key." | 722 | "Repeating prefix key when region is active works as a single prefix key." |
| 721 | (interactive "P") | 723 | (interactive) |
| 722 | (cua--prefix-override-replay arg 1)) | 724 | (cua--prefix-override-replay 1)) |
| 723 | 725 | ||
| 724 | (defun cua--prefix-copy-handler (arg) | 726 | (defun cua--prefix-copy-handler (arg) |
| 725 | "Copy region/rectangle, then replay last key." | 727 | "Copy region/rectangle, then replay last key." |
| @@ -742,7 +744,8 @@ Repeating prefix key when region is active works as a single prefix key." | |||
| 742 | (when (= (length (this-command-keys)) cua--prefix-override-length) | 744 | (when (= (length (this-command-keys)) cua--prefix-override-length) |
| 743 | (setq unread-command-events (cons 'timeout unread-command-events)) | 745 | (setq unread-command-events (cons 'timeout unread-command-events)) |
| 744 | (if prefix-arg | 746 | (if prefix-arg |
| 745 | (reset-this-command-lengths) | 747 | nil |
| 748 | ;; FIXME: Why? | ||
| 746 | (setq overriding-terminal-local-map nil)) | 749 | (setq overriding-terminal-local-map nil)) |
| 747 | (cua--select-keymaps))) | 750 | (cua--select-keymaps))) |
| 748 | 751 | ||
| @@ -755,8 +758,9 @@ Repeating prefix key when region is active works as a single prefix key." | |||
| 755 | (call-interactively this-command)) | 758 | (call-interactively this-command)) |
| 756 | 759 | ||
| 757 | (defun cua--keep-active () | 760 | (defun cua--keep-active () |
| 758 | (setq mark-active t | 761 | (when (mark t) |
| 759 | deactivate-mark nil)) | 762 | (setq mark-active t |
| 763 | deactivate-mark nil))) | ||
| 760 | 764 | ||
| 761 | (defun cua--deactivate (&optional now) | 765 | (defun cua--deactivate (&optional now) |
| 762 | (if (not now) | 766 | (if (not now) |
| @@ -944,7 +948,7 @@ See also `exchange-point-and-mark'." | |||
| 944 | (cond ((null cua-enable-cua-keys) | 948 | (cond ((null cua-enable-cua-keys) |
| 945 | (exchange-point-and-mark arg)) | 949 | (exchange-point-and-mark arg)) |
| 946 | (arg | 950 | (arg |
| 947 | (setq mark-active t)) | 951 | (when (mark t) (setq mark-active t))) |
| 948 | (t | 952 | (t |
| 949 | (let (mark-active) | 953 | (let (mark-active) |
| 950 | (exchange-point-and-mark) | 954 | (exchange-point-and-mark) |
| @@ -1212,25 +1216,28 @@ If ARG is the atom `-', scroll upward by nearly full screen." | |||
| 1212 | 1216 | ||
| 1213 | (defvar cua--keymaps-initialized nil) | 1217 | (defvar cua--keymaps-initialized nil) |
| 1214 | 1218 | ||
| 1215 | (defun cua--shift-control-prefix (prefix arg) | 1219 | (defun cua--shift-control-prefix (prefix) |
| 1216 | ;; handle S-C-x and S-C-c by emulating the fast double prefix function. | 1220 | ;; handle S-C-x and S-C-c by emulating the fast double prefix function. |
| 1217 | ;; Don't record this command | 1221 | ;; Don't record this command |
| 1218 | (setq this-command last-command) | 1222 | (setq this-command last-command) |
| 1219 | ;; Restore the prefix arg | 1223 | ;; Restore the prefix arg |
| 1220 | (setq prefix-arg arg) | 1224 | ;; This should make it so that exchange-point-and-mark gets the prefix when |
| 1221 | (reset-this-command-lengths) | 1225 | ;; you do C-u S-C-x C-x work (where the C-u is properly passed to the C-x |
| 1226 | ;; C-x binding after the first S-C-x was rewritten to just C-x). | ||
| 1227 | (prefix-command-preserve-state) | ||
| 1222 | ;; Activate the cua--prefix-repeat-keymap | 1228 | ;; Activate the cua--prefix-repeat-keymap |
| 1223 | (setq cua--prefix-override-timer 'shift) | 1229 | (setq cua--prefix-override-timer 'shift) |
| 1224 | ;; Push duplicate keys back on the event queue | 1230 | ;; Push duplicate keys back on the event queue |
| 1225 | (setq unread-command-events (cons prefix (cons prefix unread-command-events)))) | 1231 | (setq unread-command-events |
| 1232 | (cons prefix (cons prefix unread-command-events)))) | ||
| 1226 | 1233 | ||
| 1227 | (defun cua--shift-control-c-prefix (arg) | 1234 | (defun cua--shift-control-c-prefix () |
| 1228 | (interactive "P") | 1235 | (interactive) |
| 1229 | (cua--shift-control-prefix ?\C-c arg)) | 1236 | (cua--shift-control-prefix ?\C-c)) |
| 1230 | 1237 | ||
| 1231 | (defun cua--shift-control-x-prefix (arg) | 1238 | (defun cua--shift-control-x-prefix () |
| 1232 | (interactive "P") | 1239 | (interactive) |
| 1233 | (cua--shift-control-prefix ?\C-x arg)) | 1240 | (cua--shift-control-prefix ?\C-x)) |
| 1234 | 1241 | ||
| 1235 | (defun cua--init-keymaps () | 1242 | (defun cua--init-keymaps () |
| 1236 | ;; Cache actual rectangle modifier key. | 1243 | ;; Cache actual rectangle modifier key. |