Separate secondary stuff from core.

This commit is contained in:
Magnar Sveen 2012-06-07 11:11:19 +02:00
parent 00896cf47f
commit 139202758b
5 changed files with 280 additions and 266 deletions

35
mc-edit-lines.el Normal file
View File

@ -0,0 +1,35 @@
(defun mc/edit-lines ()
"Add one cursor to each line of the active region.
Starts from mark and moves in straight down or up towards the
line point is on.
Could possibly be used to mark multiple regions with
mark-multiple if point and mark is on different columns."
(interactive)
(when (not (use-region-p))
(error "Mark a set of lines first."))
(mc/remove-additional-cursors)
(let* ((point-line (line-number-at-pos))
(mark-line (progn (exchange-point-and-mark) (line-number-at-pos)))
(navigation-func (if (< point-line mark-line) 'previous-line 'next-line)))
(deactivate-mark)
(while (not (eq (line-number-at-pos) point-line))
(mc/create-fake-cursor-at-point)
(funcall navigation-func))
(multiple-cursors-mode)))
(defun mc/edit-ends-of-lines ()
"Add one cursor to the end of each line in the active region."
(interactive)
(mc/edit-lines)
(mc/execute-command-for-all-fake-cursors 'end-of-line)
(end-of-line))
(defun mc/edit-beginnings-of-lines ()
"Add one cursor to the beginning of each line in the active region."
(interactive)
(mc/edit-lines)
(mc/execute-command-for-all-fake-cursors 'beginning-of-line)
(beginning-of-line))
(provide 'mc-edit-lines)

View File

@ -0,0 +1,17 @@
(require 'mark-multiple)
(defun mc/switch-from-mark-multiple-to-cursors ()
"Removes mark-multiple and switches to multiple cursors instead"
(interactive)
(let ((offset (- (point) (overlay-start mm/master))))
(deactivate-mark)
(save-excursion
(dolist (mirror mm/mirrors)
(goto-char (+ offset (overlay-start mirror)))
(mc/create-fake-cursor-at-point)))
(mm/clear-all)
(multiple-cursors-mode)))
(define-key mm/keymap (kbd "C-g") 'mc/switch-from-mark-multiple-to-cursors)
(provide 'mc-mark-multiple-integration)

224
multiple-cursors-core.el Normal file
View File

@ -0,0 +1,224 @@
(defface mc/cursor-face
'((t (:inverse-video t)))
"The face used for fake cursors"
:group 'multiple-cursors)
(defface mc/region-face
'((t :inherit region))
"The face used for fake regions"
:group 'multiple-cursors)
(defun mc/make-cursor-overlay-at-eol (pos)
"Create overlay to look like cursor at end of line."
(let ((overlay (make-overlay pos pos nil nil t)))
(overlay-put overlay 'after-string (propertize " " 'face 'mc/cursor-face))
overlay))
(defun mc/make-cursor-overlay-inline (pos)
"Create overlay to look like cursor inside text."
(let ((overlay (make-overlay pos (1+ pos) nil nil t)))
(overlay-put overlay 'face 'mc/cursor-face)
overlay))
(defun mc/make-cursor-overlay-at-point ()
"Create overlay to look like cursor.
Special case for end of line, because overlay over a newline
highlights the entire width of the window."
(if (eolp)
(mc/make-cursor-overlay-at-eol (point))
(mc/make-cursor-overlay-inline (point))))
(defun mc/make-region-overlay-between-point-and-mark ()
"Create overlay to look like active region."
(let ((overlay (make-overlay (mark) (point) nil nil t)))
(overlay-put overlay 'face 'mc/region-face)
(overlay-put overlay 'type 'additional-region)
overlay))
(defun mc/store-current-state-in-overlay (o)
"Store relevant info about point and mark in the given overlay."
(overlay-put o 'point (set-marker (make-marker) (point)))
(overlay-put o 'kill-ring kill-ring)
(overlay-put o 'mark (set-marker (make-marker) (mark)))
(overlay-put o 'mark-ring mark-ring)
(overlay-put o 'mark-active mark-active)
(overlay-put o 'er/history er/history)
o)
(defun mc/restore-state-from-overlay (o)
"Restore point and mark from stored info in the given overlay."
(goto-char (overlay-get o 'point))
(setq kill-ring (overlay-get o 'kill-ring))
(set-marker (mark-marker) (overlay-get o 'mark))
(setq mark-ring (overlay-get o 'mark-ring))
(setq mark-active (overlay-get o 'mark-active))
(setq er/history (overlay-get o 'er/history)))
(defun mc/clean-up-state-overlay (o)
"Delete overlay with state, including dependent overlays and markers."
(set-marker (overlay-get o 'point) nil)
(set-marker (overlay-get o 'mark) nil)
(mc/delete-region-overlay o)
(delete-overlay o))
(defun mc/pop-state-from-overlay (o)
"Restore the state stored in given overlay and then remove the overlay."
(mc/restore-state-from-overlay o)
(mc/clean-up-state-overlay o))
(defun mc/delete-region-overlay (o)
"Remove the dependent region overlay for a given cursor overlay."
(ignore-errors
(delete-overlay (overlay-get o 'region-overlay))))
(defun mc/create-fake-cursor-at-point ()
"Add a fake cursor and possibly a fake active region overlay based on point and mark.
Saves the current state in the overlay to be restored later."
(let ((overlay (mc/make-cursor-overlay-at-point)))
(overlay-put overlay 'type 'additional-cursor)
(overlay-put overlay 'priority 100)
(mc/store-current-state-in-overlay overlay)
(when (use-region-p)
(overlay-put overlay 'region-overlay
(mc/make-region-overlay-between-point-and-mark)))))
(defun mc/execute-command-for-all-fake-cursors (cmd)
"Calls CMD interactively for each cursor.
It works by moving point to the fake cursor, setting
up the proper kill-ring, and then removing the cursor.
After executing the command, it sets up a new fake
cursor with updated info."
(let ((current-state (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t)))
(annoying-arrows-mode nil))
(save-excursion
(mapc #'(lambda (o)
(when (eq (overlay-get o 'type) 'additional-cursor)
(mc/pop-state-from-overlay o)
(ignore-errors
(call-interactively cmd)
(when deactivate-mark (deactivate-mark))
(mc/create-fake-cursor-at-point))))
(overlays-in (point-min) (point-max))))
(mc/pop-state-from-overlay current-state)))
(defun mc/execute-this-command-for-all-cursors ()
"Used with post-command-hook to execute supported commands for
all cursors. It also checks a list of explicitly unsupported
commands that is prevented even for the original cursor, to
inform about the lack of support.
Commands that are neither supported nor explicitly unsupported
is executed normally for point, but skipped for the fake
cursors."
(if (memq this-original-command mc--unsupported-cmds)
(message "%S is not supported with multiple cursors" this-original-command)
(if (not (memq this-original-command mc--cmds))
(message "Skipping %S" this-original-command)
(mc/execute-command-for-all-fake-cursors this-original-command))))
(defun mc/remove-additional-cursors ()
"Remove all fake cursors.
Do not use to conclude editing with multiple cursors. For that
you should disable multiple-cursors-mode."
(mapc #'(lambda (o)
(when (eq (overlay-get o 'type) 'additional-cursor)
(mc/clean-up-state-overlay o)))
(overlays-in (point-min) (point-max))))
(defun mc/keyboard-quit ()
(interactive)
(if (not (use-region-p))
(multiple-cursors-mode 0)
(deactivate-mark)))
(defvar mc/keymap nil
"Keymap while multiple cursors are active.
Main goal of the keymap is to rebind C-g and <return> to conclude
multiple cursors editing.")
(if mc/keymap
nil
(setq mc/keymap (make-sparse-keymap))
(define-key mc/keymap (kbd "C-g") 'mc/keyboard-quit)
(define-key mc/keymap (kbd "<return>") 'multiple-cursors-mode))
(define-minor-mode multiple-cursors-mode
"Mode while multiple cursors are active."
nil " mc" mc/keymap
(cond ((not multiple-cursors-mode)
(remove-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t)
(mc/remove-additional-cursors))
(t (add-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t t))))
(defvar mc--unsupported-cmds '()
"List of commands that does not work well with multiple cursors.
Set up with the unsupported-cmd macro.")
(defmacro unsupported-cmd (cmd)
"Adds command to list of unsupported commands and prevents it
from being executed if in multiple-cursors-mode."
`(progn
(push (quote ,cmd) mc--unsupported-cmds)
(defadvice ,cmd (around unsupported-advice activate)
"command isn't supported with multiple cursors"
(unless multiple-cursors-mode
ad-do-it))))
;; Commands that make a giant mess of multiple cursors
(unsupported-cmd yank-pop)
;; Commands that should be mirrored by all cursors
(setq mc--cmds '(mc/keyboard-quit
self-insert-command
js2-insert-and-indent
wrap-region-trigger
sgml-slash
slime-space
previous-line
next-line
newline
yas/expand
newline-and-indent
join-line
right-char forward-char
right-word forward-word
left-char backward-char
left-word backward-word
subword-upcase upcase-word
subword-downcase downcase-word
subword-capitalize capitalize-word
forward-list
backward-list
hippie-expand hippie-expand-lines
yank yank-indented
kill-word
kill-region-or-backward-word
kill-line
kill-whole-line
backward-kill-word
backward-delete-char-untabify
delete-char c-electric-delete-forward
delete-backward-char c-electric-backspace
c-electric-paren
c-electric-semi&comma
org-shiftright
just-one-space
zap-to-char
end-of-line
set-mark-command
js2-beginning-of-line
js2-end-of-line
js2r-inline-var
change-number-at-point
move-end-of-line
move-end-of-line-or-next-line
beginning-of-line
er/expand-region
er/mark-word
move-beginning-of-line
move-start-of-line-or-prev-line
dired-back-to-start-of-files
save-region-or-current-line
back-to-indentation))
(provide 'multiple-cursors-core)

View File

@ -72,271 +72,9 @@
;;; Code: ;;; Code:
(require 'mark-multiple) (require 'multiple-cursors-core)
(require 'mc-edit-lines)
(defface mc/cursor-face (require 'mc-mark-multiple-integration)
'((t (:inverse-video t)))
"The face used for additional cursors"
:group 'multiple-cursors)
(defface mc/region-face
'((t :inherit region))
"The face used for additional regions"
:group 'multiple-cursors)
(defun mc/make-cursor-overlay-at-eol (pos)
"Create overlay to look like cursor at end of line."
(let ((overlay (make-overlay pos pos nil nil t)))
(overlay-put overlay 'after-string (propertize " " 'face 'mc/cursor-face))
overlay))
(defun mc/make-cursor-overlay-inline (pos)
"Create overlay to look like cursor inside text."
(let ((overlay (make-overlay pos (1+ pos) nil nil t)))
(overlay-put overlay 'face 'mc/cursor-face)
overlay))
(defun mc/make-cursor-overlay-at-point ()
"Create overlay to look like cursor.
Special case for end of line, because overlay over a newline
highlights the entire width of the window."
(if (eolp)
(mc/make-cursor-overlay-at-eol (point))
(mc/make-cursor-overlay-inline (point))))
(defun mc/make-region-overlay-between-point-and-mark ()
(let ((overlay (make-overlay (mark) (point) nil nil t)))
(overlay-put overlay 'face 'mc/region-face)
(overlay-put overlay 'type 'additional-region)
overlay))
(defun mc/store-current-state-in-overlay (o)
(overlay-put o 'point (point))
(overlay-put o 'kill-ring kill-ring)
(overlay-put o 'mark (set-marker (make-marker) (mark)))
(overlay-put o 'mark-ring mark-ring)
(overlay-put o 'mark-active mark-active)
(overlay-put o 'er/history er/history)
o)
(defun mc/restore-state-from-overlay (o)
(goto-char (overlay-get o 'point))
(setq kill-ring (overlay-get o 'kill-ring))
(set-marker (mark-marker) (overlay-get o 'mark))
(setq mark-ring (overlay-get o 'mark-ring))
(setq mark-active (overlay-get o 'mark-active))
(setq er/history (overlay-get o 'er/history)))
(defun mc/clean-up-state-overlay (o)
(set-marker (overlay-get o 'mark) nil)
(mc/delete-region-overlay o)
(delete-overlay o))
(defun mc/pop-state-from-overlay (o)
(mc/restore-state-from-overlay o)
(mc/clean-up-state-overlay o))
(defun mc/delete-region-overlay (o)
(ignore-errors
(delete-overlay (overlay-get o 'region-overlay))))
(defun mc/create-fake-cursor-at-point ()
"Add a fake cursor and possibly a fake active region overlay based on point and mark.
Saves the current state in the overlay to be restored later."
(let ((overlay (mc/make-cursor-overlay-at-point)))
(overlay-put overlay 'type 'additional-cursor)
(overlay-put overlay 'priority 100)
(mc/store-current-state-in-overlay overlay)
(when (use-region-p)
(overlay-put overlay 'region-overlay
(mc/make-region-overlay-between-point-and-mark)))))
(defun mc/execute-command-for-all-fake-cursors (cmd)
"Calls CMD interactively for each cursor.
It works by moving point to the fake cursor, setting
up the proper kill-ring, and then removing the cursor.
After executing the command, it sets up a new fake
cursor with updated info."
(let ((current-state (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t)))
(annoying-arrows-mode nil))
(save-excursion
(mapc #'(lambda (o)
(when (eq (overlay-get o 'type) 'additional-cursor)
(mc/pop-state-from-overlay o)
(ignore-errors
(call-interactively cmd)
(when deactivate-mark (deactivate-mark))
(mc/create-fake-cursor-at-point))))
(overlays-in (point-min) (point-max))))
(mc/pop-state-from-overlay current-state)))
(defun mc/execute-this-command-for-all-cursors ()
"Used with post-command-hook to execute supported commands for
all cursors. It also checks a list of explicitly unsupported
commands that is prevented even for the original cursor, to
inform about the lack of support.
Commands that are neither supported nor explicitly unsupported
is executed normally for point, but skipped for the fake
cursors."
(if (memq this-original-command mc--unsupported-cmds)
(message "%S is not supported with multiple cursors" this-original-command)
(if (not (memq this-original-command mc--cmds))
(message "Skipping %S" this-original-command)
(mc/execute-command-for-all-fake-cursors this-original-command))))
(defun mc/remove-additional-cursors ()
"Remove all fake cursors.
Do not use to conclude editing with multiple cursors. For that
you should disable multiple-cursors-mode."
(mapc #'(lambda (o)
(when (eq (overlay-get o 'type) 'additional-cursor)
(mc/clean-up-state-overlay o)))
(overlays-in (point-min) (point-max))))
(defun mc/keyboard-quit ()
(interactive)
(if (not (use-region-p))
(multiple-cursors-mode 0)
(deactivate-mark)))
(defvar mc/keymap nil
"Keymap while multiple cursors are active.
Main goal of the keymap is to rebind C-g and <return> to conclude
multiple cursors editing.")
(if mc/keymap
nil
(setq mc/keymap (make-sparse-keymap))
(define-key mc/keymap (kbd "C-g") 'mc/keyboard-quit)
(define-key mc/keymap (kbd "<return>") 'multiple-cursors-mode))
(define-minor-mode multiple-cursors-mode
"Mode while multiple cursors are active."
nil " mc" mc/keymap
(cond ((not multiple-cursors-mode)
(remove-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t)
(mc/remove-additional-cursors))
(t (add-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t t))))
(defun mc/add-multiple-cursors-to-region-lines ()
"Add one cursor to each line of the active region.
Starts from mark and moves in straight down or up towards the
line point is on.
Could possibly be used to mark multiple regions with
mark-multiple if point and mark is on different columns."
(interactive)
(when (not (use-region-p))
(error "Mark a set of lines first."))
(mc/remove-additional-cursors)
(let* ((point-line (line-number-at-pos))
(mark-line (progn (exchange-point-and-mark) (line-number-at-pos)))
(navigation-func (if (< point-line mark-line) 'previous-line 'next-line)))
(deactivate-mark)
(while (not (eq (line-number-at-pos) point-line))
(mc/create-fake-cursor-at-point)
(funcall navigation-func))
(multiple-cursors-mode)))
(defun mc/edit-ends-of-lines ()
"Add one cursor to the end of each line in the active region."
(interactive)
(mc/add-multiple-cursors-to-region-lines)
(mc/execute-command-for-all-fake-cursors 'end-of-line)
(end-of-line))
(defun mc/edit-beginnings-of-lines ()
"Add one cursor to the beginning of each line in the active region."
(interactive)
(mc/add-multiple-cursors-to-region-lines)
(mc/execute-command-for-all-fake-cursors 'beginning-of-line)
(beginning-of-line))
(defun mc/switch-from-mark-multiple-to-cursors ()
"Removes mark-multiple and switches to multiple cursors instead"
(interactive)
(let ((offset (- (point) (overlay-start mm/master))))
(deactivate-mark)
(save-excursion
(dolist (mirror mm/mirrors)
(goto-char (+ offset (overlay-start mirror)))
(mc/create-fake-cursor-at-point)))
(mm/clear-all)
(multiple-cursors-mode)))
(define-key mm/keymap (kbd "C-g") 'mc/switch-from-mark-multiple-to-cursors)
(defvar mc--unsupported-cmds '()
"List of commands that does not work well with multiple cursors.
Set up with the unsupported-cmd macro.")
(defmacro unsupported-cmd (cmd)
"Adds command to list of unsupported commands and prevents it
from being executed if in multiple-cursors-mode."
`(progn
(push (quote ,cmd) mc--unsupported-cmds)
(defadvice ,cmd (around unsupported-advice activate)
"command isn't supported with multiple cursors"
(unless multiple-cursors-mode
ad-do-it))))
;; Commands that make a giant mess of multiple cursors
(unsupported-cmd yank-pop)
;; Commands that should be mirrored by all cursors
(setq mc--cmds '(mc/keyboard-quit
self-insert-command
js2-insert-and-indent
wrap-region-trigger
sgml-slash
slime-space
previous-line
next-line
newline
yas/expand
newline-and-indent
join-line
right-char forward-char
right-word forward-word
left-char backward-char
left-word backward-word
subword-upcase upcase-word
subword-downcase downcase-word
subword-capitalize capitalize-word
forward-list
backward-list
hippie-expand hippie-expand-lines
yank yank-indented
kill-word
kill-region-or-backward-word
kill-line
kill-whole-line
backward-kill-word
backward-delete-char-untabify
delete-char c-electric-delete-forward
delete-backward-char c-electric-backspace
c-electric-paren
c-electric-semi&comma
org-shiftright
just-one-space
zap-to-char
end-of-line
set-mark-command
js2-beginning-of-line
js2-end-of-line
js2r-inline-var
change-number-at-point
move-end-of-line
move-end-of-line-or-next-line
beginning-of-line
er/expand-region
er/mark-word
move-beginning-of-line
move-start-of-line-or-prev-line
dired-back-to-start-of-files
save-region-or-current-line
back-to-indentation))
(provide 'multiple-cursors) (provide 'multiple-cursors)

View File

@ -5,7 +5,7 @@
** DONE refactor: an object with all the current state, used for both overlays and current ** DONE refactor: an object with all the current state, used for both overlays and current
** TODO add tests ** TODO add tests
** TODO collapse cursors at same point ** TODO collapse cursors at same point
** TODO unknown command: (t)ry all or (i)gnore -> (did that work ok? (k)eep doing that or (d)on't) ** TODO unknown command: (t)ry all, (i)gnore -> (did that work ok? (k)eep doing that or (d)on't)
** TODO separate mark-multiple and multiple-cursors ** TODO separate mark-multiple and multiple-cursors
mark-multiple goes back to being the util? or just dies? mark-multiple goes back to being the util? or just dies?
given the problem with extract-var and undo, may just kill mark-multiple. given the problem with extract-var and undo, may just kill mark-multiple.