1 ;;; avy.el --- set-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)))
645 (add-text-properties 0 1 `(line-prefix ,os-line-prefix) str))
647 (add-text-properties 0 1 `(wrap-prefix ,os-wrap-prefix) str))
648 (overlay-put ol 'window wnd)
649 (overlay-put ol 'category 'avy)
650 (overlay-put ol (if (eq beg eob)
654 (or compose-fn #'concat)
656 (push ol avy--overlays-lead)))))
658 (defcustom avy-highlight-first nil
659 "When non-nil highlight the first decision char with `avy-lead-face-0'.
660 Do this even when the char is terminating."
663 (defun avy--key-to-char (c)
664 "If C is no character, translate it using `avy-key-to-char-alist'."
667 (or (cdr (assoc c avy-key-to-char-alist))
668 (error "Unknown key %s" c))))
670 (defun avy-candidate-beg (leaf)
671 "Return the start position for LEAF."
672 (cond ((numberp leaf)
679 (defun avy-candidate-end (leaf)
680 "Return the end position for LEAF."
681 (cond ((numberp leaf)
688 (defun avy-candidate-wnd (leaf)
689 "Return the window for LEAF."
694 (defun avy--overlay-pre (path leaf)
695 "Create an overlay with PATH at LEAF.
696 PATH is a list of keys from tree root to LEAF.
697 LEAF is normally ((BEG . END) . WND)."
698 (let* ((path (mapcar #'avy--key-to-char path))
699 (str (propertize (apply #'string (reverse path))
700 'face 'avy-lead-face)))
701 (when (or avy-highlight-first (> (length str) 1))
702 (set-text-properties 0 1 '(face avy-lead-face-0) str))
704 (propertize avy-current-path
705 'face 'avy-lead-face-1)
709 (avy-candidate-beg leaf) nil
710 (avy-candidate-wnd leaf))))
712 (defun avy--overlay-at (path leaf)
713 "Create an overlay with PATH at LEAF.
714 PATH is a list of keys from tree root to LEAF.
715 LEAF is normally ((BEG . END) . WND)."
716 (let* ((path (mapcar #'avy--key-to-char path))
718 (string (car (last path)))
719 'face 'avy-lead-face)))
722 (avy-candidate-beg leaf) nil
723 (avy-candidate-wnd leaf)
724 (lambda (str old-str)
725 (cond ((string= old-str "\n")
727 ;; add padding for wide-width character
728 ((eq (string-width old-str) 2)
733 (defun avy--overlay-at-full (path leaf)
734 "Create an overlay with PATH at LEAF.
735 PATH is a list of keys from tree root to LEAF.
736 LEAF is normally ((BEG . END) . WND)."
737 (let* ((path (mapcar #'avy--key-to-char path))
739 (apply #'string (reverse path))
740 'face 'avy-lead-face))
742 (beg (avy-candidate-beg leaf))
746 (set-text-properties (- len i 1) (- len i)
747 `(face ,(nth i avy-lead-faces))
749 (when (eq avy-style 'de-bruijn)
751 (propertize avy-current-path
752 'face 'avy-lead-face-1)
754 (setq len (length str)))
755 (with-selected-window wnd
758 (let* ((lep (if (bound-and-true-p visual-line-mode)
762 (line-end-position)))
763 (len-and-str (avy--update-offset-and-str len str lep)))
764 (setq len (car len-and-str))
765 (setq str (cdr len-and-str))
766 (setq end (if (= beg lep)
769 (if (eq (char-after) ?\t)
773 (when (and (bound-and-true-p visual-line-mode)
776 (setq len (- end beg))
777 (let ((old-str (apply #'string (reverse path))))
783 (if (= (length old-str) 1)
789 (lambda (str old-str)
790 (cond ((string= old-str "\n")
792 ((string= old-str "\t")
793 (concat str (make-string (max (- tab-width len) 0) ?\ )))
795 ;; add padding for wide-width character
796 (if (eq (string-width old-str) 2)
800 (defun avy--overlay-post (path leaf)
801 "Create an overlay with PATH at LEAF.
802 PATH is a list of keys from tree root to LEAF.
803 LEAF is normally ((BEG . END) . WND)."
804 (let* ((path (mapcar #'avy--key-to-char path))
805 (str (propertize (apply #'string (reverse path))
806 'face 'avy-lead-face)))
807 (when (or avy-highlight-first (> (length str) 1))
808 (set-text-properties 0 1 '(face avy-lead-face-0) str))
810 (propertize avy-current-path
811 'face 'avy-lead-face-1)
815 (avy-candidate-end leaf) nil
816 (avy-candidate-wnd leaf))))
818 (defun avy--update-offset-and-str (offset str lep)
819 "Recalculate the length of the new overlay at point.
821 OFFSET is the previous overlay length.
822 STR is the overlay string that we wish to add.
823 LEP is the line end position.
825 We want to add an overlay between point and END=point+OFFSET.
826 When other overlays already exist between point and END, set
827 OFFSET to be the difference between the start of the first
828 overlay and point. This is equivalent to truncating our new
829 overlay, so that it doesn't intersect with overlays that already
831 (let* ((wnd (selected-window))
836 (and (eq (overlay-get o 'category) 'avy)
837 (eq (overlay-get o 'window) wnd)
839 (overlays-in beg (min (+ beg offset) lep))))))
841 (setq offset (- (apply #'min oov) beg))
842 (setq str (substring str 0 offset)))
843 (let ((other-ov (cl-find-if
845 (and (eq (overlay-get o 'category) 'avy)
846 (eq (overlay-start o) beg)
847 (not (eq (overlay-get o 'window) wnd))))
848 (overlays-in (point) (min (+ (point) offset) lep)))))
850 (> (overlay-end other-ov)
852 (setq str (concat str (buffer-substring
854 (overlay-end other-ov))))
855 (setq offset (- (overlay-end other-ov)
859 (defun avy--style-fn (style)
860 "Transform STYLE symbol to a style function."
862 (pre #'avy--overlay-pre)
863 (at #'avy--overlay-at)
864 (at-full 'avy--overlay-at-full)
865 (post #'avy--overlay-post)
866 (de-bruijn #'avy--overlay-at-full)
867 (t (error "Unexpected style %S" style))))
869 (defun avy--generic-jump (regex window-flip style &optional beg end)
871 When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
872 STYLE determines the leading char overlay style.
873 BEG and END delimit the area where candidates are searched."
874 (let ((avy-all-windows
876 (not avy-all-windows)
879 (avy--regex-candidates regex beg end)
880 (avy--style-fn style))))
884 (defun avy-goto-char (char &optional arg)
885 "Jump to the currently visible CHAR.
886 The window scope is determined by `avy-all-windows' (ARG negates it)."
887 (interactive (list (read-char "char: " t)
889 (avy-with avy-goto-char
893 (regexp-quote (string char)))
898 (defun avy-goto-char-in-line (char)
899 "Jump to the currently visible CHAR in the current line."
900 (interactive (list (read-char "char: " t)))
901 (avy-with avy-goto-char
903 (regexp-quote (string char))
906 (line-beginning-position)
907 (line-end-position))))
910 (defun avy-goto-char-2 (char1 char2 &optional arg)
911 "Jump to the currently visible CHAR1 followed by CHAR2.
912 The window scope is determined by `avy-all-windows' (ARG negates it)."
913 (interactive (list (read-char "char 1: " t)
914 (read-char "char 2: " t)
916 (avy-with avy-goto-char-2
918 (regexp-quote (string char1 char2))
923 (defun avy-isearch ()
924 "Jump to one of the current isearch candidates."
926 (avy-with avy-isearch
927 (let ((avy-background nil))
929 (avy--regex-candidates isearch-string)
930 (avy--style-fn avy-style))
934 (defun avy-goto-word-0 (arg)
935 "Jump to a word start.
936 The window scope is determined by `avy-all-windows' (ARG negates it)."
938 (avy-with avy-goto-word-0
939 (avy--generic-jump "\\b\\sw" arg avy-style)))
942 (defun avy-goto-word-1 (char &optional arg)
943 "Jump to the currently visible CHAR at a word start.
944 The window scope is determined by `avy-all-windows' (ARG negates it)."
945 (interactive (list (read-char "char: " t)
947 (avy-with avy-goto-word-1
948 (let* ((str (string char))
949 (regex (cond ((string= str ".")
951 ((and avy-word-punc-regexp
952 (string-match avy-word-punc-regexp str))
958 (avy--generic-jump regex arg avy-style))))
960 (declare-function subword-backward "subword")
961 (defvar subword-backward-regexp)
963 (defcustom avy-subword-extra-word-chars '(?{ ?= ?} ?* ?: ?> ?<)
964 "A list of characters that should temporarily match \"\\w\".
965 This variable is used by `avy-goto-subword-0' and `avy-goto-subword-1'."
966 :type '(repeat character))
969 (defun avy-goto-subword-0 (&optional arg predicate)
970 "Jump to a word or subword start.
972 The window scope is determined by `avy-all-windows' (ARG negates it).
974 When PREDICATE is non-nil it's a function of zero parameters that
978 (avy-with avy-goto-subword-0
979 (let ((case-fold-search nil)
980 (subword-backward-regexp
981 "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)")
984 (let ((syn-tbl (copy-syntax-table)))
985 (dolist (char avy-subword-extra-word-chars)
986 (modify-syntax-entry char "w" syn-tbl))
987 (with-syntax-table syn-tbl
988 (let ((ws (window-start))
991 (goto-char (window-end (selected-window) t))
993 (while (> (point) ws)
994 (when (or (null predicate)
995 (and predicate (funcall predicate)))
996 (unless (get-char-property (point) 'invisible)
997 (push (cons (point) (selected-window)) window-cands)))
999 (setq candidates (nconc candidates window-cands))))))
1000 (avy--process candidates (avy--style-fn avy-style)))))
1003 (defun avy-goto-subword-1 (char &optional arg)
1004 "Jump to the currently visible CHAR at a subword start.
1005 The window scope is determined by `avy-all-windows' (ARG negates it).
1006 The case of CHAR is ignored."
1007 (interactive (list (read-char "char: " t)
1008 current-prefix-arg))
1009 (avy-with avy-goto-subword-1
1010 (let ((char (downcase char)))
1012 arg (lambda () (eq (downcase (char-after)) char))))))
1015 (defun avy-goto-word-or-subword-1 ()
1016 "Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
1017 Which one depends on variable `subword-mode'."
1019 (if (bound-and-true-p subword-mode)
1020 (call-interactively #'avy-goto-subword-1)
1021 (call-interactively #'avy-goto-word-1)))
1023 (defvar visual-line-mode)
1025 (defun avy--line (&optional arg beg end)
1027 The window scope is determined by `avy-all-windows' (ARG negates it).
1028 Narrow the scope to BEG END."
1031 (let ((ws (or beg (window-start))))
1034 (narrow-to-region ws (or end (window-end (selected-window) t)))
1035 (goto-char (point-min))
1036 (while (< (point) (point-max))
1037 (unless (get-char-property
1038 (max (1- (point)) ws) 'invisible)
1040 (if (eq avy-style 'post)
1043 (selected-window)) candidates))
1044 (if visual-line-mode
1046 (setq temporary-goal-column 0)
1047 (line-move-visual 1 t))
1048 (forward-line 1)))))))
1049 (let ((avy-action #'identity))
1050 (avy--process (nreverse candidates) (avy--style-fn avy-style)))))
1053 (defun avy-goto-line (&optional arg)
1054 "Jump to a line start in current buffer.
1056 When ARG is 1, jump to lines currently visible, with the option
1057 to cancel to `goto-line' by entering a number.
1059 When ARG is 4, negate the window scope determined by
1062 Otherwise, forward to `goto-line' with ARG."
1064 (setq arg (or arg 1))
1065 (if (not (memq arg '(1 4)))
1067 (goto-char (point-min))
1068 (forward-line (1- arg)))
1069 (avy-with avy-goto-line
1070 (let* ((avy-handler-function
1074 (avy-handler-default char)
1075 (let ((line (read-from-minibuffer
1076 "Goto line: " (string char))))
1081 (goto-char (point-min))
1082 (forward-line (1- (string-to-number line))))
1083 (throw 'done 'exit))))))
1084 (r (avy--line (eq arg 4))))
1086 (avy-action-goto r))))))
1089 (defun avy-goto-line-above ()
1090 "Goto visible line above the cursor."
1092 (let* ((avy-all-windows nil)
1093 (r (avy--line nil (window-start)
1094 (line-beginning-position))))
1096 (avy-action-goto r))))
1099 (defun avy-goto-line-below ()
1100 "Goto visible line below the cursor."
1102 (let* ((avy-all-windows nil)
1104 nil (line-beginning-position 2)
1105 (window-end (selected-window) t))))
1107 (avy-action-goto r))))
1109 (defcustom avy-line-insert-style 'above
1110 "How to insert the newly copied/cut line."
1112 (const :tag "Above" above)
1113 (const :tag "Below" below)))
1116 (defun avy-copy-line (arg)
1117 "Copy a selected line above the current line.
1118 ARG lines can be used."
1120 (let ((initial-window (selected-window)))
1121 (avy-with avy-copy-line
1122 (let* ((start (avy--line))
1123 (str (buffer-substring-no-properties
1127 (move-end-of-line arg)
1129 (select-window initial-window)
1130 (cond ((eq avy-line-insert-style 'above)
1134 ((eq avy-line-insert-style 'below)
1137 (beginning-of-line))
1139 (user-error "Unexpected `avy-line-insert-style'")))))))
1142 (defun avy-move-line (arg)
1143 "Move a selected line above the current line.
1144 ARG lines can be used."
1146 (let ((initial-window (selected-window)))
1147 (avy-with avy-move-line
1148 (let ((start (avy--line)))
1151 (kill-whole-line arg))
1152 (select-window initial-window)
1153 (cond ((eq avy-line-insert-style 'above)
1158 ((eq avy-line-insert-style 'below)
1162 (insert (substring (current-kill 0) 0 -1))))
1164 (user-error "Unexpected `avy-line-insert-style'")))))))
1167 (defun avy-copy-region (arg)
1168 "Select two lines and copy the text between them to point.
1170 The window scope is determined by `avy-all-windows' or
1171 `avy-all-windows-alt' when ARG is non-nil."
1173 (let ((initial-window (selected-window)))
1174 (avy-with avy-copy-region
1175 (let* ((beg (save-selected-window
1177 (end (avy--line arg))
1178 (str (buffer-substring-no-properties
1182 (line-end-position)))))
1183 (select-window initial-window)
1184 (cond ((eq avy-line-insert-style 'above)
1188 ((eq avy-line-insert-style 'below)
1194 (user-error "Unexpected `avy-line-insert-style'")))))))
1197 (defun avy-setup-default ()
1198 "Setup the default shortcuts."
1199 (eval-after-load "isearch"
1200 '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
1202 (defcustom avy-timeout-seconds 0.5
1203 "How many seconds to wait for the second char.")
1205 (defun avy--read-candidates ()
1206 "Read as many chars as possible and return their occurences.
1207 At least one char must be read, and then repeatedly one next char
1208 may be read if it is entered before `avy-timeout-seconds'. `DEL'
1209 deletes the last char entered, and `RET' exits with the currently
1210 read string immediately instead of waiting for another char for
1211 `avy-timeout-seconds'.
1212 The format of the result is the same as that of `avy--regex-candidates'.
1213 This function obeys `avy-all-windows' setting."
1214 (let ((str "") char break overlays regex)
1217 (while (and (not break)
1219 (read-char (format "char%s: "
1220 (if (string= str "")
1222 (format " (%s)" str)))
1224 (and (not (string= str ""))
1225 avy-timeout-seconds))))
1227 (dolist (ov overlays)
1228 (delete-overlay ov))
1236 (let ((l (length str)))
1238 (setq str (substring str 0 (1- l))))))
1240 (setq str (concat str (list char)))))
1242 (when (>= (length str) 1)
1243 (let ((case-fold-search
1244 (or avy-case-fold-search (string= str (downcase str))))
1246 (avy-dowindows current-prefix-arg
1247 (dolist (pair (avy--find-visible-regions
1249 (window-end (selected-window) t)))
1251 (goto-char (car pair))
1252 (setq regex (regexp-quote str))
1253 (while (re-search-forward regex (cdr pair) t)
1254 (unless (get-char-property (1- (point)) 'invisible)
1255 (let ((ov (make-overlay
1260 (overlay-put ov 'window (selected-window))
1261 (overlay-put ov 'face 'avy-goto-char-timer-face)))))))
1262 ;; No matches at all, so there's surely a typo in the input.
1263 (unless found (beep)))))
1264 (nreverse (mapcar (lambda (ov)
1265 (cons (cons (overlay-start ov)
1267 (overlay-get ov 'window)))
1269 (dolist (ov overlays)
1270 (delete-overlay ov)))))
1273 (defun avy-goto-char-timer (&optional arg)
1274 "Read one or many consecutive chars and jump to the first one.
1275 The window scope is determined by `avy-all-windows' (ARG negates it)."
1277 (let ((avy-all-windows (if arg
1278 (not avy-all-windows)
1280 (avy-with avy-goto-char-timer
1282 (avy--read-candidates)
1283 (avy--style-fn avy-style)))))
1285 (defvar avy-ring (make-ring 20)
1286 "Hold the window and point history.")
1288 (defun avy-push-mark ()
1289 "Store the current point and window."
1290 (ring-insert avy-ring
1291 (cons (point) (selected-window)))
1292 (unless (region-active-p)
1295 (defun avy-pop-mark ()
1296 "Jump back to the last location of `avy-push-mark'."
1301 (while (not (window-live-p
1302 (cdr (setq res (ring-remove avy-ring 0))))))
1303 (let* ((window (cdr res))
1304 (frame (window-frame window)))
1305 (when (and (frame-live-p frame)
1306 (not (eq frame (selected-frame))))
1307 (select-frame-set-input-focus frame))
1308 (select-window window)
1309 (goto-char (car res))))
1311 (set-mark-command 4)))))
1313 (define-obsolete-function-alias
1314 'avy--goto 'identity "0.3.0"
1315 "Don't use this function any more.
1316 `avy--process' will do the jump all by itself.")
1318 (define-obsolete-function-alias 'avy--with-avy-keys 'avy-with "0.3.0")
1322 ;;; avy.el ends here