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