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                                ;; add padding for wide-width character
 653                                (if (eq (string-width old-str) 2)
 654                                    (concat str " ")
 655                                  str)))
 656     (push ol avy--overlays-lead)))
 657
 658 (defun avy--overlay-at-full (path leaf)
 659   "Create an overlay with PATH at LEAF.
 660 PATH is a list of keys from tree root to LEAF.
 661 LEAF is normally ((BEG . END) . WND)."
 662   (let* ((path (mapcar #'avy--key-to-char path))
 663          (str (propertize
 664                (apply #'string (reverse path))
 665                'face 'avy-lead-face))
 666          (len (length path))
 667          (beg (if (consp (car leaf))
 668                   (caar leaf)
 669                 (car leaf)))
 670          (wnd (cdr leaf))
 671          oov)
 672     (dotimes (i len)
 673       (set-text-properties (- len i 1) (- len i)
 674                            `(face ,(nth i avy-lead-faces))
 675                            str))
 676     (when (eq avy-style 'de-bruijn)
 677       (setq str (concat
 678                  (propertize avy-current-path
 679                              'face 'avy-lead-face-1)
 680                  str))
 681       (setq len (length str)))
 682     (with-selected-window wnd
 683       (save-excursion
 684         (goto-char beg)
 685         (when (setq oov
 686                     (delq nil
 687                           (mapcar
 688                            (lambda (o)
 689                              (and (eq (overlay-get o 'category) 'avy)
 690                                   (eq (overlay-get o 'window) wnd)
 691                                   (overlay-start o)))
 692                            (overlays-in (point) (min (+ (point) len)
 693                                                      (line-end-position))))))
 694           (setq len (- (apply #'min oov) beg))
 695           (setq str (substring str 0 len)))
 696         (let ((other-ov (cl-find-if
 697                          (lambda (o)
 698                            (and (eq (overlay-get o 'category) 'avy)
 699                                 (eq (overlay-start o) beg)
 700                                 (not (eq (overlay-get o 'window) wnd))))
 701                          (overlays-in (point) (min (+ (point) len)
 702                                                    (line-end-position))))))
 703           (when (and other-ov
 704                      (> (overlay-end other-ov)
 705                         (+ beg len)))
 706             (setq str (concat str (buffer-substring
 707                                    (+ beg len)
 708                                    (overlay-end other-ov))))
 709             (setq len (- (overlay-end other-ov)
 710                          beg))))
 711         (let* ((end (if (= beg (line-end-position))
 712                         (1+ beg)
 713                       (min (+ beg
 714                               (if (eq (char-after) ?\t)
 715                                   1
 716                                 len))
 717                            (line-end-position))))
 718                (ol (make-overlay
 719                     beg end
 720                     (current-buffer)))
 721                (old-str (buffer-substring beg (1+ beg))))
 722           (when avy-background
 723             (setq old-str (propertize
 724                            old-str 'face 'avy-background-face)))
 725           (overlay-put ol 'window wnd)
 726           (overlay-put ol 'category 'avy)
 727           (overlay-put ol 'display
 728                        (cond ((string= old-str "\n")
 729                               (concat str "\n"))
 730                              ((string= old-str "\t")
 731                               (concat str (make-string (- tab-width len) ?\ )))
 732                              (t
 733                               ;; add padding for wide-width character
 734                               (if (eq (string-width old-str) 2)
 735                                   (concat str " ")
 736                                 str))))
 737           (push ol avy--overlays-lead))))))
 738
 739 (defun avy--overlay-post (path leaf)
 740   "Create an overlay with PATH at LEAF.
 741 PATH is a list of keys from tree root to LEAF.
 742 LEAF is normally ((BEG . END) . WND)."
 743   (let* ((path (mapcar #'avy--key-to-char path))
 744          (str (propertize (apply #'string (reverse path))
 745                           'face 'avy-lead-face)))
 746     (when (or avy-highlight-first (> (length str) 1))
 747       (set-text-properties 0 1 '(face avy-lead-face-0) str))
 748     (setq str (concat
 749                (propertize avy-current-path
 750                            'face 'avy-lead-face-1)
 751                str))
 752     (avy--overlay
 753      str
 754      (cond ((numberp leaf)
 755             leaf)
 756            ((consp (car leaf))
 757             (cdar leaf))
 758            (t
 759             (car leaf)))
 760      (if (consp leaf)
 761          (cdr leaf)
 762        (selected-window)))))
 763
 764 (defun avy--style-fn (style)
 765   "Transform STYLE symbol to a style function."
 766   (cl-case style
 767     (pre #'avy--overlay-pre)
 768     (at #'avy--overlay-at)
 769     (at-full 'avy--overlay-at-full)
 770     (post #'avy--overlay-post)
 771     (de-bruijn #'avy--overlay-at-full)
 772     (t (error "Unexpected style %S" style))))
 773
 774 (defun avy--generic-jump (regex window-flip style &optional beg end)
 775   "Jump to REGEX.
 776 When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
 777 STYLE determines the leading char overlay style.
 778 BEG and END delimit the area where candidates are searched."
 779   (let ((avy-all-windows
 780          (if window-flip
 781              (not avy-all-windows)
 782            avy-all-windows)))
 783     (avy--process
 784      (avy--regex-candidates regex beg end)
 785      (avy--style-fn style))))
 786
 787 ;;* Commands
 788 ;;;###autoload
 789 (defun avy-goto-char (char &optional arg)
 790   "Jump to the currently visible CHAR.
 791 The window scope is determined by `avy-all-windows' (ARG negates it)."
 792   (interactive (list (read-char "char: " t)
 793                      current-prefix-arg))
 794   (avy-with avy-goto-char
 795     (avy--generic-jump
 796      (if (= 13 char)
 797          "\n"
 798        (regexp-quote (string char)))
 799      arg
 800      avy-style)))
 801
 802 ;;;###autoload
 803 (defun avy-goto-char-in-line (char)
 804   "Jump to the currently visible CHAR in the current line."
 805   (interactive (list (read-char "char: " t)))
 806   (avy-with avy-goto-char
 807     (avy--generic-jump
 808      (regexp-quote (string char))
 809      avy-all-windows
 810      avy-style
 811      (line-beginning-position)
 812      (line-end-position))))
 813
 814 ;;;###autoload
 815 (defun avy-goto-char-2 (char1 char2 &optional arg)
 816   "Jump to the currently visible CHAR1 followed by CHAR2.
 817 The window scope is determined by `avy-all-windows' (ARG negates it)."
 818   (interactive (list (read-char "char 1: " t)
 819                      (read-char "char 2: " t)
 820                      current-prefix-arg))
 821   (avy-with avy-goto-char-2
 822     (avy--generic-jump
 823      (regexp-quote (string char1 char2))
 824      arg
 825      avy-style)))
 826
 827 ;;;###autoload
 828 (defun avy-isearch ()
 829   "Jump to one of the current isearch candidates."
 830   (interactive)
 831   (avy-with avy-isearch
 832     (let ((avy-background nil))
 833       (avy--process
 834        (avy--regex-candidates isearch-string)
 835        (avy--style-fn avy-style))
 836       (isearch-done))))
 837
 838 ;;;###autoload
 839 (defun avy-goto-word-0 (arg)
 840   "Jump to a word start.
 841 The window scope is determined by `avy-all-windows' (ARG negates it)."
 842   (interactive "P")
 843   (avy-with avy-goto-word-0
 844     (avy--generic-jump "\\b\\sw" arg avy-style)))
 845
 846 ;;;###autoload
 847 (defun avy-goto-word-1 (char &optional arg)
 848   "Jump to the currently visible CHAR at a word start.
 849 The window scope is determined by `avy-all-windows' (ARG negates it)."
 850   (interactive (list (read-char "char: " t)
 851                      current-prefix-arg))
 852   (avy-with avy-goto-word-1
 853     (let* ((str (string char))
 854            (regex (cond ((string= str ".")
 855                          "\\.")
 856                         ((and avy-word-punc-regexp
 857                               (string-match avy-word-punc-regexp str))
 858                          (regexp-quote str))
 859                         (t
 860                          (concat
 861                           "\\b"
 862                           str)))))
 863       (avy--generic-jump regex arg avy-style))))
 864
 865 (declare-function subword-backward "subword")
 866 (defvar subword-backward-regexp)
 867
 868 ;;;###autoload
 869 (defun avy-goto-subword-0 (&optional arg predicate)
 870   "Jump to a word or subword start.
 871
 872 The window scope is determined by `avy-all-windows' (ARG negates it).
 873
 874 When PREDICATE is non-nil it's a function of zero parameters that
 875 should return true."
 876   (interactive "P")
 877   (require 'subword)
 878   (avy-with avy-goto-subword-0
 879     (let ((case-fold-search nil)
 880           (subword-backward-regexp
 881            "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)")
 882           candidates)
 883       (avy-dowindows arg
 884         (let ((ws (window-start))
 885               window-cands)
 886           (save-excursion
 887             (goto-char (window-end (selected-window) t))
 888             (subword-backward)
 889             (while (> (point) ws)
 890               (when (or (null predicate)
 891                         (and predicate (funcall predicate)))
 892                 (unless (get-char-property (point) 'invisible)
 893                   (push (cons (point) (selected-window)) window-cands)))
 894               (subword-backward)))
 895           (setq candidates (nconc candidates window-cands))))
 896       (avy--process candidates (avy--style-fn avy-style)))))
 897
 898 ;;;###autoload
 899 (defun avy-goto-subword-1 (char &optional arg)
 900   "Jump to the currently visible CHAR at a subword start.
 901 The window scope is determined by `avy-all-windows' (ARG negates it).
 902 The case of CHAR is ignored."
 903   (interactive (list (read-char "char: " t)
 904                      current-prefix-arg))
 905   (avy-with avy-goto-subword-1
 906     (let ((char (downcase char)))
 907       (avy-goto-subword-0
 908        arg (lambda () (eq (downcase (char-after)) char))))))
 909
 910 ;;;###autoload
 911 (defun avy-goto-word-or-subword-1 ()
 912   "Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
 913 Which one depends on variable `subword-mode'."
 914   (interactive)
 915   (if (bound-and-true-p subword-mode)
 916       (call-interactively #'avy-goto-subword-1)
 917     (call-interactively #'avy-goto-word-1)))
 918
 919 (defvar visual-line-mode)
 920
 921 (defun avy--line (&optional arg)
 922   "Select a line.
 923 The window scope is determined by `avy-all-windows' (ARG negates it)."
 924   (let (candidates)
 925     (avy-dowindows arg
 926       (let ((ws (window-start)))
 927         (save-excursion
 928           (save-restriction
 929             (narrow-to-region ws (window-end (selected-window) t))
 930             (goto-char (point-min))
 931             (while (< (point) (point-max))
 932               (unless (get-char-property
 933                        (max (1- (point)) ws) 'invisible)
 934                 (push (cons
 935                        (if (eq avy-style 'post)
 936                            (line-end-position)
 937                          (point))
 938                        (selected-window)) candidates))
 939               (if visual-line-mode
 940                   (ignore-errors
 941                     (line-move 1))
 942                 (forward-line 1)))))))
 943     (setq avy-action #'identity)
 944     (avy--process (nreverse candidates) (avy--style-fn avy-style))))
 945
 946 ;;;###autoload
 947 (defun avy-goto-line (&optional arg)
 948   "Jump to a line start in current buffer.
 949
 950 When ARG is 1, jump to lines currently visible, with the option
 951 to cancel to `goto-line' by entering a number.
 952
 953 When ARG is 4, negate the window scope determined by
 954 `avy-all-windows'.
 955
 956 Otherwise, forward to `goto-line' with ARG."
 957   (interactive "p")
 958   (if (not (memq arg '(1 4)))
 959       (progn
 960         (goto-char (point-min))
 961         (forward-line (1- arg)))
 962     (avy-with avy-goto-line
 963       (let* ((avy-handler-function
 964               (lambda (char)
 965                 (if (or (< char ?0)
 966                         (> char ?9))
 967                     (avy-handler-default char)
 968                   (let ((line (read-from-minibuffer
 969                                "Goto line: " (string char))))
 970                     (when line
 971                       (avy-push-mark)
 972                       (goto-char (point-min))
 973                       (forward-line (1- (string-to-number line)))
 974                       (throw 'done 'exit))))))
 975              (r (avy--line (eq arg 4))))
 976         (unless (eq r t)
 977           (avy-action-goto r))))))
 978
 979 ;;;###autoload
 980 (defun avy-copy-line (arg)
 981   "Copy a selected line above the current line.
 982 ARG lines can be used."
 983   (interactive "p")
 984   (avy-with avy-copy-line
 985     (let ((start (avy--line)))
 986       (move-beginning-of-line nil)
 987       (save-excursion
 988         (insert
 989          (buffer-substring-no-properties
 990           start
 991           (save-excursion
 992             (goto-char start)
 993             (move-end-of-line arg)
 994             (point)))
 995          "\n")))))
 996
 997 ;;;###autoload
 998 (defun avy-move-line (arg)
 999   "Move a selected line above the current line.
1000 ARG lines can be used."
1001   (interactive "p")
1002   (avy-with avy-move-line
1003     (let ((start (avy--line)))
1004       (move-beginning-of-line nil)
1005       (save-excursion
1006         (save-excursion
1007           (goto-char start)
1008           (kill-whole-line arg))
1009         (insert
1010          (current-kill 0))))))
1011
1012 ;;;###autoload
1013 (defun avy-copy-region ()
1014   "Select two lines and copy the text between them here."
1015   (interactive)
1016   (avy-with avy-copy-region
1017     (let ((beg (avy--line))
1018           (end (avy--line))
1019           (pad (if (bolp) "" "\n")))
1020       (move-beginning-of-line nil)
1021       (save-excursion
1022         (insert
1023          (buffer-substring-no-properties
1024           beg
1025           (save-excursion
1026             (goto-char end)
1027             (line-end-position)))
1028          pad)))))
1029
1030 ;;;###autoload
1031 (defun avy-setup-default ()
1032   "Setup the default shortcuts."
1033   (eval-after-load "isearch"
1034     '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
1035
1036 (defcustom avy-timeout-seconds 0.5
1037   "How many seconds to wait for the second char.")
1038
1039 (defun avy--read-string-timer ()
1040   "Read as many chars as possible and return them as string.
1041 At least one char must be read, and then repeatedly one next char
1042 may be read if it is entered before `avy-timeout-seconds'."
1043   (let ((str "") char)
1044     (while (setq char (read-char (format "char%s: "
1045                                          (if (string= str "")
1046                                              str
1047                                            (format " (%s)" str)))
1048                                  t
1049                                  (and (not (string= str ""))
1050                                       avy-timeout-seconds)))
1051       (setq str (concat str (list char))))
1052     str))
1053
1054 ;;;###autoload
1055 (defun avy-goto-char-timer (&optional arg)
1056   "Read one or many consecutive chars and jump to the first one.
1057 The window scope is determined by `avy-all-windows' (ARG negates it)."
1058   (interactive "P")
1059   (let ((str (avy--read-string-timer)))
1060     (avy-with avy-goto-char-timer
1061       (avy--generic-jump
1062        (regexp-quote str)
1063        arg
1064        avy-style))))
1065
1066 (defvar avy-ring (make-ring 20)
1067   "Hold the window and point history.")
1068
1069 (defun avy-push-mark ()
1070   "Store the current point and window."
1071   (ring-insert avy-ring
1072                (cons (point) (selected-window)))
1073   (unless (region-active-p)
1074     (push-mark)))
1075
1076 (defun avy-pop-mark ()
1077   "Jump back to the last location of `avy-push-mark'."
1078   (interactive)
1079   (let (res)
1080     (condition-case nil
1081         (progn
1082           (while (not (window-live-p
1083                        (cdr (setq res (ring-remove avy-ring 0))))))
1084           (let* ((window (cdr res))
1085                  (frame (window-frame window)))
1086             (when (and (frame-live-p frame)
1087                        (not (eq frame (selected-frame))))
1088               (select-frame-set-input-focus frame))
1089             (select-window window)
1090             (goto-char (car res))))
1091       (error
1092        (set-mark-command 4)))))
1093
1094 (define-obsolete-function-alias
1095     'avy--goto 'identity "0.3.0"
1096     "Don't use this function any more.
1097 `avy--process' will do the jump all by itself.")
1098
1099 (define-obsolete-function-alias 'avy--with-avy-keys 'avy-with "0.3.0")
1100
1101 (provide 'avy)
1102
1103 ;;; avy.el ends here