+;;; -*-emacs-lisp-*-
+;;;
+;;; Key bindings for Magnar Sveen's `multiple-cursors' package
+;;;
+;;; (c) 2014 Mark Wooding
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;; Loading and setup:
+;;
+;; (global-set-key [...] 'mdw-multiple-values-keymap)
+;; (autoload 'mdw-multiple-cursors-keymap "mdw-multiple-cursors.el"
+;; "A keymap for Magnar Sveen's awesome multiple-cursors." nil 'keymap)
+
+;;;--------------------------------------------------------------------------
+;;; Some machinery for omitting key prefixes.
+
+(defvar mdw-omit-prefix-enable-repeat t
+ "*If true, allow invoking sequences of commands without repeating prefixes.
+This is both a user twiddle (which you can turn on and off depending on
+whether you like the feature) and a state variable used by the
+implementation.")
+
+(defun mdw-omit-prefix-repeat (keys tag)
+ "Maybe invoke other commands with the same prefix.
+The KEYS which invoked the current command, usually as collected via
+`this-single-command-keys'. If the next keystroke refers to a command
+whose name has a `mdw-omit-prefix-repeat' property with value TAG then run
+that command and repeat.
+
+Call this at the end of your command function if you want to allow prefix
+omission. Honours the `mdw-omit-prefix-enable-repeat' variable."
+ (when mdw-omit-prefix-enable-repeat
+ (let ((n (1- (length keys))) cmd done
+ (mdw-omit-prefix-enable-repeat nil))
+ (while (not done)
+ (setq done t)
+ (aset keys n (read-event))
+ (let* ((cmd (key-binding keys t))
+ (cmdtag (get cmd 'mdw-omit-prefix-repeat)))
+ (clear-this-command-keys t)
+ (when (eq cmdtag tag)
+ (setq done nil)
+ (call-interactively cmd))))
+ (when last-input-event
+ (setq unread-command-events (list last-input-event))))))
+
+(defmacro mdw-omit-prefix-wrapper (name func args tag &rest things)
+ "Generate a prefix-omission wrapper function around a command.
+The wrapper will be called NAME; it will invoke FUNC, passing it ARGS;
+commands in the same keymap whose `mdw-omit-prefix-enable-repeat'
+property has the value TAG can be invoked without repeating the
+prefix. The THINGS are items (such as documentation or `interactive'
+forms) to appear at the start of the wrapper function."
+ `(progn
+ (defun ,name ,args
+ ,@things
+ (let ((keys (this-single-command-keys)))
+ (,func ,@args)
+ (mdw-omit-prefix-repeat keys ',tag)))
+ (put ',name 'mdw-omit-prefix-repeat ',tag)
+ ',name))
+
+;;;--------------------------------------------------------------------------
+;;; The multiple-cursors key bindings.
+
+(eval-when (load eval)
+ (require 'multiple-cursors))
+
+(defvar mdw-multiple-cursors-keymap (make-sparse-keymap)
+ "Keymap for `multiple-cursors'.")
+(fset 'mdw-multiple-cursors-keymap mdw-multiple-cursors-keymap)
+
+(defmacro mdw-make-multiple-cursors-repeat-wrappers (&rest specs)
+ "Set up wrappers around the `multiple-cursors' functions.
+Each of the SPECS has the form
+
+ (FUNC ARGS INTERACT BIND)
+
+where:
+
+ * FUNC is the existing function which is to be wrapped;
+
+ * ARGS are the arguments to be collected by the wrapper function,
+ and passed to FUNC;
+
+ * INTERACT is an `interactive' string, or `nil' (if there are no
+ interactive arguments to be collected); and
+
+ * BIND is the key binding to set in `mdw-multiple-cursors-keymap'."
+
+ `(progn
+ ,@(apply #'append
+ (mapcar (lambda (spec)
+ (let* ((func (car spec))
+ (args (cadr spec))
+ (interact (car (cddr spec)))
+ (bind (cadr (cddr spec)))
+ (wrapper (intern
+ (concat "mdw-"
+ (symbol-name func)))))
+ `((mdw-omit-prefix-wrapper
+ ,wrapper ,func ,args
+ multiple-cursors
+ (interactive ,@(and interact
+ (list interact))))
+ (define-key mdw-multiple-cursors-keymap
+ ,bind ',wrapper)
+ (pushnew ',wrapper mc/cmds-to-run-once))))
+ specs))
+ '(,@(mapcar #'car specs))))
+
+;; Set up commands which want omit-prefix wrappers.
+(mdw-make-multiple-cursors-repeat-wrappers
+ (mc/mark-next-like-this (arg) "p" "\C-s")
+ (mc/mark-previous-like-this (arg) "p" "\C-r")
+ (mc/mark-next-word-like-this (arg) "p" "\M-f")
+ (mc/mark-previous-word-like-this (arg) "p" "\M-b")
+ (mc/mark-next-symbol-like-this (arg) "p" "\C-\M-f")
+ (mc/mark-previous-symbol-like-this (arg) "p" "\C-\M-b")
+ (mc/skip-to-next-like-this () nil "\M-s")
+ (mc/skip-to-previous-like-this () nil "\M-r")
+ (mc/unmark-next-like-this () nil "\C-\M-s")
+ (mc/unmark-previous-like-this () nil "\C-\M-r")
+ (mc/cycle-forward () nil "\M-n")
+ (mc/cycle-backward () nil "\M-p")
+ (mc/mark-all-like-this-dwim (arg) "p" "a"))
+
+;; Set up other commands.
+(let ((map mdw-multiple-cursors-keymap))
+ (define-key map "/" 'mc/mark-sgml-tag-pair)
+ (define-key map "\M-a" 'mc/mark-all-dwim)
+ (define-key map "e" 'mc/edit-lines)
+ (define-key map "\C-e" 'mc/edit-ends-of-lines)
+ (define-key map "\C-a" 'mc/edit-beginnings-of-lines)
+ (define-key map "\C-@" 'set-rectangular-region-anchor)
+ (define-key map [?\C- ] 'set-rectangular-region-anchor))
+
+;;;----- That's all, folks --------------------------------------------------
+
+(provide 'mdw-multiple-cursors)
~mdw / profile / commitdiff