| 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) |