chiark - git - mdw - profile/blob - 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)