Commit | Line | Data |
---|---|---|
c6fe19d5 MW |
1 | ;;; -*-emacs-lisp-*- |
2 | ;;; | |
3 | ;;; Key bindings for Magnar Sveen's `multiple-cursors' package | |
4 | ;;; | |
5 | ;;; (c) 2014 Mark Wooding | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This program is free software; you can redistribute it and/or modify | |
11 | ;;; it under the terms of the GNU General Public License as published by | |
12 | ;;; the Free Software Foundation; either version 2 of the License, or | |
13 | ;;; (at your option) any later version. | |
14 | ;;; | |
15 | ;;; This program is distributed in the hope that it will be useful, | |
16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
19 | ;;; | |
20 | ;;; You should have received a copy of the GNU General Public License | |
21 | ;;; along with this program; if not, write to the Free Software Foundation, | |
22 | ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
23 | ||
24 | ;; Loading and setup: | |
25 | ;; | |
26 | ;; (global-set-key [...] 'mdw-multiple-values-keymap) | |
27 | ;; (autoload 'mdw-multiple-cursors-keymap "mdw-multiple-cursors.el" | |
28 | ;; "A keymap for Magnar Sveen's awesome multiple-cursors." nil 'keymap) | |
29 | ||
51f93214 MW |
30 | (require 'cl-lib) |
31 | ||
c6fe19d5 MW |
32 | ;;;-------------------------------------------------------------------------- |
33 | ;;; Some machinery for omitting key prefixes. | |
34 | ||
35 | (defvar mdw-omit-prefix-enable-repeat t | |
36 | "*If true, allow invoking sequences of commands without repeating prefixes. | |
37 | This is both a user twiddle (which you can turn on and off depending on | |
38 | whether you like the feature) and a state variable used by the | |
39 | implementation.") | |
40 | ||
41 | (defun mdw-omit-prefix-repeat (keys tag) | |
42 | "Maybe invoke other commands with the same prefix. | |
43 | The KEYS which invoked the current command, usually as collected via | |
44 | `this-single-command-keys'. If the next keystroke refers to a command | |
45 | whose name has a `mdw-omit-prefix-repeat' property with value TAG then run | |
46 | that command and repeat. | |
47 | ||
48 | Call this at the end of your command function if you want to allow prefix | |
49 | omission. Honours the `mdw-omit-prefix-enable-repeat' variable." | |
50 | (when mdw-omit-prefix-enable-repeat | |
51 | (let ((n (1- (length keys))) cmd done | |
52 | (mdw-omit-prefix-enable-repeat nil)) | |
53 | (while (not done) | |
54 | (setq done t) | |
55 | (aset keys n (read-event)) | |
56 | (let* ((cmd (key-binding keys t)) | |
57 | (cmdtag (get cmd 'mdw-omit-prefix-repeat))) | |
58 | (clear-this-command-keys t) | |
59 | (when (eq cmdtag tag) | |
60 | (setq done nil) | |
61 | (call-interactively cmd)))) | |
62 | (when last-input-event | |
63 | (setq unread-command-events (list last-input-event)))))) | |
64 | ||
65 | (defmacro mdw-omit-prefix-wrapper (name func args tag &rest things) | |
66 | "Generate a prefix-omission wrapper function around a command. | |
67 | The wrapper will be called NAME; it will invoke FUNC, passing it ARGS; | |
68 | commands in the same keymap whose `mdw-omit-prefix-enable-repeat' | |
69 | property has the value TAG can be invoked without repeating the | |
70 | prefix. The THINGS are items (such as documentation or `interactive' | |
71 | forms) to appear at the start of the wrapper function." | |
72 | `(progn | |
73 | (defun ,name ,args | |
74 | ,@things | |
75 | (let ((keys (this-single-command-keys))) | |
76 | (,func ,@args) | |
77 | (mdw-omit-prefix-repeat keys ',tag))) | |
78 | (put ',name 'mdw-omit-prefix-repeat ',tag) | |
79 | ',name)) | |
80 | ||
81 | ;;;-------------------------------------------------------------------------- | |
82 | ;;; The multiple-cursors key bindings. | |
83 | ||
51f93214 | 84 | (cl-eval-when (load eval) |
c6fe19d5 MW |
85 | (require 'multiple-cursors)) |
86 | ||
87 | (defvar mdw-multiple-cursors-keymap (make-sparse-keymap) | |
88 | "Keymap for `multiple-cursors'.") | |
89 | (fset 'mdw-multiple-cursors-keymap mdw-multiple-cursors-keymap) | |
90 | ||
91 | (defmacro mdw-make-multiple-cursors-repeat-wrappers (&rest specs) | |
92 | "Set up wrappers around the `multiple-cursors' functions. | |
93 | Each of the SPECS has the form | |
94 | ||
95 | (FUNC ARGS INTERACT BIND) | |
96 | ||
97 | where: | |
98 | ||
99 | * FUNC is the existing function which is to be wrapped; | |
100 | ||
101 | * ARGS are the arguments to be collected by the wrapper function, | |
102 | and passed to FUNC; | |
103 | ||
104 | * INTERACT is an `interactive' string, or `nil' (if there are no | |
105 | interactive arguments to be collected); and | |
106 | ||
107 | * BIND is the key binding to set in `mdw-multiple-cursors-keymap'." | |
108 | ||
109 | `(progn | |
110 | ,@(apply #'append | |
111 | (mapcar (lambda (spec) | |
112 | (let* ((func (car spec)) | |
113 | (args (cadr spec)) | |
114 | (interact (car (cddr spec))) | |
115 | (bind (cadr (cddr spec))) | |
116 | (wrapper (intern | |
117 | (concat "mdw-" | |
118 | (symbol-name func))))) | |
119 | `((mdw-omit-prefix-wrapper | |
120 | ,wrapper ,func ,args | |
121 | multiple-cursors | |
122 | (interactive ,@(and interact | |
123 | (list interact)))) | |
124 | (define-key mdw-multiple-cursors-keymap | |
125 | ,bind ',wrapper) | |
126 | (pushnew ',wrapper mc/cmds-to-run-once)))) | |
127 | specs)) | |
128 | '(,@(mapcar #'car specs)))) | |
129 | ||
130 | ;; Set up commands which want omit-prefix wrappers. | |
131 | (mdw-make-multiple-cursors-repeat-wrappers | |
132 | (mc/mark-next-like-this (arg) "p" "\C-s") | |
133 | (mc/mark-previous-like-this (arg) "p" "\C-r") | |
134 | (mc/mark-next-word-like-this (arg) "p" "\M-f") | |
135 | (mc/mark-previous-word-like-this (arg) "p" "\M-b") | |
136 | (mc/mark-next-symbol-like-this (arg) "p" "\C-\M-f") | |
137 | (mc/mark-previous-symbol-like-this (arg) "p" "\C-\M-b") | |
138 | (mc/skip-to-next-like-this () nil "\M-s") | |
139 | (mc/skip-to-previous-like-this () nil "\M-r") | |
140 | (mc/unmark-next-like-this () nil "\C-\M-s") | |
141 | (mc/unmark-previous-like-this () nil "\C-\M-r") | |
142 | (mc/cycle-forward () nil "\M-n") | |
143 | (mc/cycle-backward () nil "\M-p") | |
144 | (mc/mark-all-like-this-dwim (arg) "p" "a")) | |
145 | ||
146 | ;; Set up other commands. | |
147 | (let ((map mdw-multiple-cursors-keymap)) | |
148 | (define-key map "/" 'mc/mark-sgml-tag-pair) | |
149 | (define-key map "\M-a" 'mc/mark-all-dwim) | |
150 | (define-key map "e" 'mc/edit-lines) | |
151 | (define-key map "\C-e" 'mc/edit-ends-of-lines) | |
152 | (define-key map "\C-a" 'mc/edit-beginnings-of-lines) | |
153 | (define-key map "\C-@" 'set-rectangular-region-anchor) | |
154 | (define-key map [?\C- ] 'set-rectangular-region-anchor)) | |
155 | ||
38cde5d3 MW |
156 | ;;;-------------------------------------------------------------------------- |
157 | ;;; Various little tweaks. | |
158 | ||
159 | (define-key mc/keymap "\C-m" 'multiple-cursors-mode) | |
160 | ||
c6fe19d5 MW |
161 | ;;;----- That's all, folks -------------------------------------------------- |
162 | ||
163 | (provide 'mdw-multiple-cursors) |