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)
"Make sure point is in the right place when undoing"
(let ((uc (make-symbol "undo-cleaner")))
`(let ((,uc (cons 'apply (cons 'deactivate-cursor-after-undo (list id)))))
(setq buffer-undo-list (cons ,uc buffer-undo-list))
,@forms
(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 ;; otherwise add a function to activate this cursor
(cons (cons 'apply (cons 'activate-cursor-for-undo (list id))) buffer-undo-list))))))
`(let ((,uc (cons 'apply (cons 'deactivate-cursor-after-undo (list id)))))
(setq buffer-undo-list (cons ,uc buffer-undo-list))
,@forms
(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 ;; otherwise add a function to activate this cursor
(cons (cons 'apply (cons 'activate-cursor-for-undo (list id))) buffer-undo-list))))))
(defun mc/all-fake-cursors (&optional start end)
(remove-if-not 'mc/fake-cursor-p
@ -63,11 +63,11 @@
(defmacro mc/save-excursion (&rest forms)
"Saves and restores all the state that multiple-cursors cares about."
(let ((cs (make-symbol "current-state")))
`(let ((,cs (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t))))
(overlay-put ,cs 'type 'original-cursor)
(save-excursion ,@forms)
(mc/pop-state-from-overlay ,cs))))
`(let ((,cs (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t))))
(overlay-put ,cs 'type 'original-cursor)
(save-excursion ,@forms)
(mc/pop-state-from-overlay ,cs))))
(defun mc--compare-by-overlay-start (o1 o2)
(< (overlay-start o1) (overlay-start o2)))
@ -75,27 +75,27 @@
(defmacro mc/for-each-cursor-ordered (&rest forms)
"Runs the body for each cursor, fake and real, bound to the name cursor"
(let ((rci (make-symbol "real-cursor-id")))
`(let ((,rci (overlay-get (mc/create-fake-cursor-at-point) 'mc-id)))
(mapc #'(lambda (cursor)
(when (mc/fake-cursor-p cursor)
,@forms))
(sort (overlays-in (point-min) (point-max)) 'mc--compare-by-overlay-start))
(mc/pop-state-from-overlay (mc/cursor-with-id ,rci)))))
`(let ((,rci (overlay-get (mc/create-fake-cursor-at-point) 'mc-id)))
(mapc #'(lambda (cursor)
(when (mc/fake-cursor-p cursor)
,@forms))
(sort (overlays-in (point-min) (point-max)) 'mc--compare-by-overlay-start))
(mc/pop-state-from-overlay (mc/cursor-with-id ,rci)))))
(defmacro mc/save-window-scroll (&rest forms)
"Saves and restores the window scroll position"
(let ((p (make-symbol "p"))
(s (make-symbol "start"))
(h (make-symbol "hscroll")))
`(let ((,p (set-marker (make-marker) (point)))
(,s (set-marker (make-marker) (window-start)))
(,h (window-hscroll)))
,@forms
(goto-char ,p)
(set-window-start nil ,s t)
(set-window-hscroll nil ,h)
(set-marker ,p nil)
(set-marker ,s nil))))
`(let ((,p (set-marker (make-marker) (point)))
(,s (set-marker (make-marker) (window-start)))
(,h (window-hscroll)))
,@forms
(goto-char ,p)
(set-window-start nil ,s t)
(set-window-hscroll nil ,h)
(set-marker ,p nil)
(set-marker ,s nil))))
(defun mc/make-cursor-overlay-at-eol (pos)
"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))
(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
transient-mark-mode
er/history)
"A list of vars that need to be tracked on a per-cursor basis.")
(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)
(dolist (var mc/cursor-specific-vars)
(when (boundp var) (overlay-put o var (symbol-value var))))
o)
@ -147,13 +149,7 @@ highlights the entire width of the window."
(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))
(dolist (var mc/cursor-specific-vars)
(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.
Main goal of the keymap is to rebind C-g and <return> to conclude
multiple cursors editing.")
(if mc/keymap
nil
(unless mc/keymap
(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)
@ -406,13 +401,13 @@ multiple cursors editing.")
(when (fboundp 'phi-search-backward)
(define-key mc/keymap (kbd "C-r") 'phi-search-backward)))
(defun mc--all-equal (entries)
"Are all these entries equal?"
(let ((first (car entries))
(defun mc--all-equal (list)
"Are all the items in LIST equal?"
(let ((first (car list))
(all-equal t))
(while (and all-equal entries)
(setq all-equal (equal first (car entries)))
(setq entries (cdr entries)))
(while (and all-equal list)
(setq all-equal (equal first (car list)))
(setq list (cdr list)))
all-equal))
(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 ()
"Start from the anchor and draw a rectangle between it and point."
(rrm/remove-rectangular-region-overlays)
(let* ((annoying-arrows-mode nil)
(point-column (current-column))
(point-line (line-number-at-pos))
(anchor-column (save-excursion (goto-char rrm/anchor) (current-column)))
(anchor-line (save-excursion (goto-char rrm/anchor) (line-number-at-pos)))
(left-column (if (< point-column anchor-column) point-column anchor-column))
(right-column (if (> point-column anchor-column) point-column anchor-column))
(navigation-step (if (< point-line anchor-line) 1 -1)))
(move-to-column anchor-column)
(set-mark (point))
(move-to-column point-column)
(mc/save-excursion
(while (not (= anchor-line (line-number-at-pos)))
(forward-line navigation-step)
(move-to-column anchor-column)
(when (= anchor-column (current-column))
(set-mark (point))
(move-to-column point-column)
(when (= point-column (current-column))
(mc/create-fake-cursor-at-point)))))))
(if (not rectangular-region-mode)
(remove-hook 'post-command-hook 'rrm/repaint t)
;; else
(rrm/remove-rectangular-region-overlays)
(let* ((annoying-arrows-mode nil)
(point-column (current-column))
(point-line (line-number-at-pos))
(anchor-column (save-excursion (goto-char rrm/anchor) (current-column)))
(anchor-line (save-excursion (goto-char rrm/anchor) (line-number-at-pos)))
(left-column (if (< point-column anchor-column) point-column anchor-column))
(right-column (if (> point-column anchor-column) point-column anchor-column))
(navigation-step (if (< point-line anchor-line) 1 -1)))
(move-to-column anchor-column)
(set-mark (point))
(move-to-column point-column)
(mc/save-excursion
(while (not (= anchor-line (line-number-at-pos)))
(forward-line navigation-step)
(move-to-column anchor-column)
(when (= anchor-column (current-column))
(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)
"Switch from rectangular-region-mode to multiple-cursors-mode."