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

;;;--------------------------------------------------------------------------
;;; Various little tweaks.

(define-key mc/keymap "\C-m" 'multiple-cursors-mode)

;;;----- That's all, folks --------------------------------------------------

(provide 'mdw-multiple-cursors)