mirror of
https://github.com/magnars/multiple-cursors.el.git
synced 2025-10-13 21:03:05 +00:00
311 lines
12 KiB
EmacsLisp
311 lines
12 KiB
EmacsLisp
(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 nil)))
|
|
(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 nil)))
|
|
(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 'kill-ring-yank-pointer kill-ring-yank-pointer)
|
|
(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 'yank-undo-function yank-undo-function)
|
|
(overlay-put o 'kill-ring-yank-pointer kill-ring-yank-pointer)
|
|
(when (boundp 'er/history) (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))
|
|
(setq kill-ring-yank-pointer (overlay-get o 'kill-ring-yank-pointer))
|
|
(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 yank-undo-function (overlay-get o 'yank-undo-function))
|
|
(setq kill-ring-yank-pointer (overlay-get o 'kill-ring-yank-pointer))
|
|
(when (boundp 'er/history) (setq er/history (overlay-get o 'er/history))))
|
|
|
|
(defun mc/remove-fake-cursor (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/remove-fake-cursor 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 ((annoying-arrows-mode nil))
|
|
(mc/save-excursion
|
|
(mc/for-each-fake-cursor
|
|
(mc/pop-state-from-overlay cursor)
|
|
(ignore-errors
|
|
(setq this-command cmd)
|
|
(run-hooks 'pre-command-hook)
|
|
(unless (eq this-command 'ignore)
|
|
(call-interactively cmd))
|
|
(when deactivate-mark (deactivate-mark))
|
|
(mc/create-fake-cursor-at-point))))))
|
|
|
|
(defmacro mc/for-each-fake-cursor (&rest forms)
|
|
"Runs the body for each fake cursor, bound to the name cursor"
|
|
`(mapc #'(lambda (cursor)
|
|
(when (eq (overlay-get cursor 'type) 'additional-cursor)
|
|
,@forms))
|
|
(overlays-in (point-min) (point-max))))
|
|
|
|
(defmacro mc/save-excursion (&rest forms)
|
|
"Saves and restores all the state that multiple-cursors cares about."
|
|
`(let ((current-state (mc/store-current-state-in-overlay
|
|
(make-overlay (point) (point) nil nil t))))
|
|
(overlay-put current-state 'type 'original-cursor)
|
|
(save-excursion ,@forms)
|
|
(mc/pop-state-from-overlay current-state)))
|
|
|
|
(defun mc/prompt-for-inclusion-in-whitelist (original-command)
|
|
(if (y-or-n-p (format "Do %S for all cursors?" original-command))
|
|
(add-to-list 'mc--cmds original-command)
|
|
(add-to-list 'mc--cmds-run-once original-command)
|
|
nil))
|
|
|
|
(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."
|
|
(let ((original-command (or (command-remapping this-original-command)
|
|
this-original-command)))
|
|
|
|
;; if it's a lambda, we can't know if it's supported or not
|
|
;; - so go ahead and assume it's ok, because we're just optimistic like that
|
|
(if (not (symbolp original-command))
|
|
(mc/execute-command-for-all-fake-cursors original-command)
|
|
|
|
;; otherwise it's a symbol, and we can be more thorough
|
|
(if (get original-command 'mc--unsupported)
|
|
(message "%S is not supported with multiple cursors%s"
|
|
original-command
|
|
(get original-command 'mc--unsupported))
|
|
(when (and original-command
|
|
(not (memq original-command mc--cmds-run-once))
|
|
(or (memq original-command mc--cmds)
|
|
(mc/prompt-for-inclusion-in-whitelist original-command)))
|
|
(mc/execute-command-for-all-fake-cursors original-command))))))
|
|
|
|
(defun mc/remove-fake-cursors ()
|
|
"Remove all fake cursors.
|
|
Do not use to conclude editing with multiple cursors. For that
|
|
you should disable multiple-cursors-mode."
|
|
(mc/for-each-fake-cursor
|
|
(mc/remove-fake-cursor cursor)))
|
|
|
|
(defun mc/keyboard-quit ()
|
|
"Deactivate mark if there are any active, otherwise exit multiple-cursors-mode."
|
|
(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
|
|
(if multiple-cursors-mode
|
|
(add-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t t)
|
|
(remove-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t)
|
|
(mc/remove-fake-cursors)))
|
|
|
|
(defmacro unsupported-cmd (cmd msg)
|
|
"Adds command to list of unsupported commands and prevents it
|
|
from being executed if in multiple-cursors-mode."
|
|
`(progn
|
|
(put (quote ,cmd) 'mc--unsupported ,msg)
|
|
(defadvice ,cmd (around unsupported-advice activate)
|
|
"command isn't supported with multiple cursors"
|
|
(unless (and multiple-cursors-mode (called-interactively-p 'any))
|
|
ad-do-it))))
|
|
|
|
;; Commands that does not work with multiple-cursors
|
|
(unsupported-cmd isearch-forward ". Feel free to add a compatible version.")
|
|
(unsupported-cmd isearch-backward ". Feel free to add a compatible version.")
|
|
|
|
;; Fixing certain commands
|
|
;;----------------------------------------------------------------------------------------
|
|
;; Make sure pastes from other programs are added to all kill-rings when yanking
|
|
(defadvice current-kill (before interprogram-paste-for-all-cursors activate)
|
|
(let ((interprogram-paste (and (= n 0)
|
|
interprogram-paste-function
|
|
(funcall interprogram-paste-function))))
|
|
(when interprogram-paste
|
|
;; Add interprogram-paste to normal kill ring, just
|
|
;; like current-kill usually does for itself.
|
|
;; We have to do the work for it tho, since the funcall only returns
|
|
;; something once. It is not a pure function.
|
|
(let ((interprogram-cut-function nil))
|
|
(if (listp interprogram-paste)
|
|
(mapc 'kill-new (nreverse interprogram-paste))
|
|
(kill-new interprogram-paste))
|
|
;; And then add interprogram-paste to the kill-rings
|
|
;; of all the other cursors too.
|
|
(mc/for-each-fake-cursor
|
|
(let ((kill-ring (overlay-get cursor 'kill-ring))
|
|
(kill-ring-yank-pointer (overlay-get cursor 'kill-ring-yank-pointer)))
|
|
(if (listp interprogram-paste)
|
|
(mapc 'kill-new (nreverse interprogram-paste))
|
|
(kill-new interprogram-paste))
|
|
(overlay-put cursor 'kill-ring kill-ring)
|
|
(overlay-put cursor 'kill-ring-yank-pointer kill-ring-yank-pointer)))))))
|
|
;;----------------------------------------------------------------------------------------
|
|
|
|
;; Commands to run only once (don't need to message about skipping it)
|
|
(setq mc--cmds-run-once '(mark-next-like-this
|
|
save-buffer
|
|
undo
|
|
undo-tree-undo
|
|
undo-tree-redo
|
|
universal-argument
|
|
universal-argument-other-key
|
|
mc/switch-from-mark-multiple-to-cursors
|
|
mc/edit-lines
|
|
mc/edit-ends-of-lines
|
|
mc/edit-beginnings-of-lines))
|
|
|
|
;; 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
|
|
upcase-word
|
|
downcase-word
|
|
capitalize-word
|
|
forward-list
|
|
backward-list
|
|
hippie-expand hippie-expand-lines
|
|
yank yank-indented yank-pop
|
|
kill-word
|
|
kill-region-or-backward-word
|
|
kill-line
|
|
kill-whole-line
|
|
subword-forward
|
|
subword-backward
|
|
subword-mark
|
|
subword-kill
|
|
subword-backward-kill
|
|
subword-transpose
|
|
subword-capitalize
|
|
subword-upcase
|
|
subword-downcase
|
|
backward-kill-word
|
|
backward-delete-char-untabify
|
|
delete-char delete-forward-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
|
|
beginning-of-line
|
|
er/expand-region
|
|
er/mark-word
|
|
smart-forward
|
|
smart-backward
|
|
smart-up
|
|
smart-down
|
|
move-beginning-of-line
|
|
dired-back-to-start-of-files
|
|
kill-ring-save save-region-or-current-line
|
|
back-to-indentation))
|
|
|
|
(provide 'multiple-cursors-core)
|