Add pre- & post-command-hook to be cursor specific

This commit is contained in:
Magnar Sveen 2013-07-14 14:07:07 +02:00
parent 4c293c46fd
commit 6cff0c2ebd
2 changed files with 68 additions and 70 deletions

View File

@ -42,13 +42,13 @@
(defmacro mc/add-fake-cursor-to-undo-list (&rest forms) (defmacro mc/add-fake-cursor-to-undo-list (&rest forms)
"Make sure point is in the right place when undoing" "Make sure point is in the right place when undoing"
(let ((uc (make-symbol "undo-cleaner"))) (let ((uc (make-symbol "undo-cleaner")))
`(let ((,uc (cons 'apply (cons 'deactivate-cursor-after-undo (list id))))) `(let ((,uc (cons 'apply (cons 'deactivate-cursor-after-undo (list id)))))
(setq buffer-undo-list (cons ,uc buffer-undo-list)) (setq buffer-undo-list (cons ,uc buffer-undo-list))
,@forms ,@forms
(if (eq ,uc (car buffer-undo-list)) ;; if nothing has been added to the undo-list (if (eq ,uc (car buffer-undo-list)) ;; if nothing has been added to the undo-list
(setq buffer-undo-list (cdr buffer-undo-list)) ;; then pop the cleaner right off again (setq buffer-undo-list (cdr buffer-undo-list)) ;; then pop the cleaner right off again
(setq buffer-undo-list ;; otherwise add a function to activate this cursor (setq buffer-undo-list ;; otherwise add a function to activate this cursor
(cons (cons 'apply (cons 'activate-cursor-for-undo (list id))) buffer-undo-list)))))) (cons (cons 'apply (cons 'activate-cursor-for-undo (list id))) buffer-undo-list))))))
(defun mc/all-fake-cursors (&optional start end) (defun mc/all-fake-cursors (&optional start end)
(remove-if-not 'mc/fake-cursor-p (remove-if-not 'mc/fake-cursor-p
@ -63,11 +63,11 @@
(defmacro mc/save-excursion (&rest forms) (defmacro mc/save-excursion (&rest forms)
"Saves and restores all the state that multiple-cursors cares about." "Saves and restores all the state that multiple-cursors cares about."
(let ((cs (make-symbol "current-state"))) (let ((cs (make-symbol "current-state")))
`(let ((,cs (mc/store-current-state-in-overlay `(let ((,cs (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t)))) (make-overlay (point) (point) nil nil t))))
(overlay-put ,cs 'type 'original-cursor) (overlay-put ,cs 'type 'original-cursor)
(save-excursion ,@forms) (save-excursion ,@forms)
(mc/pop-state-from-overlay ,cs)))) (mc/pop-state-from-overlay ,cs))))
(defun mc--compare-by-overlay-start (o1 o2) (defun mc--compare-by-overlay-start (o1 o2)
(< (overlay-start o1) (overlay-start o2))) (< (overlay-start o1) (overlay-start o2)))
@ -75,27 +75,27 @@
(defmacro mc/for-each-cursor-ordered (&rest forms) (defmacro mc/for-each-cursor-ordered (&rest forms)
"Runs the body for each cursor, fake and real, bound to the name cursor" "Runs the body for each cursor, fake and real, bound to the name cursor"
(let ((rci (make-symbol "real-cursor-id"))) (let ((rci (make-symbol "real-cursor-id")))
`(let ((,rci (overlay-get (mc/create-fake-cursor-at-point) 'mc-id))) `(let ((,rci (overlay-get (mc/create-fake-cursor-at-point) 'mc-id)))
(mapc #'(lambda (cursor) (mapc #'(lambda (cursor)
(when (mc/fake-cursor-p cursor) (when (mc/fake-cursor-p cursor)
,@forms)) ,@forms))
(sort (overlays-in (point-min) (point-max)) 'mc--compare-by-overlay-start)) (sort (overlays-in (point-min) (point-max)) 'mc--compare-by-overlay-start))
(mc/pop-state-from-overlay (mc/cursor-with-id ,rci))))) (mc/pop-state-from-overlay (mc/cursor-with-id ,rci)))))
(defmacro mc/save-window-scroll (&rest forms) (defmacro mc/save-window-scroll (&rest forms)
"Saves and restores the window scroll position" "Saves and restores the window scroll position"
(let ((p (make-symbol "p")) (let ((p (make-symbol "p"))
(s (make-symbol "start")) (s (make-symbol "start"))
(h (make-symbol "hscroll"))) (h (make-symbol "hscroll")))
`(let ((,p (set-marker (make-marker) (point))) `(let ((,p (set-marker (make-marker) (point)))
(,s (set-marker (make-marker) (window-start))) (,s (set-marker (make-marker) (window-start)))
(,h (window-hscroll))) (,h (window-hscroll)))
,@forms ,@forms
(goto-char ,p) (goto-char ,p)
(set-window-start nil ,s t) (set-window-start nil ,s t)
(set-window-hscroll nil ,h) (set-window-hscroll nil ,h)
(set-marker ,p nil) (set-marker ,p nil)
(set-marker ,s nil)))) (set-marker ,s nil))))
(defun mc/make-cursor-overlay-at-eol (pos) (defun mc/make-cursor-overlay-at-eol (pos)
"Create overlay to look like cursor at end of line." "Create overlay to look like cursor at end of line."
@ -124,22 +124,24 @@ highlights the entire width of the window."
(overlay-put overlay 'type 'additional-region) (overlay-put overlay 'type 'additional-region)
overlay)) overlay))
(defvar mc/cursor-specific-vars '(autopair-action (defvar mc/cursor-specific-vars '(transient-mark-mode
pre-command-hook
post-command-hook
kill-ring
kill-ring-yank-pointer
mark-ring
mark-active
yank-undo-function
kill-ring-yank-pointer
autopair-action
autopair-wrap-action autopair-wrap-action
transient-mark-mode
er/history) er/history)
"A list of vars that need to be tracked on a per-cursor basis.") "A list of vars that need to be tracked on a per-cursor basis.")
(defun mc/store-current-state-in-overlay (o) (defun mc/store-current-state-in-overlay (o)
"Store relevant info about point and mark in the given overlay." "Store relevant info about point and mark in the given overlay."
(overlay-put o 'point (set-marker (make-marker) (point))) (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 (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)
(dolist (var mc/cursor-specific-vars) (dolist (var mc/cursor-specific-vars)
(when (boundp var) (overlay-put o var (symbol-value var)))) (when (boundp var) (overlay-put o var (symbol-value var))))
o) o)
@ -147,13 +149,7 @@ highlights the entire width of the window."
(defun mc/restore-state-from-overlay (o) (defun mc/restore-state-from-overlay (o)
"Restore point and mark from stored info in the given overlay." "Restore point and mark from stored info in the given overlay."
(goto-char (overlay-get o 'point)) (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)) (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))
(dolist (var mc/cursor-specific-vars) (dolist (var mc/cursor-specific-vars)
(when (boundp var) (set var (overlay-get o var))))) (when (boundp var) (set var (overlay-get o var)))))
@ -396,8 +392,7 @@ you should disable multiple-cursors-mode."
"Keymap while multiple cursors are active. "Keymap while multiple cursors are active.
Main goal of the keymap is to rebind C-g and <return> to conclude Main goal of the keymap is to rebind C-g and <return> to conclude
multiple cursors editing.") multiple cursors editing.")
(if mc/keymap (unless mc/keymap
nil
(setq mc/keymap (make-sparse-keymap)) (setq mc/keymap (make-sparse-keymap))
(define-key mc/keymap (kbd "C-g") 'mc/keyboard-quit) (define-key mc/keymap (kbd "C-g") 'mc/keyboard-quit)
(define-key mc/keymap (kbd "<return>") 'multiple-cursors-mode) (define-key mc/keymap (kbd "<return>") 'multiple-cursors-mode)
@ -406,13 +401,13 @@ multiple cursors editing.")
(when (fboundp 'phi-search-backward) (when (fboundp 'phi-search-backward)
(define-key mc/keymap (kbd "C-r") 'phi-search-backward))) (define-key mc/keymap (kbd "C-r") 'phi-search-backward)))
(defun mc--all-equal (entries) (defun mc--all-equal (list)
"Are all these entries equal?" "Are all the items in LIST equal?"
(let ((first (car entries)) (let ((first (car list))
(all-equal t)) (all-equal t))
(while (and all-equal entries) (while (and all-equal list)
(setq all-equal (equal first (car entries))) (setq all-equal (equal first (car list)))
(setq entries (cdr entries))) (setq list (cdr list)))
all-equal)) all-equal))
(defun mc--kill-ring-entries () (defun mc--kill-ring-entries ()

View File

@ -67,27 +67,30 @@ an exceedingly quick way of adding multiple cursors to multiple lines."
(defun rrm/repaint () (defun rrm/repaint ()
"Start from the anchor and draw a rectangle between it and point." "Start from the anchor and draw a rectangle between it and point."
(rrm/remove-rectangular-region-overlays) (if (not rectangular-region-mode)
(let* ((annoying-arrows-mode nil) (remove-hook 'post-command-hook 'rrm/repaint t)
(point-column (current-column)) ;; else
(point-line (line-number-at-pos)) (rrm/remove-rectangular-region-overlays)
(anchor-column (save-excursion (goto-char rrm/anchor) (current-column))) (let* ((annoying-arrows-mode nil)
(anchor-line (save-excursion (goto-char rrm/anchor) (line-number-at-pos))) (point-column (current-column))
(left-column (if (< point-column anchor-column) point-column anchor-column)) (point-line (line-number-at-pos))
(right-column (if (> point-column anchor-column) point-column anchor-column)) (anchor-column (save-excursion (goto-char rrm/anchor) (current-column)))
(navigation-step (if (< point-line anchor-line) 1 -1))) (anchor-line (save-excursion (goto-char rrm/anchor) (line-number-at-pos)))
(move-to-column anchor-column) (left-column (if (< point-column anchor-column) point-column anchor-column))
(set-mark (point)) (right-column (if (> point-column anchor-column) point-column anchor-column))
(move-to-column point-column) (navigation-step (if (< point-line anchor-line) 1 -1)))
(mc/save-excursion (move-to-column anchor-column)
(while (not (= anchor-line (line-number-at-pos))) (set-mark (point))
(forward-line navigation-step) (move-to-column point-column)
(move-to-column anchor-column) (mc/save-excursion
(when (= anchor-column (current-column)) (while (not (= anchor-line (line-number-at-pos)))
(set-mark (point)) (forward-line navigation-step)
(move-to-column point-column) (move-to-column anchor-column)
(when (= point-column (current-column)) (when (= anchor-column (current-column))
(mc/create-fake-cursor-at-point))))))) (set-mark (point))
(move-to-column point-column)
(when (= point-column (current-column))
(mc/create-fake-cursor-at-point))))))))
(defun rrm/switch-to-multiple-cursors (&rest forms) (defun rrm/switch-to-multiple-cursors (&rest forms)
"Switch from rectangular-region-mode to multiple-cursors-mode." "Switch from rectangular-region-mode to multiple-cursors-mode."