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