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 | ||
30 | ;;;-------------------------------------------------------------------------- | |
31 | ;;; Some machinery for omitting key prefixes. | |
32 | ||
33 | (defvar mdw-omit-prefix-enable-repeat t | |
34 | "*If true, allow invoking sequences of commands without repeating prefixes. | |
35 | This is both a user twiddle (which you can turn on and off depending on | |
36 | whether you like the feature) and a state variable used by the | |
37 | implementation.") | |
38 | ||
39 | (defun mdw-omit-prefix-repeat (keys tag) | |
40 | "Maybe invoke other commands with the same prefix. | |
41 | The KEYS which invoked the current command, usually as collected via | |
42 | `this-single-command-keys'. If the next keystroke refers to a command | |
43 | whose name has a `mdw-omit-prefix-repeat' property with value TAG then run | |
44 | that command and repeat. | |
45 | ||
46 | Call this at the end of your command function if you want to allow prefix | |
47 | omission. Honours the `mdw-omit-prefix-enable-repeat' variable." | |
48 | (when mdw-omit-prefix-enable-repeat | |
49 | (let ((n (1- (length keys))) cmd done | |
50 | (mdw-omit-prefix-enable-repeat nil)) | |
51 | (while (not done) | |
52 | (setq done t) | |
53 | (aset keys n (read-event)) | |
54 | (let* ((cmd (key-binding keys t)) | |
55 | (cmdtag (get cmd 'mdw-omit-prefix-repeat))) | |
56 | (clear-this-command-keys t) | |
57 | (when (eq cmdtag tag) | |
58 | (setq done nil) | |
59 | (call-interactively cmd)))) | |
60 | (when last-input-event | |
61 | (setq unread-command-events (list last-input-event)))))) | |
62 | ||
63 | (defmacro mdw-omit-prefix-wrapper (name func args tag &rest things) | |
64 | "Generate a prefix-omission wrapper function around a command. | |
65 | The wrapper will be called NAME; it will invoke FUNC, passing it ARGS; | |
66 | commands in the same keymap whose `mdw-omit-prefix-enable-repeat' | |
67 | property has the value TAG can be invoked without repeating the | |
68 | prefix. The THINGS are items (such as documentation or `interactive' | |
69 | forms) to appear at the start of the wrapper function." | |
70 | `(progn | |
71 | (defun ,name ,args | |
72 | ,@things | |
73 | (let ((keys (this-single-command-keys))) | |
74 | (,func ,@args) | |
75 | (mdw-omit-prefix-repeat keys ',tag))) | |
76 | (put ',name 'mdw-omit-prefix-repeat ',tag) | |
77 | ',name)) | |
78 | ||
79 | ;;;-------------------------------------------------------------------------- | |
80 | ;;; The multiple-cursors key bindings. | |
81 | ||
82 | (eval-when (load eval) | |
83 | (require 'multiple-cursors)) | |
84 | ||
85 | (defvar mdw-multiple-cursors-keymap (make-sparse-keymap) | |
86 | "Keymap for `multiple-cursors'.") | |
87 | (fset 'mdw-multiple-cursors-keymap mdw-multiple-cursors-keymap) | |
88 | ||
89 | (defmacro mdw-make-multiple-cursors-repeat-wrappers (&rest specs) | |
90 | "Set up wrappers around the `multiple-cursors' functions. | |
91 | Each of the SPECS has the form | |
92 | ||
93 | (FUNC ARGS INTERACT BIND) | |
94 | ||
95 | where: | |
96 | ||
97 | * FUNC is the existing function which is to be wrapped; | |
98 | ||
99 | * ARGS are the arguments to be collected by the wrapper function, | |
100 | and passed to FUNC; | |
101 | ||
102 | * INTERACT is an `interactive' string, or `nil' (if there are no | |
103 | interactive arguments to be collected); and | |
104 | ||
105 | * BIND is the key binding to set in `mdw-multiple-cursors-keymap'." | |
106 | ||
107 | `(progn | |
108 | ,@(apply #'append | |
109 | (mapcar (lambda (spec) | |
110 | (let* ((func (car spec)) | |
111 | (args (cadr spec)) | |
112 | (interact (car (cddr spec))) | |
113 | (bind (cadr (cddr spec))) | |
114 | (wrapper (intern | |
115 | (concat "mdw-" | |
116 | (symbol-name func))))) | |
117 | `((mdw-omit-prefix-wrapper | |
118 | ,wrapper ,func ,args | |
119 | multiple-cursors | |
120 | (interactive ,@(and interact | |
121 | (list interact)))) | |
122 | (define-key mdw-multiple-cursors-keymap | |
123 | ,bind ',wrapper) | |
124 | (pushnew ',wrapper mc/cmds-to-run-once)))) | |
125 | specs)) | |
126 | '(,@(mapcar #'car specs)))) | |
127 | ||
128 | ;; Set up commands which want omit-prefix wrappers. | |
129 | (mdw-make-multiple-cursors-repeat-wrappers | |
130 | (mc/mark-next-like-this (arg) "p" "\C-s") | |
131 | (mc/mark-previous-like-this (arg) "p" "\C-r") | |
132 | (mc/mark-next-word-like-this (arg) "p" "\M-f") | |
133 | (mc/mark-previous-word-like-this (arg) "p" "\M-b") | |
134 | (mc/mark-next-symbol-like-this (arg) "p" "\C-\M-f") | |
135 | (mc/mark-previous-symbol-like-this (arg) "p" "\C-\M-b") | |
136 | (mc/skip-to-next-like-this () nil "\M-s") | |
137 | (mc/skip-to-previous-like-this () nil "\M-r") | |
138 | (mc/unmark-next-like-this () nil "\C-\M-s") | |
139 | (mc/unmark-previous-like-this () nil "\C-\M-r") | |
140 | (mc/cycle-forward () nil "\M-n") | |
141 | (mc/cycle-backward () nil "\M-p") | |
142 | (mc/mark-all-like-this-dwim (arg) "p" "a")) | |
143 | ||
144 | ;; Set up other commands. | |
145 | (let ((map mdw-multiple-cursors-keymap)) | |
146 | (define-key map "/" 'mc/mark-sgml-tag-pair) | |
147 | (define-key map "\M-a" 'mc/mark-all-dwim) | |
148 | (define-key map "e" 'mc/edit-lines) | |
149 | (define-key map "\C-e" 'mc/edit-ends-of-lines) | |
150 | (define-key map "\C-a" 'mc/edit-beginnings-of-lines) | |
151 | (define-key map "\C-@" 'set-rectangular-region-anchor) | |
152 | (define-key map [?\C- ] 'set-rectangular-region-anchor)) | |
153 | ||
38cde5d3 MW |
154 | ;;;-------------------------------------------------------------------------- |
155 | ;;; Various little tweaks. | |
156 | ||
157 | (define-key mc/keymap "\C-m" 'multiple-cursors-mode) | |
158 | ||
c6fe19d5 MW |
159 | ;;;----- That's all, folks -------------------------------------------------- |
160 | ||
161 | (provide 'mdw-multiple-cursors) |