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