chiark / gitweb /
dot/zshrc: Turn off `KSH_GLOB'.
[profile] / el / mdw-multiple-cursors.el
CommitLineData
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.
35This is both a user twiddle (which you can turn on and off depending on
36whether you like the feature) and a state variable used by the
37implementation.")
38
39(defun mdw-omit-prefix-repeat (keys tag)
40 "Maybe invoke other commands with the same prefix.
41The KEYS which invoked the current command, usually as collected via
42`this-single-command-keys'. If the next keystroke refers to a command
43whose name has a `mdw-omit-prefix-repeat' property with value TAG then run
44that command and repeat.
45
46Call this at the end of your command function if you want to allow prefix
47omission. 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.
65The wrapper will be called NAME; it will invoke FUNC, passing it ARGS;
66commands in the same keymap whose `mdw-omit-prefix-enable-repeat'
67property has the value TAG can be invoked without repeating the
68prefix. The THINGS are items (such as documentation or `interactive'
69forms) 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.
91Each of the SPECS has the form
92
93 (FUNC ARGS INTERACT BIND)
94
95where:
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)