Allow to switch action midway from goto to kill/mark/copy

* avy.el (avy-action): New defvar.
(avy-dispatch-alist): New defvar.
Customize this to add new dispatch functionality.
(avy-handler-default): Use `avy-dispatch-alist'.
(avy--with-avy-keys): Set `avy-action' to nil, which means
`avy-action-goto' will be called by default.
(avy--goto): Remove defun. Redirect it as an obsolete alias to identity.
(avy-action-goto): New defun.
(avy-action-mark): New defun.
(avy-action-copy): New defun.
(avy-action-kill): New defun.
(avy--process): Call `avy-action'. This function alone now does
what (avy--goto (avy--process ...)) used to do.
(avy--generic-jump): Remove `avy--goto'.
(avy-goto-char-in-line): Remove `avy--goto'.
(avy-isearch): Remove `avy--goto'.
(avy--line): Set `avy-action' to identity so that `avy--process' doesn't
move point.
(avy-goto-line): Replace `avy--goto' with `avy-action-goto'.
(avy-copy-line): `avy--line' now returns a point, not a cons.
(avy-move-line): `avy--line' now returns a point, not a cons.
(avy-copy-region): `avy--line' now returns a point, not a cons.

**Example of use.**

Suppose you have:
(global-set-key (kbd "M-g w") 'avy-goto-word-1)

To jump to a certain word (e.g. first one on screen): "M-g wa".
To copy the word instead of jumping to it:            "M-g wna".
To mark the word after jumping to it:                 "M-g wma".
To kill the word after jumping to it:                 "M-g wxa".

Re #78
This commit is contained in:
Oleh Krehel 2015-07-16 14:50:48 +02:00
parent 7928d11ef3
commit 1d1e4b62e8

173
avy.el
View File

@ -314,10 +314,28 @@ KEYS is the path from the root of `avy-tree' to LEAF."
(funcall walker key (cddr br)) (funcall walker key (cddr br))
(avy-traverse (cdr br) walker key))))) (avy-traverse (cdr br) walker key)))))
(defvar avy-action nil
"Function to call at the end of select.")
(defvar avy-dispatch-alist
'((?x avy-action-kill)
(?m avy-action-mark)
(?n avy-action-copy))
"List of actions for `avy-handler-default'.
Each item is (KEY ACTION). When KEY that is not on `avy-keys' is
pressed during the dispatch, ACTION is set to replace the default
`avy-action-goto' once a candidate is finally selected.")
(defun avy-handler-default (char) (defun avy-handler-default (char)
"The default hander for a bad CHAR." "The default handler for a bad CHAR."
(signal 'user-error (list "No such candidate" char)) (let (dispatch)
(throw 'done nil)) (if (setq dispatch (assoc char avy-dispatch-alist))
(progn
(setq avy-action (cadr dispatch))
(throw 'done 'restart))
(signal 'user-error (list "No such candidate" char))
(throw 'done nil))))
(defvar avy-handler-function 'avy-handler-default (defvar avy-handler-function 'avy-handler-default
"A function to call for a bad `read-key' in `avy-read'.") "A function to call for a bad `read-key' in `avy-read'.")
@ -422,49 +440,81 @@ multiple DISPLAY-FN invokations."
avy-keys)) avy-keys))
(avy-style (or (cdr (assq ',command avy-styles-alist)) (avy-style (or (cdr (assq ',command avy-styles-alist))
avy-style))) avy-style)))
(setq avy-action nil)
,@body)) ,@body))
(defun avy--goto (x) (defun avy-action-goto (pt)
"Goto X. "Goto PT."
X is (POS . WND) (unless (= pt (point)) (push-mark))
POS is either a position or (BEG . END)." (goto-char pt))
(cond ((null x)
(message "zero candidates"))
;; ignore exit from `avy-handler-function' (defun avy-action-mark (pt)
((eq x 'exit)) "Mark sexp at PT."
(goto-char pt)
(set-mark (point))
(forward-sexp))
(t (defun avy-action-copy (pt)
(let* ((window (cdr x)) "Copy sexp starting on PT."
(frame (window-frame window))) (save-excursion
(unless (equal frame (selected-frame)) (let (str)
(select-frame-set-input-focus frame)) (goto-char pt)
(select-window window)) (forward-sexp)
(let ((pt (car x))) (setq str (buffer-substring pt (point)))
(when (consp pt) (kill-new str)
(setq pt (car pt))) (message "Copied: %s" str))))
(unless (= pt (point)) (push-mark))
(goto-char pt))))) (defun avy-action-kill (pt)
"Kill sexp at PT."
(goto-char pt)
(forward-sexp)
(kill-region pt (point))
(message "Killed: %s" (current-kill 0)))
(define-obsolete-function-alias
'avy--goto 'identity "0.3.0"
"Don't use this function any more.
`avy--process' will do the jump all by itself.")
(defun avy--process (candidates overlay-fn) (defun avy--process (candidates overlay-fn)
"Select one of CANDIDATES using `avy-read'. "Select one of CANDIDATES using `avy-read'.
Use OVERLAY-FN to visualize the decision overlay." Use OVERLAY-FN to visualize the decision overlay."
(unwind-protect (let ((len (length candidates))
(cl-case (length candidates) (cands (copy-sequence candidates))
(0 res)
nil) (if (= len 0)
(1 (message "zero candidates")
(car candidates)) (if (= len 1)
(t (setq res (car candidates))
(avy--make-backgrounds (unwind-protect
(avy-window-list)) (progn
(if (eq avy-style 'de-bruijn) (avy--make-backgrounds
(avy-read-de-bruijn (avy-window-list))
candidates avy-keys) (setq res (if (eq avy-style 'de-bruijn)
(avy-read (avy-tree candidates avy-keys) (avy-read-de-bruijn
overlay-fn candidates avy-keys)
#'avy--remove-leading-chars)))) (avy-read (avy-tree candidates avy-keys)
(avy--done))) overlay-fn
#'avy--remove-leading-chars))))
(avy--done)))
(cond ((eq res 'restart)
(avy--process cands overlay-fn))
;; ignore exit from `avy-handler-function'
((eq res 'exit))
(t
(when (and (consp res)
(windowp (cdr res)))
(let* ((window (cdr res))
(frame (window-frame window)))
(unless (equal frame (selected-frame))
(select-frame-set-input-focus frame))
(select-window window))
(setq res (car res)))
(funcall (or avy-action 'avy-action-goto)
(if (consp res)
(car res)
res)))))))
(defvar avy--overlays-back nil (defvar avy--overlays-back nil
"Hold overlays for when `avy-background' is t.") "Hold overlays for when `avy-background' is t.")
@ -719,10 +769,9 @@ STYLE determines the leading char overlay style."
(if window-flip (if window-flip
(not avy-all-windows) (not avy-all-windows)
avy-all-windows))) avy-all-windows)))
(avy--goto (avy--process
(avy--process (avy--regex-candidates regex)
(avy--regex-candidates regex) (avy--style-fn style))))
(avy--style-fn style)))))
;;* Commands ;;* Commands
;;;###autoload ;;;###autoload
@ -745,13 +794,12 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
(interactive (list (read-char "char: " t))) (interactive (list (read-char "char: " t)))
(let ((avy-all-windows nil)) (let ((avy-all-windows nil))
(avy--with-avy-keys avy-goto-char (avy--with-avy-keys avy-goto-char
(avy--goto (avy--process
(avy--process (save-restriction
(save-restriction (narrow-to-region (line-beginning-position)
(narrow-to-region (line-beginning-position) (line-end-position))
(line-end-position)) (avy--regex-candidates (regexp-quote (string char))))
(avy--regex-candidates (regexp-quote (string char)))) (avy--style-fn avy-style)))))
(avy--style-fn avy-style))))))
;;;###autoload ;;;###autoload
(defun avy-goto-char-2 (char1 char2 &optional arg) (defun avy-goto-char-2 (char1 char2 &optional arg)
@ -771,13 +819,11 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
"Jump to one of the current isearch candidates." "Jump to one of the current isearch candidates."
(interactive) (interactive)
(avy--with-avy-keys avy-isearch (avy--with-avy-keys avy-isearch
(let* ((candidates (let ((avy-background nil))
(avy--regex-candidates isearch-string)) (avy--process
(avy-background nil) (avy--regex-candidates isearch-string)
(candidate (avy--style-fn avy-style))
(avy--process candidates (avy--style-fn avy-style)))) (isearch-done))))
(isearch-done)
(avy--goto candidate))))
;;;###autoload ;;;###autoload
(defun avy-goto-word-0 (arg) (defun avy-goto-word-0 (arg)
@ -833,8 +879,7 @@ should return true."
(push (cons (point) (selected-window)) window-cands)) (push (cons (point) (selected-window)) window-cands))
(subword-backward))) (subword-backward)))
(setq candidates (nconc candidates window-cands)))) (setq candidates (nconc candidates window-cands))))
(avy--goto (avy--process candidates (avy--style-fn avy-style)))))
(avy--process candidates (avy--style-fn avy-style))))))
;;;###autoload ;;;###autoload
(defun avy-goto-subword-1 (char arg) (defun avy-goto-subword-1 (char arg)
@ -876,6 +921,7 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
(line-beginning-position)) (line-beginning-position))
(selected-window)) candidates)) (selected-window)) candidates))
(forward-line 1)))))) (forward-line 1))))))
(setq avy-action #'identity)
(avy--process (nreverse candidates) (avy--style-fn avy-style)))) (avy--process (nreverse candidates) (avy--style-fn avy-style))))
;;;###autoload ;;;###autoload
@ -896,7 +942,8 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
(goto-char (point-min)) (goto-char (point-min))
(forward-line (1- (string-to-number line))) (forward-line (1- (string-to-number line)))
(throw 'done 'exit))))))) (throw 'done 'exit)))))))
(avy--goto (avy--line arg))))) (avy-action-goto
(avy--line arg)))))
;;;###autoload ;;;###autoload
(defun avy-copy-line (arg) (defun avy-copy-line (arg)
@ -904,7 +951,7 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
ARG lines can be used." ARG lines can be used."
(interactive "p") (interactive "p")
(avy--with-avy-keys avy-copy-line (avy--with-avy-keys avy-copy-line
(let ((start (car (avy--line)))) (let ((start (avy--line)))
(move-beginning-of-line nil) (move-beginning-of-line nil)
(save-excursion (save-excursion
(insert (insert
@ -922,7 +969,7 @@ ARG lines can be used."
ARG lines can be used." ARG lines can be used."
(interactive "p") (interactive "p")
(avy--with-avy-keys avy-move-line (avy--with-avy-keys avy-move-line
(let ((start (car (avy--line)))) (let ((start (avy--line)))
(move-beginning-of-line nil) (move-beginning-of-line nil)
(save-excursion (save-excursion
(save-excursion (save-excursion
@ -936,8 +983,8 @@ ARG lines can be used."
"Select two lines and copy the text between them here." "Select two lines and copy the text between them here."
(interactive) (interactive)
(avy--with-avy-keys avy-copy-region (avy--with-avy-keys avy-copy-region
(let ((beg (car (avy--line))) (let ((beg (avy--line))
(end (car (avy--line))) (end (avy--line))
(pad (if (bolp) "" "\n"))) (pad (if (bolp) "" "\n")))
(move-beginning-of-line nil) (move-beginning-of-line nil)
(save-excursion (save-excursion