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