chiark / gitweb /
dot/emacs, el/dot-emacs.el: Gather mode settings together.
[profile] / el / mdw-multiple-cursors.el
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
154 ;;;--------------------------------------------------------------------------
155 ;;; Various little tweaks.
156
157 (define-key mc/keymap "\C-m" 'multiple-cursors-mode)
158
159 ;;;----- That's all, folks --------------------------------------------------
160
161 (provide 'mdw-multiple-cursors)