1 ;;; avy.el --- tree-based completion -*- lexical-binding: t -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
6 ;; URL: https://github.com/abo-abo/avy
8 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
9 ;; Keywords: point, location
11 ;; This file is part of GNU Emacs.
13 ;; This file is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; For a full copy of the GNU General Public License
24 ;; see <http://www.gnu.org/licenses/>.
28 ;; This package provides a generic completion method based on building
29 ;; a balanced decision tree with each candidate being a leaf. To
30 ;; traverse the tree from the root to a desired leaf, typically a
31 ;; sequence of `read-key' can be used.
33 ;; In order for `read-key' to make sense, the tree needs to be
34 ;; visualized appropriately, with a character at each branch node. So
35 ;; this completion method works only for things that you can see on
36 ;; your screen, all at once:
38 ;; * character positions
39 ;; * word or subword start positions
40 ;; * line beginning positions
44 ;; If you're familiar with the popular `ace-jump-mode' package, this
45 ;; package does all that and more, without the implementation
54 "Jump to things tree-style."
58 (defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
59 "Default keys for jumping.
60 Any key is either a character representing a self-inserting
61 key (letters, digits, punctuation, etc.) or a symbol denoting a
62 non-printing key like an arrow key (left, right, up, down). For
63 non-printing keys, a corresponding entry in
64 `avy-key-to-char-alist' must exist in order to visualize the key
66 :type '(repeat :tag "Keys" (choice (character :tag "char")
67 (symbol :tag "non-printing key"))))
69 (defcustom avy-keys-alist nil
70 "Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
72 :key-type (choice :tag "Command"
74 (const avy-goto-char-2)
77 (const avy-goto-subword-0)
78 (const avy-goto-subword-1)
79 (const avy-goto-word-0)
80 (const avy-goto-word-1)
82 (const avy-copy-region)
83 (const avy-move-line))
84 :value-type (repeat :tag "Keys" character)))
86 (defcustom avy-style 'at-full
87 "The default method of displaying the overlays.
88 Use `avy-styles-alist' to customize this per-command."
90 (const :tag "Pre" pre)
92 (const :tag "At Full" at-full)
93 (const :tag "Post" post)
94 (const :tag "De Bruijn" de-bruijn)))
96 (defcustom avy-styles-alist nil
97 "Alist of avy-jump commands to the style for each command.
98 If the commands isn't on the list, `avy-style' is used."
100 :key-type (choice :tag "Command"
101 (const avy-goto-char)
102 (const avy-goto-char-2)
104 (const avy-goto-line)
105 (const avy-goto-subword-0)
106 (const avy-goto-subword-1)
107 (const avy-goto-word-0)
108 (const avy-goto-word-1)
109 (const avy-copy-line)
110 (const avy-copy-region)
111 (const avy-move-line))
113 (const :tag "Pre" pre)
115 (const :tag "At Full" at-full)
116 (const :tag "Post" post)
117 (const :tag "De Bruijn" de-bruijn))))
119 (defcustom avy-dispatch-alist
120 '((?x . avy-action-kill)
121 (?m . avy-action-mark)
122 (?n . avy-action-copy))
123 "List of actions for `avy-handler-default'.
125 Each item is (KEY . ACTION). When KEY not on `avy-keys' is
126 pressed during the dispatch, ACTION is set to replace the default
127 `avy-action-goto' once a candidate is finally selected."
130 :key-type (choice (character :tag "Char"))
132 (const :tag "Mark" avy-action-mark)
133 (const :tag "Copy" avy-action-copy)
134 (const :tag "Kill" avy-action-kill))))
136 (defcustom avy-background nil
137 "When non-nil, a gray background will be added during the selection."
140 (defcustom avy-all-windows t
141 "Determine the list of windows to consider in search of candidates."
144 (const :tag "All Frames" all-frames)
145 (const :tag "This Frame" t)
146 (const :tag "This Window" nil)))
148 (defcustom avy-case-fold-search t
149 "Non-nil if searches should ignore case."
152 (defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]"
153 "Regexp of punctuation chars that count as word starts for `avy-goto-word-1.
154 When nil, punctuation chars will not be matched.
156 \"[!-/:-@[-`{-~]\" will match all printable punctuation chars."
159 (defcustom avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode)
160 "List of modes to ignore when searching for candidates.
161 Typically, these modes don't use the text representation.")
163 (defvar avy-translate-char-function #'identity
164 "Function to translate user input key into another key.
165 For example, to make SPC do the same as ?a, use
166 \(lambda (c) (if (= c 32) ?a c)).")
168 (defface avy-lead-face-0
169 '((t (:foreground "white" :background "#4f57f9")))
170 "Face used for first non-terminating leading chars.")
172 (defface avy-lead-face-1
173 '((t (:foreground "white" :background "gray")))
174 "Face used for matched leading chars.")
176 (defface avy-lead-face-2
177 '((t (:foreground "white" :background "#f86bf3")))
178 "Face used for leading chars.")
180 (defface avy-lead-face
181 '((t (:foreground "white" :background "#e52b50")))
182 "Face used for the leading chars.")
184 (defface avy-background-face
185 '((t (:foreground "gray40")))
186 "Face for whole window background during selection.")
188 (defface avy-goto-char-timer-face
189 '((t (:inherit highlight)))
190 "Face for matches during reading chars using `avy-goto-char-timer'.")
192 (defconst avy-lead-faces '(avy-lead-face
198 "Face sequence for `avy--overlay-at-full'.")
200 (defvar avy-key-to-char-alist '((left . ?◀)
206 "An alist from non-character keys to printable chars used in avy overlays.
207 This alist must contain all keys used in `avy-keys' which are not
208 self-inserting keys and thus aren't read as characters.")
212 (defmacro avy-multipop (lst n)
213 "Remove LST's first N elements and return them."
214 `(if (<= (length ,lst) ,n)
219 (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
222 (defun avy--de-bruijn (keys n)
223 "De Bruijn sequence for alphabet KEYS and subsequences of length N."
224 (let* ((k (length keys))
225 (a (make-list (* n k) 0))
227 (cl-labels ((db (T p)
232 (cl-subseq a 1 (1+ p)))))
233 (setf (nth T a) (nth (- T p) a))
235 (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
243 (defun avy--path-alist-1 (lst seq-len keys)
244 "Build a De Bruin sequence from LST.
245 SEQ-LEN is how many elements of KEYS it takes to identify a match."
246 (let ((db-seq (avy--de-bruijn keys seq-len))
247 prev-pos prev-seq prev-win path-alist)
248 ;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to
250 (setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len))))
251 (cl-labels ((subseq-and-pop ()
252 (when (nth (1- seq-len) db-seq)
253 (prog1 (cl-subseq db-seq 0 seq-len)
256 (let* ((cur (car lst))
258 ;; ace-window has matches of the form (pos . wnd)
259 ((integerp (car cur)) (car cur))
260 ;; avy-jump have form ((start . end) . wnd)
261 ((consp (car cur)) (caar cur))
262 (t (error "Unexpected match representation: %s" cur))))
265 (let ((diff (if (eq win prev-win)
268 (when (and (> diff 0) (< diff seq-len))
269 (while (and (nth (1- seq-len) db-seq)
272 (cl-subseq prev-seq diff)
273 (cl-subseq db-seq 0 seq-len)))))
280 (push (cons path (car lst)) path-alist)
285 (nreverse path-alist)))
287 (defun avy-tree (lst keys)
288 "Coerce LST into a balanced tree.
289 The degree of the tree is the length of KEYS.
290 KEYS are placed appropriately on internal nodes."
291 (let ((len (length keys)))
294 (let ((ln (length ls)))
297 (mapcar (lambda (x) (cons 'leaf x)) ls))
298 (let ((ks (copy-sequence keys))
300 (dolist (s (avy-subdiv ln len))
303 (cons 'leaf (pop ls))
304 (rd (avy-multipop ls s))))
309 (defun avy-subdiv (n b)
310 "Distribute N in B terms in a balanced way."
311 (let* ((p (1- (floor (+ (log n b) 1e-6))))
315 (n2 (/ delta (- x2 x1)))
320 (- n (* n1 x1) (* n2 x2)))
323 (defun avy-traverse (tree walker &optional recur-key)
324 "Traverse TREE generated by `avy-tree'.
325 WALKER is a function that takes KEYS and LEAF.
327 RECUR-KEY is used in recursion.
329 LEAF is a member of LST argument of `avy-tree'.
331 KEYS is the path from the root of `avy-tree' to LEAF."
333 (let ((key (cons (car br) recur-key)))
334 (if (eq (cadr br) 'leaf)
335 (funcall walker key (cddr br))
336 (avy-traverse (cdr br) walker key)))))
338 (defvar avy-action nil
339 "Function to call at the end of select.")
341 (defun avy-handler-default (char)
342 "The default handler for a bad CHAR."
344 (if (setq dispatch (assoc char avy-dispatch-alist))
346 (setq avy-action (cdr dispatch))
347 (throw 'done 'restart))
348 (signal 'user-error (list "No such candidate" char))
351 (defvar avy-handler-function 'avy-handler-default
352 "A function to call for a bad `read-key' in `avy-read'.")
354 (defvar avy-current-path ""
355 "Store the current incomplete path during `avy-read'.")
357 (defun avy-read (tree display-fn cleanup-fn)
358 "Select a leaf from TREE using consecutive `read-char'.
360 DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
361 associated with CHAR will be selected if CHAR is pressed. This is
362 commonly done by adding a CHAR overlay at LEAF position.
364 CLEANUP-FN should take no arguments and remove the effects of
365 multiple DISPLAY-FN invokations."
367 (setq avy-current-path "")
369 (let ((avy--leafs nil))
372 (push (cons path leaf) avy--leafs)))
373 (dolist (x avy--leafs)
374 (funcall display-fn (car x) (cdr x))))
375 (let ((char (funcall avy-translate-char-function (read-key)))
378 (if (setq branch (assoc char tree))
379 (if (eq (car (setq tree (cdr branch))) 'leaf)
380 (throw 'done (cdr tree))
381 (setq avy-current-path
382 (concat avy-current-path (string (avy--key-to-char char)))))
383 (funcall avy-handler-function char))))))
385 (defun avy-read-de-bruijn (lst keys)
386 "Select from LST dispatching on KEYS."
387 ;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n
388 ;; (the path length) usable as paths, thus that's the lower bound. Due to
389 ;; partially overlapping matches, not all subsequences may be usable, so it's
390 ;; possible that the path-len must be incremented, e.g., if we're matching
391 ;; for x and a buffer contains xaxbxcx only every second subsequence is
392 ;; usable for the four matches.
394 (let* ((path-len (ceiling (log (length lst) (length keys))))
395 (alist (avy--path-alist-1 lst path-len keys)))
398 (setq alist (avy--path-alist-1 lst path-len keys)))
399 (let* ((len (length (caar alist)))
401 (setq avy-current-path "")
403 (dolist (x (reverse alist))
404 (avy--overlay-at-full (reverse (car x)) (cdr x)))
405 (let ((char (funcall avy-translate-char-function (read-key))))
406 (avy--remove-leading-chars)
410 (when (eq (caar x) char)
411 (cons (cdr (car x)) (cdr x))))
413 (setq avy-current-path
414 (concat avy-current-path (string (avy--key-to-char char))))
417 (funcall avy-handler-function char))))
421 (defun avy-window-list ()
422 "Return a list of windows depending on `avy-all-windows'."
423 (cond ((eq avy-all-windows 'all-frames)
424 (cl-mapcan #'window-list (frame-list)))
426 ((eq avy-all-windows t)
429 ((null avy-all-windows)
430 (list (selected-window)))
433 (error "Unrecognized option: %S" avy-all-windows))))
435 (defcustom avy-all-windows-alt t
436 "The alternative `avy-all-windows' for use with \\[universal-argument]."
438 (const :tag "All windows on the current frame" t)
439 (const :tag "All windows on all frames" all-frames)))
441 (defmacro avy-dowindows (flip &rest body)
442 "Depending on FLIP and `avy-all-windows' run BODY in each or selected window."
445 `(let ((avy-all-windows (if ,flip
448 (dolist (wnd (avy-window-list))
449 (with-selected-window wnd
450 (unless (memq major-mode avy-ignored-modes)
453 (defmacro avy-with (command &rest body)
454 "Set `avy-keys' according to COMMAND and execute BODY.
455 Set `avy-style' according to COMMMAND as well."
458 `(let ((avy-keys (or (cdr (assq ',command avy-keys-alist))
460 (avy-style (or (cdr (assq ',command avy-styles-alist))
462 (setq avy-action nil)
465 (defun avy-action-goto (pt)
469 (defun avy-action-mark (pt)
475 (defun avy-action-copy (pt)
476 "Copy sexp starting on PT."
481 (setq str (buffer-substring pt (point)))
483 (message "Copied: %s" str))))
485 (defun avy-action-kill (pt)
489 (kill-region pt (point))
490 (message "Killed: %s" (current-kill 0)))
492 (defun avy--process (candidates overlay-fn)
493 "Select one of CANDIDATES using `avy-read'.
494 Use OVERLAY-FN to visualize the decision overlay."
495 (unless (and (consp (car candidates))
496 (windowp (cdar candidates)))
498 (mapcar (lambda (x) (cons x (selected-window)))
500 (let ((len (length candidates))
501 (cands (copy-sequence candidates))
504 (message "zero candidates")
506 (setq res (car candidates))
509 (avy--make-backgrounds
511 (setq res (if (eq avy-style 'de-bruijn)
514 (avy-read (avy-tree candidates avy-keys)
516 #'avy--remove-leading-chars))))
518 (cond ((eq res 'restart)
519 (avy--process cands overlay-fn))
520 ;; ignore exit from `avy-handler-function'
524 (when (and (consp res)
526 (let* ((window (cdr res))
527 (frame (window-frame window)))
528 (unless (equal frame (selected-frame))
529 (select-frame-set-input-focus frame))
530 (select-window window))
531 (setq res (car res)))
533 (funcall (or avy-action 'avy-action-goto)
538 (defvar avy--overlays-back nil
539 "Hold overlays for when `avy-background' is t.")
541 (defun avy--make-backgrounds (wnd-list)
542 "Create a dim background overlay for each window on WND-LIST."
544 (setq avy--overlays-back
546 (let ((ol (make-overlay
550 (overlay-put ol 'face 'avy-background-face)
551 (overlay-put ol 'window w)
557 (mapc #'delete-overlay avy--overlays-back)
558 (setq avy--overlays-back nil)
559 (avy--remove-leading-chars))
561 (defun avy--next-visible-point ()
562 "Return the next closest point without 'invisible property."
564 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
565 (get-char-property s 'invisible)))
568 (defun avy--next-invisible-point ()
569 "Return the next closest point with 'invisible property."
571 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
572 (not (get-char-property s 'invisible))))
575 (defun avy--find-visible-regions (rbeg rend)
576 "Return a list of all visible regions between RBEG and REND."
577 (setq rbeg (max rbeg (point-min)))
578 (setq rend (min rend (point-max)))
583 (narrow-to-region rbeg rend)
584 (setq beg (goto-char (point-min)))
585 (while (not (= (point) (point-max)))
586 (goto-char (avy--next-invisible-point))
587 (push (cons beg (point)) visibles)
588 (setq beg (goto-char (avy--next-visible-point))))
589 (nreverse visibles))))))
591 (defun avy--regex-candidates (regex &optional beg end pred group)
592 "Return all elements that match REGEX.
593 Each element of the list is ((BEG . END) . WND)
594 When PRED is non-nil, it's a filter for matching point positions.
595 When GROUP is non-nil, (BEG . END) should delimit that regex group."
596 (setq group (or group 0))
597 (let ((case-fold-search (or avy-case-fold-search
598 (string= regex (downcase regex))))
600 (avy-dowindows current-prefix-arg
601 (dolist (pair (avy--find-visible-regions
602 (or beg (window-start))
603 (or end (window-end (selected-window) t))))
605 (goto-char (car pair))
606 (while (re-search-forward regex (cdr pair) t)
607 (unless (get-char-property (1- (point)) 'invisible)
608 (when (or (null pred)
610 (push (cons (cons (match-beginning group)
612 wnd) candidates)))))))
613 (nreverse candidates)))
615 (defvar avy--overlay-offset 0
616 "The offset to apply in `avy--overlay'.")
618 (defvar avy--overlays-lead nil
619 "Hold overlays for leading chars.")
621 (defun avy--remove-leading-chars ()
622 "Remove leading char overlays."
623 (mapc #'delete-overlay avy--overlays-lead)
624 (setq avy--overlays-lead nil))
626 (defun avy--old-str (pt wnd)
627 "Return a one-char string at PT in WND."
628 (let ((old-str (with-selected-window wnd
629 (buffer-substring pt (1+ pt)))))
631 (propertize old-str 'face 'avy-background-face)
634 (defun avy--overlay (str beg end wnd &optional compose-fn)
635 "Create an overlay with STR from BEG to END in WND.
636 COMPOSE-FN is a lambda that concatenates the old string at BEG with STR."
637 (let ((eob (with-selected-window wnd (point-max))))
639 (let* ((beg (+ beg avy--overlay-offset))
640 (ol (make-overlay beg (or end (1+ beg)) (window-buffer wnd)))
641 (old-str (if (eq beg eob) "" (avy--old-str beg wnd)))
642 (os-line-prefix (get-text-property 0 'line-prefix old-str))
643 (os-wrap-prefix (get-text-property 0 'wrap-prefix old-str))
646 (add-text-properties 0 1 `(line-prefix ,os-line-prefix) str))
648 (add-text-properties 0 1 `(wrap-prefix ,os-wrap-prefix) str))
649 (when (setq other-ol (cl-find-if
650 (lambda (o) (overlay-get o 'goto-address))
654 `(face ,(overlay-get other-ol 'face)) old-str))
655 (overlay-put ol 'window wnd)
656 (overlay-put ol 'category 'avy)
657 (overlay-put ol (if (eq beg eob)
661 (or compose-fn #'concat)
663 (push ol avy--overlays-lead)))))
665 (defcustom avy-highlight-first nil
666 "When non-nil highlight the first decision char with `avy-lead-face-0'.
667 Do this even when the char is terminating."
670 (defun avy--key-to-char (c)
671 "If C is no character, translate it using `avy-key-to-char-alist'."
674 (or (cdr (assoc c avy-key-to-char-alist))
675 (error "Unknown key %s" c))))
677 (defun avy-candidate-beg (leaf)
678 "Return the start position for LEAF."
679 (cond ((numberp leaf)
686 (defun avy-candidate-end (leaf)
687 "Return the end position for LEAF."
688 (cond ((numberp leaf)
695 (defun avy-candidate-wnd (leaf)
696 "Return the window for LEAF."
701 (defun avy--overlay-pre (path leaf)
702 "Create an overlay with PATH at LEAF.
703 PATH is a list of keys from tree root to LEAF.
704 LEAF is normally ((BEG . END) . WND)."
705 (let* ((path (mapcar #'avy--key-to-char path))
706 (str (propertize (apply #'string (reverse path))
707 'face 'avy-lead-face)))
708 (when (or avy-highlight-first (> (length str) 1))
709 (set-text-properties 0 1 '(face avy-lead-face-0) str))
711 (propertize avy-current-path
712 'face 'avy-lead-face-1)
716 (avy-candidate-beg leaf) nil
717 (avy-candidate-wnd leaf))))
719 (defun avy--overlay-at (path leaf)
720 "Create an overlay with PATH at LEAF.
721 PATH is a list of keys from tree root to LEAF.
722 LEAF is normally ((BEG . END) . WND)."
723 (let* ((path (mapcar #'avy--key-to-char path))
725 (string (car (last path)))
726 'face 'avy-lead-face)))
729 (avy-candidate-beg leaf) nil
730 (avy-candidate-wnd leaf)
731 (lambda (str old-str)
732 (cond ((string= old-str "\n")
734 ;; add padding for wide-width character
735 ((eq (string-width old-str) 2)
740 (defun avy--overlay-at-full (path leaf)
741 "Create an overlay with PATH at LEAF.
742 PATH is a list of keys from tree root to LEAF.
743 LEAF is normally ((BEG . END) . WND)."
744 (let* ((path (mapcar #'avy--key-to-char path))
746 (apply #'string (reverse path))
747 'face 'avy-lead-face))
749 (beg (avy-candidate-beg leaf))
753 (set-text-properties (- len i 1) (- len i)
754 `(face ,(nth i avy-lead-faces))
756 (when (eq avy-style 'de-bruijn)
758 (propertize avy-current-path
759 'face 'avy-lead-face-1)
761 (setq len (length str)))
762 (with-selected-window wnd
765 (let* ((lep (if (bound-and-true-p visual-line-mode)
769 (line-end-position)))
770 (len-and-str (avy--update-offset-and-str len str lep)))
771 (setq len (car len-and-str))
772 (setq str (cdr len-and-str))
773 (setq end (if (= beg lep)
776 (if (eq (char-after) ?\t)
780 (when (and (bound-and-true-p visual-line-mode)
783 (setq len (- end beg))
784 (let ((old-str (apply #'string (reverse path))))
790 (if (= (length old-str) 1)
796 (lambda (str old-str)
797 (cond ((string= old-str "\n")
799 ((string= old-str "\t")
800 (concat str (make-string (max (- tab-width len) 0) ?\ )))
802 ;; add padding for wide-width character
803 (if (eq (string-width old-str) 2)
807 (defun avy--overlay-post (path leaf)
808 "Create an overlay with PATH at LEAF.
809 PATH is a list of keys from tree root to LEAF.
810 LEAF is normally ((BEG . END) . WND)."
811 (let* ((path (mapcar #'avy--key-to-char path))
812 (str (propertize (apply #'string (reverse path))
813 'face 'avy-lead-face)))
814 (when (or avy-highlight-first (> (length str) 1))
815 (set-text-properties 0 1 '(face avy-lead-face-0) str))
817 (propertize avy-current-path
818 'face 'avy-lead-face-1)
822 (avy-candidate-end leaf) nil
823 (avy-candidate-wnd leaf))))
825 (defun avy--update-offset-and-str (offset str lep)
826 "Recalculate the length of the new overlay at point.
828 OFFSET is the previous overlay length.
829 STR is the overlay string that we wish to add.
830 LEP is the line end position.
832 We want to add an overlay between point and END=point+OFFSET.
833 When other overlays already exist between point and END, set
834 OFFSET to be the difference between the start of the first
835 overlay and point. This is equivalent to truncating our new
836 overlay, so that it doesn't intersect with overlays that already
838 (let* ((wnd (selected-window))
843 (and (eq (overlay-get o 'category) 'avy)
844 (eq (overlay-get o 'window) wnd)
846 (overlays-in beg (min (+ beg offset) lep))))))
848 (setq offset (- (apply #'min oov) beg))
849 (setq str (substring str 0 offset)))
850 (let ((other-ov (cl-find-if
852 (and (eq (overlay-get o 'category) 'avy)
853 (eq (overlay-start o) beg)
854 (not (eq (overlay-get o 'window) wnd))))
855 (overlays-in (point) (min (+ (point) offset) lep)))))
857 (> (overlay-end other-ov)
859 (setq str (concat str (buffer-substring
861 (overlay-end other-ov))))
862 (setq offset (- (overlay-end other-ov)
866 (defun avy--style-fn (style)
867 "Transform STYLE symbol to a style function."
869 (pre #'avy--overlay-pre)
870 (at #'avy--overlay-at)
871 (at-full 'avy--overlay-at-full)
872 (post #'avy--overlay-post)
873 (de-bruijn #'avy--overlay-at-full)
874 (t (error "Unexpected style %S" style))))
876 (defun avy--generic-jump (regex window-flip style &optional beg end)
878 When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
879 STYLE determines the leading char overlay style.
880 BEG and END delimit the area where candidates are searched."
881 (let ((avy-all-windows
883 (not avy-all-windows)
886 (avy--regex-candidates regex beg end)
887 (avy--style-fn style))))
891 (defun avy-goto-char (char &optional arg)
892 "Jump to the currently visible CHAR.
893 The window scope is determined by `avy-all-windows' (ARG negates it)."
894 (interactive (list (read-char "char: " t)
896 (avy-with avy-goto-char
900 (regexp-quote (string char)))
905 (defun avy-goto-char-in-line (char)
906 "Jump to the currently visible CHAR in the current line."
907 (interactive (list (read-char "char: " t)))
908 (avy-with avy-goto-char
910 (regexp-quote (string char))
913 (line-beginning-position)
914 (line-end-position))))
917 (defun avy-goto-char-2 (char1 char2 &optional arg)
918 "Jump to the currently visible CHAR1 followed by CHAR2.
919 The window scope is determined by `avy-all-windows' (ARG negates it)."
920 (interactive (list (read-char "char 1: " t)
921 (read-char "char 2: " t)
923 (avy-with avy-goto-char-2
925 (regexp-quote (string char1 char2))
930 (defun avy-isearch ()
931 "Jump to one of the current isearch candidates."
933 (avy-with avy-isearch
934 (let ((avy-background nil))
936 (avy--regex-candidates isearch-string)
937 (avy--style-fn avy-style))
941 (defun avy-goto-word-0 (arg)
942 "Jump to a word start.
943 The window scope is determined by `avy-all-windows' (ARG negates it)."
945 (avy-with avy-goto-word-0
946 (avy--generic-jump "\\b\\sw" arg avy-style)))
949 (defun avy-goto-word-1 (char &optional arg)
950 "Jump to the currently visible CHAR at a word start.
951 The window scope is determined by `avy-all-windows' (ARG negates it)."
952 (interactive (list (read-char "char: " t)
954 (avy-with avy-goto-word-1
955 (let* ((str (string char))
956 (regex (cond ((string= str ".")
958 ((and avy-word-punc-regexp
959 (string-match avy-word-punc-regexp str))
965 (avy--generic-jump regex arg avy-style))))
967 (declare-function subword-backward "subword")
968 (defvar subword-backward-regexp)
970 (defcustom avy-subword-extra-word-chars '(?{ ?= ?} ?* ?: ?> ?<)
971 "A list of characters that should temporarily match \"\\w\".
972 This variable is used by `avy-goto-subword-0' and `avy-goto-subword-1'."
973 :type '(repeat character))
976 (defun avy-goto-subword-0 (&optional arg predicate)
977 "Jump to a word or subword start.
979 The window scope is determined by `avy-all-windows' (ARG negates it).
981 When PREDICATE is non-nil it's a function of zero parameters that
985 (avy-with avy-goto-subword-0
986 (let ((case-fold-search nil)
987 (subword-backward-regexp
988 "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)")
991 (let ((syn-tbl (copy-syntax-table)))
992 (dolist (char avy-subword-extra-word-chars)
993 (modify-syntax-entry char "w" syn-tbl))
994 (with-syntax-table syn-tbl
995 (let ((ws (window-start))
998 (goto-char (window-end (selected-window) t))
1000 (while (> (point) ws)
1001 (when (or (null predicate)
1002 (and predicate (funcall predicate)))
1003 (unless (get-char-property (point) 'invisible)
1004 (push (cons (point) (selected-window)) window-cands)))
1005 (subword-backward)))
1006 (setq candidates (nconc candidates window-cands))))))
1007 (avy--process candidates (avy--style-fn avy-style)))))
1010 (defun avy-goto-subword-1 (char &optional arg)
1011 "Jump to the currently visible CHAR at a subword start.
1012 The window scope is determined by `avy-all-windows' (ARG negates it).
1013 The case of CHAR is ignored."
1014 (interactive (list (read-char "char: " t)
1015 current-prefix-arg))
1016 (avy-with avy-goto-subword-1
1017 (let ((char (downcase char)))
1019 arg (lambda () (eq (downcase (char-after)) char))))))
1022 (defun avy-goto-word-or-subword-1 ()
1023 "Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
1024 Which one depends on variable `subword-mode'."
1026 (if (bound-and-true-p subword-mode)
1027 (call-interactively #'avy-goto-subword-1)
1028 (call-interactively #'avy-goto-word-1)))
1030 (defvar visual-line-mode)
1032 (defun avy--line (&optional arg beg end)
1034 The window scope is determined by `avy-all-windows' (ARG negates it).
1035 Narrow the scope to BEG END."
1038 (let ((ws (or beg (window-start))))
1041 (narrow-to-region ws (or end (window-end (selected-window) t)))
1042 (goto-char (point-min))
1043 (while (< (point) (point-max))
1044 (unless (get-char-property
1045 (max (1- (point)) ws) 'invisible)
1047 (if (eq avy-style 'post)
1050 (selected-window)) candidates))
1051 (if visual-line-mode
1053 (setq temporary-goal-column 0)
1054 (line-move-visual 1 t))
1055 (forward-line 1)))))))
1056 (let ((avy-action #'identity))
1057 (avy--process (nreverse candidates) (avy--style-fn avy-style)))))
1060 (defun avy-goto-line (&optional arg)
1061 "Jump to a line start in current buffer.
1063 When ARG is 1, jump to lines currently visible, with the option
1064 to cancel to `goto-line' by entering a number.
1066 When ARG is 4, negate the window scope determined by
1069 Otherwise, forward to `goto-line' with ARG."
1071 (setq arg (or arg 1))
1072 (if (not (memq arg '(1 4)))
1074 (goto-char (point-min))
1075 (forward-line (1- arg)))
1076 (avy-with avy-goto-line
1077 (let* ((avy-handler-function
1081 (avy-handler-default char)
1082 (let ((line (read-from-minibuffer
1083 "Goto line: " (string char))))
1088 (goto-char (point-min))
1089 (forward-line (1- (string-to-number line))))
1090 (throw 'done 'exit))))))
1091 (r (avy--line (eq arg 4))))
1093 (avy-action-goto r))))))
1096 (defun avy-goto-line-above ()
1097 "Goto visible line above the cursor."
1099 (let* ((avy-all-windows nil)
1100 (r (avy--line nil (window-start)
1101 (line-beginning-position))))
1103 (avy-action-goto r))))
1106 (defun avy-goto-line-below ()
1107 "Goto visible line below the cursor."
1109 (let* ((avy-all-windows nil)
1111 nil (line-beginning-position 2)
1112 (window-end (selected-window) t))))
1114 (avy-action-goto r))))
1116 (defcustom avy-line-insert-style 'above
1117 "How to insert the newly copied/cut line."
1119 (const :tag "Above" above)
1120 (const :tag "Below" below)))
1123 (defun avy-copy-line (arg)
1124 "Copy a selected line above the current line.
1125 ARG lines can be used."
1127 (let ((initial-window (selected-window)))
1128 (avy-with avy-copy-line
1129 (let* ((start (avy--line))
1130 (str (buffer-substring-no-properties
1134 (move-end-of-line arg)
1136 (select-window initial-window)
1137 (cond ((eq avy-line-insert-style 'above)
1141 ((eq avy-line-insert-style 'below)
1144 (beginning-of-line))
1146 (user-error "Unexpected `avy-line-insert-style'")))))))
1149 (defun avy-move-line (arg)
1150 "Move a selected line above the current line.
1151 ARG lines can be used."
1153 (let ((initial-window (selected-window)))
1154 (avy-with avy-move-line
1155 (let ((start (avy--line)))
1158 (kill-whole-line arg))
1159 (select-window initial-window)
1160 (cond ((eq avy-line-insert-style 'above)
1165 ((eq avy-line-insert-style 'below)
1169 (insert (substring (current-kill 0) 0 -1))))
1171 (user-error "Unexpected `avy-line-insert-style'")))))))
1174 (defun avy-copy-region (arg)
1175 "Select two lines and copy the text between them to point.
1177 The window scope is determined by `avy-all-windows' or
1178 `avy-all-windows-alt' when ARG is non-nil."
1180 (let ((initial-window (selected-window)))
1181 (avy-with avy-copy-region
1182 (let* ((beg (save-selected-window
1184 (end (avy--line arg))
1185 (str (buffer-substring-no-properties
1189 (line-end-position)))))
1190 (select-window initial-window)
1191 (cond ((eq avy-line-insert-style 'above)
1195 ((eq avy-line-insert-style 'below)
1201 (user-error "Unexpected `avy-line-insert-style'")))))))
1204 (defun avy-setup-default ()
1205 "Setup the default shortcuts."
1206 (eval-after-load "isearch"
1207 '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
1209 (defcustom avy-timeout-seconds 0.5
1210 "How many seconds to wait for the second char.")
1212 (defun avy--read-candidates ()
1213 "Read as many chars as possible and return their occurences.
1214 At least one char must be read, and then repeatedly one next char
1215 may be read if it is entered before `avy-timeout-seconds'. `DEL'
1216 deletes the last char entered, and `RET' exits with the currently
1217 read string immediately instead of waiting for another char for
1218 `avy-timeout-seconds'.
1219 The format of the result is the same as that of `avy--regex-candidates'.
1220 This function obeys `avy-all-windows' setting."
1221 (let ((str "") char break overlays regex)
1224 (while (and (not break)
1226 (read-char (format "char%s: "
1227 (if (string= str "")
1229 (format " (%s)" str)))
1231 (and (not (string= str ""))
1232 avy-timeout-seconds))))
1234 (dolist (ov overlays)
1235 (delete-overlay ov))
1243 (let ((l (length str)))
1245 (setq str (substring str 0 (1- l))))))
1247 (setq str (concat str (list char)))))
1249 (when (>= (length str) 1)
1250 (let ((case-fold-search
1251 (or avy-case-fold-search (string= str (downcase str))))
1253 (avy-dowindows current-prefix-arg
1254 (dolist (pair (avy--find-visible-regions
1256 (window-end (selected-window) t)))
1258 (goto-char (car pair))
1259 (setq regex (regexp-quote str))
1260 (while (re-search-forward regex (cdr pair) t)
1261 (unless (get-char-property (1- (point)) 'invisible)
1262 (let ((ov (make-overlay
1267 (overlay-put ov 'window (selected-window))
1268 (overlay-put ov 'face 'avy-goto-char-timer-face)))))))
1269 ;; No matches at all, so there's surely a typo in the input.
1270 (unless found (beep)))))
1271 (nreverse (mapcar (lambda (ov)
1272 (cons (cons (overlay-start ov)
1274 (overlay-get ov 'window)))
1276 (dolist (ov overlays)
1277 (delete-overlay ov)))))
1280 (defun avy-goto-char-timer (&optional arg)
1281 "Read one or many consecutive chars and jump to the first one.
1282 The window scope is determined by `avy-all-windows' (ARG negates it)."
1284 (let ((avy-all-windows (if arg
1285 (not avy-all-windows)
1287 (avy-with avy-goto-char-timer
1289 (avy--read-candidates)
1290 (avy--style-fn avy-style)))))
1292 (defvar avy-ring (make-ring 20)
1293 "Hold the window and point history.")
1295 (defun avy-push-mark ()
1296 "Store the current point and window."
1297 (ring-insert avy-ring
1298 (cons (point) (selected-window)))
1299 (unless (region-active-p)
1302 (defun avy-pop-mark ()
1303 "Jump back to the last location of `avy-push-mark'."
1308 (while (not (window-live-p
1309 (cdr (setq res (ring-remove avy-ring 0))))))
1310 (let* ((window (cdr res))
1311 (frame (window-frame window)))
1312 (when (and (frame-live-p frame)
1313 (not (eq frame (selected-frame))))
1314 (select-frame-set-input-focus frame))
1315 (select-window window)
1316 (goto-char (car res))))
1318 (set-mark-command 4)))))
1320 (define-obsolete-function-alias
1321 'avy--goto 'identity "0.3.0"
1322 "Don't use this function any more.
1323 `avy--process' will do the jump all by itself.")
1325 (define-obsolete-function-alias 'avy--with-avy-keys 'avy-with "0.3.0")
1329 ;;; avy.el ends here