code.delx.au - gnu-emacs-elpa/blob - avy.el

   1 ;;; avy.el --- set-based completion -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
   6 ;; URL: https://github.com/abo-abo/avy
   7 ;; Version: 0.2.1
   8 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
   9 ;; Keywords: point, location
  10
  11 ;; This file is part of GNU Emacs.
  12
  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)
  16 ;; any later version.
  17
  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.
  22
  23 ;; For a full copy of the GNU General Public License
  24 ;; see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;;
  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-char' can be used.
  32 ;;
  33 ;; In order for `read-char' 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:
  37 ;;
  38 ;; * character positions
  39 ;; * word or subword start positions
  40 ;; * line beginning positions
  41 ;; * link positions
  42 ;; * window positions
  43 ;;
  44 ;; If you're familiar with the popular `ace-jump-mode' package, this
  45 ;; package does all that and more, without the implementation
  46 ;; headache.
  47
  48 ;;; Code:
  49 (require 'cl-lib)
  50
  51 ;;* Customization
  52 (defgroup avy nil
  53   "Jump to things tree-style."
  54   :group 'convenience
  55   :prefix "avy-")
  56
  57 (defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
  58   "Default keys for jumping."
  59   :type '(repeat :tag "Keys" character))
  60
  61 (defcustom avy-keys-alist nil
  62   "Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
  63   :type '(alist
  64           :key-type (choice :tag "Command"
  65                      (const avy-goto-char)
  66                      (const avy-goto-char-2)
  67                      (const avy-isearch)
  68                      (const avy-goto-line)
  69                      (const avy-goto-subword-0)
  70                      (const avy-goto-subword-1)
  71                      (const avy-goto-word-0)
  72                      (const avy-goto-word-1)
  73                      (const avy-copy-line)
  74                      (const avy-copy-region)
  75                      (const avy-move-line))
  76           :value-type (repeat :tag "Keys" character)))
  77
  78 (defcustom avy-style 'pre
  79   "The default method of displaying the overlays.
  80 Use `avy-styles-alist' to customize this per-command."
  81   :type '(choice
  82           (const :tag "Pre" pre)
  83           (const :tag "At" at)
  84           (const :tag "At Full" at-full)
  85           (const :tag "Post" post)
  86           (const :tag "De Bruijn" de-bruijn)))
  87
  88 (defcustom avy-styles-alist nil
  89   "Alist of avy-jump commands to the style for each command.
  90 If the commands isn't on the list, `avy-style' is used."
  91   :type '(alist
  92           :key-type (choice :tag "Command"
  93                      (const avy-goto-char)
  94                      (const avy-goto-char-2)
  95                      (const avy-isearch)
  96                      (const avy-goto-line)
  97                      (const avy-goto-subword-0)
  98                      (const avy-goto-subword-1)
  99                      (const avy-goto-word-0)
 100                      (const avy-goto-word-1)
 101                      (const avy-copy-line)
 102                      (const avy-copy-region)
 103                      (const avy-move-line))
 104           :value-type (choice
 105                        (const :tag "Pre" pre)
 106                        (const :tag "At" at)
 107                        (const :tag "At Full" at-full)
 108                        (const :tag "Post" post))))
 109
 110 (defcustom avy-background nil
 111   "When non-nil, a gray background will be added during the selection."
 112   :type 'boolean)
 113
 114 (defcustom avy-all-windows t
 115   "Determine the list of windows to consider in search of candidates."
 116   :type
 117   '(choice
 118     (const :tag "All Frames" all-frames)
 119     (const :tag "This Frame" t)
 120     (const :tag "This Window" nil)))
 121
 122 (defcustom avy-case-fold-search t
 123   "Non-nil if searches should ignore case."
 124   :type 'boolean)
 125
 126 (defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]"
 127   "Regexp of punctuation chars that count as word starts for `avy-goto-word-1.
 128 When nil, punctuation chars will not be matched.
 129
 130 \"[!-/:-@[-`{-~]\" will match all printable punctuation chars."
 131   :type 'regexp)
 132
 133 (defface avy-lead-face-0
 134   '((t (:foreground "white" :background "#4f57f9")))
 135   "Face used for first non-terminating leading chars.")
 136
 137 (defface avy-lead-face-1
 138     '((t (:foreground "white" :background "gray")))
 139   "Face used for matched leading chars.")
 140
 141 (defface avy-lead-face
 142   '((t (:foreground "white" :background "#e52b50")))
 143   "Face used for the leading chars.")
 144
 145 (defface avy-background-face
 146   '((t (:foreground "gray40")))
 147   "Face for whole window background during selection.")
 148
 149 ;;* Internals
 150 ;;** Tree
 151 (defmacro avy-multipop (lst n)
 152   "Remove LST's first N elements and return them."
 153   `(if (<= (length ,lst) ,n)
 154        (prog1 ,lst
 155          (setq ,lst nil))
 156      (prog1 ,lst
 157        (setcdr
 158         (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
 159         nil))))
 160
 161 (defun avy--de-bruijn (keys n)
 162   "De Bruijn sequence for alphabet KEYS and subsequences of length N."
 163   (let* ((k (length keys))
 164          (a (make-list (* n k) 0))
 165          sequence)
 166     (cl-labels ((db (T p)
 167                   (if (> T n)
 168                       (if (eq (% n p) 0)
 169                           (setq sequence
 170                                 (append sequence
 171                                         (cl-subseq a 1 (1+ p)))))
 172                     (setf (nth T a) (nth (- T p) a))
 173                     (db (1+ T) p)
 174                     (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
 175                              (setf (nth T a) j)
 176                              (db (1+ T) T)))))
 177       (db 1 1)
 178       (mapcar (lambda (n)
 179                 (nth n keys))
 180               sequence))))
 181
 182 (defun avy--path-alist-1 (lst seq-len keys)
 183   "Build a De Bruin sequence from LST.
 184 SEQ-LEN is how many elements of KEYS it takes to identify a match."
 185   (let ((db-seq (avy--de-bruijn keys seq-len))
 186         prev-pos prev-seq prev-win path-alist)
 187     ;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to
 188     ;; the end.
 189     (setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len))))
 190     (cl-labels ((subseq-and-pop ()
 191                   (when (nth (1- seq-len) db-seq)
 192                     (prog1 (cl-subseq db-seq 0 seq-len)
 193                       (pop db-seq)))))
 194       (while lst
 195         (let* ((cur (car lst))
 196                (pos (cond
 197                       ;; ace-window has matches of the form (pos . wnd)
 198                       ((integerp (car cur)) (car cur))
 199                       ;; avy-jump have form ((start . end) . wnd)
 200                       ((consp (car cur)) (caar cur))
 201                       (t (error "Unexpected match representation: %s" cur))))
 202                (win (cdr cur))
 203                (path (if prev-pos
 204                          (let ((diff (if (eq win prev-win)
 205                                          (- pos prev-pos)
 206                                        0)))
 207                            (when (and (> diff 0) (< diff seq-len))
 208                              (while (and (nth (1- seq-len) db-seq)
 209                                          (not
 210                                           (eq 0 (cl-search
 211                                                  (cl-subseq prev-seq diff)
 212                                                  (cl-subseq db-seq 0 seq-len)))))
 213                                (pop db-seq)))
 214                            (subseq-and-pop))
 215                        (subseq-and-pop))))
 216           (if (not path)
 217               (setq lst nil
 218                     path-alist nil)
 219             (push (cons path (car lst)) path-alist)
 220             (setq prev-pos pos
 221                   prev-seq path
 222                   prev-win win
 223                   lst (cdr lst))))))
 224     (nreverse path-alist)))
 225
 226 (defun avy--group-by (fn seq)
 227   "Apply FN to each element of SEQ.
 228 Separate the elements of SEQ into an alist using the results as
 229 keys.  Keys are compared using `equal'."
 230   (let (alist)
 231     (while seq
 232       (let* ((el (pop seq))
 233              (r (funcall fn el))
 234              (entry (assoc r alist)))
 235         (if entry
 236             (setcdr entry (cons el (cdr entry)))
 237           (push (list r el) alist))))
 238     alist))
 239
 240 (defun avy--path-alist-to-tree (p-alist)
 241   "Convert P-ALIST to the format of `avy-tree'."
 242   (if (> (length (caar p-alist)) 1)
 243       (mapcar (lambda (x)
 244                 (setcdr x (avy--path-alist-to-tree
 245                            (mapcar (lambda (c)
 246                                      (cons (cdar c) (cdr c)))
 247                                    (cdr x))))
 248                 x)
 249               (avy--group-by #'caar p-alist))
 250     (mapcar (lambda (x)
 251               (cons (caar x)
 252                     (cons 'leaf (cdr x))))
 253             p-alist)))
 254
 255 (defun avy-tree-de-bruijn (lst keys)
 256   "Coerse LST into a tree.
 257 The degree of the tree is the length of KEYS.
 258 KEYS are placed on the internal nodes according to De Bruijn sequences.
 259 LST elements should be of the form ((BEG . END) WND)."
 260   ;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n
 261   ;; (the path length) usable as paths, thus that's the lower bound.  Due to
 262   ;; partially overlapping matches, not all subsequences may be usable, so it's
 263   ;; possible that the path-len must be incremented, e.g., if we're matching
 264   ;; for x and a buffer contains xaxbxcx only every second subsequence is
 265   ;; usable for the four matches.
 266   (let* ((path-len (ceiling (log (length lst) (length keys))))
 267          (path-alist (avy--path-alist-1 lst path-len keys)))
 268     (while (not path-alist)
 269       (cl-incf path-len)
 270       (setq path-alist (avy--path-alist-1 lst path-len keys)))
 271     (avy--path-alist-to-tree path-alist)))
 272
 273 (defun avy-tree (lst keys)
 274   "Coerce LST into a balanced tree.
 275 The degree of the tree is the length of KEYS.
 276 KEYS are placed appropriately on internal nodes."
 277   (let ((len (length keys)))
 278     (cl-labels
 279         ((rd (ls)
 280            (let ((ln (length ls)))
 281              (if (< ln len)
 282                  (cl-pairlis keys
 283                              (mapcar (lambda (x) (cons 'leaf x)) ls))
 284                (let ((ks (copy-sequence keys))
 285                      res)
 286                  (dolist (s (avy-subdiv ln len))
 287                    (push (cons (pop ks)
 288                                (if (eq s 1)
 289                                    (cons 'leaf (pop ls))
 290                                  (rd (avy-multipop ls s))))
 291                          res))
 292                  (nreverse res))))))
 293       (rd lst))))
 294
 295 (defun avy-subdiv (n b)
 296   "Distribute N in B terms in a balanced way."
 297   (let* ((p (1- (floor (+ (log n b) 1e-6))))
 298          (x1 (expt b p))
 299          (x2 (* b x1))
 300          (delta (- n x2))
 301          (n2 (/ delta (- x2 x1)))
 302          (n1 (- b n2 1)))
 303     (append
 304      (make-list n1 x1)
 305      (list
 306       (- n (* n1 x1) (* n2 x2)))
 307      (make-list n2 x2))))
 308
 309 (defun avy-traverse (tree walker &optional recur-key)
 310   "Traverse TREE generated by `avy-tree'.
 311 WALKER is a function that takes KEYS and LEAF.
 312
 313 RECUR-KEY is used in recursion.
 314
 315 LEAF is a member of LST argument of `avy-tree'.
 316
 317 KEYS is the path from the root of `avy-tree' to LEAF."
 318   (dolist (br tree)
 319     (let ((key (cons (car br) recur-key)))
 320       (if (eq (cadr br) 'leaf)
 321           (funcall walker key (cddr br))
 322         (avy-traverse (cdr br) walker key)))))
 323
 324 (defun avy-handler-default (char)
 325   "The default hander for a bad CHAR."
 326   (signal 'user-error (list "No such candidate" char))
 327   (throw 'done nil))
 328
 329 (defvar avy-handler-function 'avy-handler-default
 330   "A function to call for a bad `read-char' in `avy-read'.")
 331
 332 (defvar avy-current-path ""
 333   "Store the current incomplete path during `avy-read'.")
 334
 335 (defun avy-read (tree display-fn cleanup-fn)
 336   "Select a leaf from TREE using consecutive `read-char'.
 337
 338 DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
 339 associated with CHAR will be selected if CHAR is pressed.  This is
 340 commonly done by adding a CHAR overlay at LEAF position.
 341
 342 CLEANUP-FN should take no arguments and remove the effects of
 343 multiple DISPLAY-FN invokations."
 344   (catch 'done
 345     (setq avy-current-path "")
 346     (while tree
 347       (let ((avy--leafs nil))
 348         (avy-traverse tree
 349                       (lambda (path leaf)
 350                         (push (cons path leaf) avy--leafs)))
 351         (dolist (x avy--leafs)
 352           (funcall display-fn (car x) (cdr x))))
 353       (let ((char (read-char))
 354             branch)
 355         (funcall cleanup-fn)
 356         (if (setq branch (assoc char tree))
 357             (if (eq (car (setq tree (cdr branch))) 'leaf)
 358                 (throw 'done (cdr tree))
 359               (setq avy-current-path
 360                     (concat avy-current-path (string char))))
 361           (funcall avy-handler-function char))))))
 362
 363 ;;** Rest
 364 (defun avy-window-list ()
 365   "Return a list of windows depending on `avy-all-windows'."
 366   (cond ((eq avy-all-windows 'all-frames)
 367          (cl-mapcan #'window-list (frame-list)))
 368
 369         ((eq avy-all-windows t)
 370          (window-list))
 371
 372         ((null avy-all-windows)
 373          (list (selected-window)))
 374
 375         (t
 376          (error "Unrecognized option: %S" avy-all-windows))))
 377
 378 (defmacro avy-dowindows (flip &rest body)
 379   "Depending on FLIP and `avy-all-windows' run BODY in each or selected window."
 380   (declare (indent 1)
 381            (debug (form body)))
 382   `(let ((avy-all-windows (if ,flip
 383                               (not avy-all-windows)
 384                             avy-all-windows)))
 385      (dolist (wnd (avy-window-list))
 386        (with-selected-window wnd
 387          (unless (memq major-mode '(image-mode doc-view-mode))
 388            ,@body)))))
 389
 390 (defmacro avy--with-avy-keys (command &rest body)
 391   "Set `avy-keys' according to COMMAND and execute BODY."
 392   (declare (indent 1)
 393            (debug (form body)))
 394   `(let ((avy-keys (or (cdr (assq ',command avy-keys-alist))
 395                        avy-keys))
 396          (avy-style (or (cdr (assq ',command avy-styles-alist))
 397                         avy-style)))
 398      ,@body))
 399
 400 (defun avy--goto (x)
 401   "Goto X.
 402 X is (POS . WND)
 403 POS is either a position or (BEG . END)."
 404   (cond ((null x)
 405          (message "zero candidates"))
 406
 407         ;; ignore exit from `avy-handler-function'
 408         ((eq x 'exit))
 409
 410         (t
 411          (select-window (cdr x))
 412          (let ((pt (car x)))
 413            (when (consp pt)
 414              (setq pt (car pt)))
 415            (unless (= pt (point)) (push-mark))
 416            (goto-char pt)))))
 417
 418 (defun avy--process (candidates overlay-fn)
 419   "Select one of CANDIDATES using `avy-read'.
 420 Use OVERLAY-FN to visualize the decision overlay."
 421   (unwind-protect
 422        (cl-case (length candidates)
 423          (0
 424           nil)
 425          (1
 426           (car candidates))
 427          (t
 428           (avy--make-backgrounds
 429            (avy-window-list))
 430           (avy-read (if (eq avy-style 'de-bruijn)
 431                         (avy-tree-de-bruijn candidates avy-keys)
 432                       (avy-tree candidates avy-keys))
 433                     overlay-fn
 434                     #'avy--remove-leading-chars)))
 435     (avy--done)))
 436
 437 (defvar avy--overlays-back nil
 438   "Hold overlays for when `avy-background' is t.")
 439
 440 (defun avy--make-backgrounds (wnd-list)
 441   "Create a dim background overlay for each window on WND-LIST."
 442   (when avy-background
 443     (setq avy--overlays-back
 444           (mapcar (lambda (w)
 445                     (let ((ol (make-overlay
 446                                (window-start w)
 447                                (window-end w)
 448                                (window-buffer w))))
 449                       (overlay-put ol 'face 'avy-background-face)
 450                       (overlay-put ol 'window w)
 451                       ol))
 452                   wnd-list))))
 453
 454 (defun avy--done ()
 455   "Clean up overlays."
 456   (mapc #'delete-overlay avy--overlays-back)
 457   (setq avy--overlays-back nil)
 458   (avy--remove-leading-chars))
 459
 460 (defun avy--regex-candidates (regex &optional beg end pred group)
 461   "Return all elements that match REGEX.
 462 Each element of the list is ((BEG . END) . WND)
 463 When PRED is non-nil, it's a filter for matching point positions.
 464 When GROUP is non-nil, (BEG . END) should delimit that regex group."
 465   (setq group (or group 0))
 466   (let ((case-fold-search avy-case-fold-search)
 467         candidates)
 468     (avy-dowindows nil
 469       (let ((we (or end (window-end (selected-window) t))))
 470         (save-excursion
 471           (goto-char (or beg (window-start)))
 472           (while (re-search-forward regex we t)
 473             (unless (get-char-property (point) 'invisible)
 474               (when (or (null pred)
 475                         (funcall pred))
 476                 (push (cons (cons (match-beginning group)
 477                                   (match-end group))
 478                             wnd) candidates)))))))
 479     (nreverse candidates)))
 480
 481 (defvar avy--overlay-offset 0
 482   "The offset to apply in `avy--overlay'.")
 483
 484 (defvar avy--overlays-lead nil
 485   "Hold overlays for leading chars.")
 486
 487 (defun avy--remove-leading-chars ()
 488   "Remove leading char overlays."
 489   (mapc #'delete-overlay avy--overlays-lead)
 490   (setq avy--overlays-lead nil))
 491
 492 (defun avy--overlay (str pt wnd)
 493   "Create an overlay with STR at PT in WND."
 494   (when (<= (1+ pt) (with-selected-window wnd (point-max)))
 495     (let* ((pt (+ pt avy--overlay-offset))
 496            (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
 497            (old-str (with-selected-window wnd
 498                       (buffer-substring pt (1+ pt)))))
 499       (when avy-background
 500         (setq old-str (propertize
 501                        old-str 'face 'avy-background-face)))
 502       (overlay-put ol 'window wnd)
 503       (overlay-put ol 'display (concat str old-str))
 504       (push ol avy--overlays-lead))))
 505
 506 (defcustom avy-highlight-first nil
 507   "When non-nil highlight the first decision char with `avy-lead-face-0'.
 508 Do this even when the char is terminating."
 509   :type 'boolean)
 510
 511 (defun avy--overlay-pre (path leaf)
 512   "Create an overlay with PATH at LEAF.
 513 PATH is a list of keys from tree root to LEAF.
 514 LEAF is normally ((BEG . END) . WND)."
 515   (let ((str (propertize (apply #'string (reverse path))
 516                          'face 'avy-lead-face)))
 517     (when (or avy-highlight-first (> (length str) 1))
 518       (set-text-properties 0 1 '(face avy-lead-face-0) str))
 519     (setq str (concat
 520                (propertize avy-current-path
 521                            'face 'avy-lead-face-1)
 522                str))
 523     (avy--overlay
 524      str
 525      (cond ((numberp leaf)
 526             leaf)
 527            ((consp (car leaf))
 528             (caar leaf))
 529            (t
 530             (car leaf)))
 531      (if (consp leaf)
 532          (cdr leaf)
 533        (selected-window)))))
 534
 535 (defun avy--overlay-at (path leaf)
 536   "Create an overlay with PATH at LEAF.
 537 PATH is a list of keys from tree root to LEAF.
 538 LEAF is normally ((BEG . END) . WND)."
 539   (let ((str (propertize
 540               (string (car (last path)))
 541               'face 'avy-lead-face))
 542         (pt (+ (if (consp (car leaf))
 543                    (caar leaf)
 544                  (car leaf))
 545                avy--overlay-offset))
 546         (wnd (cdr leaf)))
 547     (let ((ol (make-overlay pt (1+ pt)
 548                             (window-buffer wnd)))
 549           (old-str (with-selected-window wnd
 550                      (buffer-substring pt (1+ pt)))))
 551       (when avy-background
 552         (setq old-str (propertize
 553                        old-str 'face 'avy-background-face)))
 554       (overlay-put ol 'window wnd)
 555       (overlay-put ol 'display (if (string= old-str "\n")
 556                                    (concat str "\n")
 557                                  str))
 558       (push ol avy--overlays-lead))))
 559
 560 (defun avy--overlay-at-full (path leaf)
 561   "Create an overlay with PATH at LEAF.
 562 PATH is a list of keys from tree root to LEAF.
 563 LEAF is normally ((BEG . END) . WND)."
 564   (let* ((str (propertize
 565                (apply #'string (reverse path))
 566                'face 'avy-lead-face))
 567          (len (length path))
 568          (beg (if (consp (car leaf))
 569                   (caar leaf)
 570                 (car leaf)))
 571          (wnd (cdr leaf)))
 572     (when (or avy-highlight-first (> (length str) 1))
 573       (set-text-properties 0 1 '(face avy-lead-face-0) str))
 574     (with-selected-window wnd
 575       (save-excursion
 576         (goto-char beg)
 577         (when (cl-some (lambda (o)
 578                          (and (eq (overlay-get o 'category) 'avy)
 579                               (eq (overlay-get o 'window) wnd)))
 580                        (overlays-in (point) (min (+ (point) len)
 581                                                  (line-end-position))))
 582           (setq str (substring str 0 1))
 583           (setq len 1))
 584         (let ((other-ov (cl-find-if
 585                          (lambda (o)
 586                            (and (eq (overlay-get o 'category) 'avy)
 587                                 (eq (overlay-start o) beg)
 588                                 (not (eq (overlay-get o 'window) wnd))))
 589                          (overlays-in (point) (min (+ (point) len)
 590                                                    (line-end-position))))))
 591           (when (and other-ov
 592                      (> (overlay-end other-ov)
 593                         (+ beg len)))
 594             (setq str (concat str (buffer-substring
 595                                    (+ beg len)
 596                                    (overlay-end other-ov))))
 597             (setq len (- (overlay-end other-ov)
 598                          beg))))
 599         (let* ((end (if (= beg (line-end-position))
 600                         (1+ beg)
 601                       (min (+ beg
 602                               (if (eq (char-after) ?\t)
 603                                   1
 604                                 len))
 605                            (line-end-position))))
 606                (ol (make-overlay
 607                     beg end
 608                     (current-buffer)))
 609                (old-str (buffer-substring beg (1+ beg))))
 610           (when avy-background
 611             (setq old-str (propertize
 612                            old-str 'face 'avy-background-face)))
 613           (overlay-put ol 'window wnd)
 614           (overlay-put ol 'category 'avy)
 615           (overlay-put ol 'display
 616                        (cond ((string= old-str "\n")
 617                               (concat str "\n"))
 618                              ((string= old-str "\t")
 619                               (concat str (make-string (- tab-width len) ?\ )))
 620                              (t
 621                               str)))
 622           (push ol avy--overlays-lead))))))
 623
 624 (defun avy--overlay-post (path leaf)
 625   "Create an overlay with PATH at LEAF.
 626 PATH is a list of keys from tree root to LEAF.
 627 LEAF is normally ((BEG . END) . WND)."
 628   (let ((str (propertize (apply #'string (reverse path))
 629                          'face 'avy-lead-face)))
 630     (when (or avy-highlight-first (> (length str) 1))
 631       (set-text-properties 0 1 '(face avy-lead-face-0) str))
 632     (setq str (concat
 633                (propertize avy-current-path
 634                            'face 'avy-lead-face-1)
 635                str))
 636     (avy--overlay
 637      str
 638      (cond ((numberp leaf)
 639             leaf)
 640            ((consp (car leaf))
 641             (cdar leaf))
 642            (t
 643             (car leaf)))
 644      (if (consp leaf)
 645          (cdr leaf)
 646        (selected-window)))))
 647
 648 (defun avy--style-fn (style)
 649   "Transform STYLE symbol to a style function."
 650   (cl-case style
 651     (pre #'avy--overlay-pre)
 652     (at #'avy--overlay-at)
 653     (at-full 'avy--overlay-at-full)
 654     (post #'avy--overlay-post)
 655     (de-bruijn #'avy--overlay-at-full)
 656     (t (error "Unexpected style %S" style))))
 657
 658 (defun avy--generic-jump (regex window-flip style)
 659   "Jump to REGEX.
 660 When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
 661 STYLE determines the leading char overlay style."
 662   (let ((avy-all-windows
 663          (if window-flip
 664              (not avy-all-windows)
 665            avy-all-windows)))
 666     (avy--goto
 667      (avy--process
 668       (avy--regex-candidates regex)
 669       (avy--style-fn style)))))
 670
 671 ;;* Commands
 672 ;;;###autoload
 673 (defun avy-goto-char (char &optional arg)
 674   "Jump to the currently visible CHAR.
 675 The window scope is determined by `avy-all-windows' (ARG negates it)."
 676   (interactive (list (read-char "char: ")
 677                      current-prefix-arg))
 678   (avy--with-avy-keys avy-goto-char
 679     (avy--generic-jump
 680      (if (= 13 char)
 681          "\n"
 682        (regexp-quote (string char)))
 683      arg
 684      avy-style)))
 685
 686 ;;;###autoload
 687 (defun avy-goto-char-in-line (char &optional arg)
 688   "Jump to the currently visible CHAR in the current line.
 689 The window scope is determined by `avy-all-windows' (ARG negates it)."
 690   (interactive (list (read-char "char: ")
 691                      current-prefix-arg))
 692   (let ((avy-all-windows
 693          (if arg
 694              (not avy-all-windows)
 695            avy-all-windows)))
 696     (avy--with-avy-keys avy-goto-char
 697       (avy--goto
 698        (avy--process
 699         (save-restriction
 700           (narrow-to-region (line-beginning-position)
 701                             (line-end-position))
 702           (avy--regex-candidates (string char)))
 703         (avy--style-fn avy-style))))))
 704
 705 ;;;###autoload
 706 (defun avy-goto-char-2 (char1 char2 &optional arg)
 707   "Jump to the currently visible CHAR1 followed by CHAR2.
 708 The window scope is determined by `avy-all-windows' (ARG negates it)."
 709   (interactive (list (read-char "char 1: ")
 710                      (read-char "char 2: ")
 711                      current-prefix-arg))
 712   (avy--with-avy-keys avy-goto-char-2
 713     (avy--generic-jump
 714      (regexp-quote (string char1 char2))
 715      arg
 716      avy-style)))
 717
 718 ;;;###autoload
 719 (defun avy-isearch ()
 720   "Jump to one of the current isearch candidates."
 721   (interactive)
 722   (avy--with-avy-keys avy-isearch
 723     (let* ((candidates
 724             (avy--regex-candidates isearch-string))
 725            (avy-background nil)
 726            (candidate
 727             (avy--process candidates #'avy--overlay-post)))
 728       (isearch-done)
 729       (avy--goto candidate))))
 730
 731 ;;;###autoload
 732 (defun avy-goto-word-0 (arg)
 733   "Jump to a word start.
 734 The window scope is determined by `avy-all-windows' (ARG negates it)."
 735   (interactive "P")
 736   (avy--with-avy-keys avy-goto-word-0
 737     (avy--generic-jump "\\b\\sw" arg avy-style)))
 738
 739 ;;;###autoload
 740 (defun avy-goto-word-1 (char &optional arg)
 741   "Jump to the currently visible CHAR at a word start.
 742 The window scope is determined by `avy-all-windows' (ARG negates it)."
 743   (interactive (list (read-char "char: ")
 744                      current-prefix-arg))
 745   (avy--with-avy-keys avy-goto-word-1
 746     (let* ((str (string char))
 747            (regex (cond ((string= str ".")
 748                          "\\.")
 749                         ((and avy-word-punc-regexp
 750                               (string-match avy-word-punc-regexp str))
 751                          str)
 752                         (t
 753                          (concat
 754                           "\\b"
 755                           str)))))
 756       (avy--generic-jump regex arg avy-style))))
 757
 758 (declare-function subword-backward "subword")
 759
 760 ;;;###autoload
 761 (defun avy-goto-subword-0 (&optional arg predicate)
 762   "Jump to a word or subword start.
 763
 764 The window scope is determined by `avy-all-windows' (ARG negates it).
 765
 766 When PREDICATE is non-nil it's a function of zero parameters that
 767 should return true."
 768   (interactive "P")
 769   (require 'subword)
 770   (avy--with-avy-keys avy-goto-subword-0
 771     (let ((case-fold-search nil)
 772           candidates)
 773       (avy-dowindows arg
 774         (let ((ws (window-start))
 775               window-cands)
 776           (save-excursion
 777             (goto-char (window-end (selected-window) t))
 778             (subword-backward)
 779             (while (> (point) ws)
 780               (when (or (null predicate)
 781                         (and predicate (funcall predicate)))
 782                 (push (cons (point) (selected-window)) window-cands))
 783               (subword-backward)))
 784           (setq candidates (nconc candidates window-cands))))
 785       (avy--goto
 786        (avy--process candidates (avy--style-fn avy-style))))))
 787
 788 ;;;###autoload
 789 (defun avy-goto-subword-1 (char arg)
 790   "Jump to the currently visible CHAR at a subword start.
 791 The window scope is determined by `avy-all-windows' (ARG negates it).
 792 The case of CHAR is ignored."
 793   (interactive (list (read-char "char: ")
 794                      current-prefix-arg))
 795   (avy--with-avy-keys avy-goto-subword-1
 796     (let ((char (downcase char)))
 797       (avy-goto-subword-0
 798        arg (lambda () (eq (downcase (char-after)) char))))))
 799
 800 (defun avy-goto-word-or-subword-1 ()
 801   "Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
 802 Which one depends on variable `subword-mode'."
 803   (interactive)
 804   (if (bound-and-true-p subword-mode)
 805       (call-interactively #'avy-goto-subword-1)
 806     (call-interactively #'avy-goto-word-1)))
 807
 808 (defun avy--line (&optional arg)
 809   "Select a line.
 810 The window scope is determined by `avy-all-windows' (ARG negates it)."
 811   (let ((avy-background nil)
 812         candidates)
 813     (avy-dowindows arg
 814       (let ((ws (window-start)))
 815         (save-excursion
 816           (save-restriction
 817             (narrow-to-region ws (window-end (selected-window) t))
 818             (goto-char (point-min))
 819             (while (< (point) (point-max))
 820               (unless (get-char-property
 821                        (max (1- (point)) ws) 'invisible)
 822                 (push (cons
 823                        (if (eq avy-style 'post)
 824                            (line-end-position)
 825                          (line-beginning-position))
 826                        (selected-window)) candidates))
 827               (forward-line 1))))))
 828     (avy--process (nreverse candidates) (avy--style-fn avy-style))))
 829
 830 ;;;###autoload
 831 (defun avy-goto-line (&optional arg)
 832   "Jump to a line start in current buffer.
 833 The window scope is determined by `avy-all-windows' (ARG negates it)."
 834   (interactive "P")
 835   (avy--with-avy-keys avy-goto-line
 836     (let ((avy-handler-function
 837            (lambda (char)
 838              (if (or (< char ?0)
 839                      (> char ?9))
 840                  (avy-handler-default char)
 841                (let ((line (read-from-minibuffer
 842                             "Goto line: " (string char))))
 843                  (when line
 844                    (goto-char (point-min))
 845                    (forward-line (1- (string-to-number line)))
 846                    (throw 'done 'exit)))))))
 847       (avy--goto (avy--line arg)))))
 848
 849 ;;;###autoload
 850 (defun avy-copy-line (arg)
 851   "Copy a selected line above the current line.
 852 ARG lines can be used."
 853   (interactive "p")
 854   (avy--with-avy-keys avy-copy-line
 855     (let ((start (car (avy--line))))
 856       (move-beginning-of-line nil)
 857       (save-excursion
 858         (insert
 859          (buffer-substring-no-properties
 860           start
 861           (save-excursion
 862             (goto-char start)
 863             (move-end-of-line arg)
 864             (point)))
 865          "\n")))))
 866
 867 ;;;###autoload
 868 (defun avy-move-line (arg)
 869   "Move a selected line above the current line.
 870 ARG lines can be used."
 871   (interactive "p")
 872   (avy--with-avy-keys avy-move-line
 873     (let ((start (car (avy--line))))
 874       (move-beginning-of-line nil)
 875       (save-excursion
 876         (save-excursion
 877           (goto-char start)
 878           (kill-whole-line arg))
 879         (insert
 880          (current-kill 0))))))
 881
 882 ;;;###autoload
 883 (defun avy-copy-region ()
 884   "Select two lines and copy the text between them here."
 885   (interactive)
 886   (avy--with-avy-keys avy-copy-region
 887     (let ((beg (car (avy--line)))
 888           (end (car (avy--line)))
 889           (pad (if (bolp) "" "\n")))
 890       (move-beginning-of-line nil)
 891       (save-excursion
 892         (insert
 893          (buffer-substring-no-properties
 894           beg
 895           (save-excursion
 896             (goto-char end)
 897             (line-end-position)))
 898          pad)))))
 899
 900 ;;;###autoload
 901 (defun avy-setup-default ()
 902   "Setup the default shortcuts."
 903   (eval-after-load "isearch"
 904     '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
 905
 906 (defcustom avy-timeout-seconds 0.5
 907   "How many seconds to wait for the second char.")
 908
 909 ;;;###autoload
 910 (defun avy-goto-char-timer (&optional arg)
 911   "Read one or two consecutive chars and jump to the first one.
 912 The window scope is determined by `avy-all-windows' (ARG negates it)."
 913   (interactive "P")
 914   (let ((c1 (read-char "char 1: "))
 915         (c2 (read-char "char 2: " nil avy-timeout-seconds)))
 916     (avy--generic-jump
 917      (regexp-quote
 918       (if c2
 919           (string c1 c2)
 920         (string c1)))
 921      arg
 922      avy-style)))
 923
 924 (define-obsolete-variable-alias
 925     'avy-goto-char-style 'avy-style "0.1.0"
 926     "Use `avy-style' and `avy-styles-alist' instead.")
 927 (define-obsolete-variable-alias
 928     'avy-goto-word-style 'avy-style "0.1.0"
 929     "Use `avy-style' and `avy-styles-alist' instead.")
 930 (define-obsolete-variable-alias 'avi-keys 'avy-keys "0.1.0")
 931 (define-obsolete-variable-alias 'avi-background 'avy-background "0.1.0")
 932 (define-obsolete-variable-alias 'avi-word-punc-regexp 'avy-word-punc-regexp "0.1.0")
 933 (define-obsolete-face-alias 'avi-lead-face 'avy-lead-face "0.1.0")
 934 (define-obsolete-function-alias 'avi--goto 'avy--goto "0.1.0")
 935 (define-obsolete-function-alias 'avi--process 'avy--process "0.1.0")
 936 (define-obsolete-variable-alias 'avi-all-windows 'avy-all-windows "0.1.0")
 937 (define-obsolete-function-alias 'avi--overlay-pre 'avy--overlay-pre "0.1.0")
 938 (define-obsolete-function-alias 'avi--overlay-at 'avy--overlay-at "0.1.0")
 939 (define-obsolete-function-alias 'avi--overlay-post 'avy--overlay-post "0.1.0")
 940 (define-obsolete-function-alias 'avi-goto-char 'avy-goto-char "0.1.0")
 941 (define-obsolete-function-alias 'avi-goto-char-2 'avy-goto-char-2 "0.1.0")
 942 (define-obsolete-function-alias 'avi-isearch 'avy-isearch "0.1.0")
 943 (define-obsolete-function-alias 'avi-goto-word-0 'avy-goto-word-0 "0.1.0")
 944 (define-obsolete-function-alias 'avi-goto-subword-0 'avy-goto-subword-0 "0.1.0")
 945 (define-obsolete-function-alias 'avi-goto-word-1 'avy-goto-word-1 "0.1.0")
 946 (define-obsolete-function-alias 'avi-goto-line 'avy-goto-line "0.1.0")
 947 (define-obsolete-function-alias 'avi-copy-line 'avy-copy-line "0.1.0")
 948 (define-obsolete-function-alias 'avi-move-line 'avy-move-line "0.1.0")
 949 (define-obsolete-function-alias 'avi-copy-region 'avy-copy-region "0.1.0")
 950 (define-obsolete-function-alias 'avi--regex-candidates 'avy--regex-candidates "0.1.0")
 951
 952 (provide 'avy)
 953
 954 ;;; avy.el ends here