avy.el (84809B)
1 ;;; avy.el --- Jump to arbitrary positions in visible text and select text quickly. -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. 4 5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com> 6 ;; URL: https://github.com/abo-abo/avy 7 ;; Package-Version: 20241101.1357 8 ;; Package-Revision: 933d1f36cca0 9 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) 10 ;; Keywords: point, location 11 12 ;; This file is part of GNU Emacs. 13 14 ;; This file is free software; you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation; either version 3, or (at your option) 17 ;; any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; For a full copy of the GNU General Public License 25 ;; see <http://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 ;; 29 ;; With Avy, you can move point to any position in Emacs – even in a 30 ;; different window – using very few keystrokes. For this, you look at 31 ;; the position where you want point to be, invoke Avy, and then enter 32 ;; the sequence of characters displayed at that position. 33 ;; 34 ;; If the position you want to jump to can be determined after only 35 ;; issuing a single keystroke, point is moved to the desired position 36 ;; immediately after that keystroke. In case this isn't possible, the 37 ;; sequence of keystrokes you need to enter is comprised of more than 38 ;; one character. Avy uses a decision tree where each candidate position 39 ;; is a leaf and each edge is described by a character which is distinct 40 ;; per level of the tree. By entering those characters, you navigate the 41 ;; tree, quickly arriving at the desired candidate position, such that 42 ;; Avy can move point to it. 43 ;; 44 ;; Note that this only makes sense for positions you are able to see 45 ;; when invoking Avy. These kinds of positions are supported: 46 ;; 47 ;; * character positions 48 ;; * word or subword start positions 49 ;; * line beginning positions 50 ;; * link positions 51 ;; * window positions 52 ;; 53 ;; If you're familiar with the popular `ace-jump-mode' package, this 54 ;; package does all that and more, without the implementation 55 ;; headache. 56 57 ;;; Code: 58 (require 'cl-lib) 59 (require 'ring) 60 61 ;;* Customization 62 (defgroup avy nil 63 "Jump to things tree-style." 64 :group 'convenience 65 :prefix "avy-") 66 67 (defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) 68 "Default keys for jumping. 69 Any key is either a character representing a self-inserting 70 key (letters, digits, punctuation, etc.) or a symbol denoting a 71 non-printing key like an arrow key (left, right, up, down). For 72 non-printing keys, a corresponding entry in 73 `avy-key-to-char-alist' must exist in order to visualize the key 74 in the avy overlays. 75 76 If `avy-style' is set to words, make sure there are at least three 77 keys different than the following: a, e, i, o, u, y" 78 :type '(repeat :tag "Keys" (choice 79 (character :tag "char") 80 (symbol :tag "non-printing key")))) 81 82 (defconst avy--key-type 83 '(choice :tag "Command" 84 (const avy-goto-char) 85 (const avy-goto-char-2) 86 (const avy-isearch) 87 (const avy-goto-line) 88 (const avy-goto-subword-0) 89 (const avy-goto-subword-1) 90 (const avy-goto-word-0) 91 (const avy-goto-word-1) 92 (const avy-copy-line) 93 (const avy-copy-region) 94 (const avy-move-line) 95 (const avy-move-region) 96 (const avy-kill-whole-line) 97 (const avy-kill-region) 98 (const avy-kill-ring-save-whole-line) 99 (const avy-kill-ring-save-region) 100 (function :tag "Other command"))) 101 102 (defcustom avy-keys-alist nil 103 "Alist of `avy-jump' commands to `avy-keys' overriding the default `avy-keys'." 104 :type `(alist 105 :key-type ,avy--key-type 106 :value-type (repeat :tag "Keys" character))) 107 108 (defcustom avy-orders-alist '((avy-goto-char . avy-order-closest)) 109 "Alist of candidate ordering functions. 110 Usually, candidates appear in their point position order." 111 :type `(alist 112 :key-type ,avy--key-type 113 :value-type function)) 114 115 (defcustom avy-words 116 '("am" "by" "if" "is" "it" "my" "ox" "up" 117 "ace" "act" "add" "age" "ago" "aim" "air" "ale" "all" "and" "ant" "any" 118 "ape" "apt" "arc" "are" "arm" "art" "ash" "ate" "awe" "axe" "bad" "bag" 119 "ban" "bar" "bat" "bay" "bed" "bee" "beg" "bet" "bid" "big" "bit" "bob" 120 "bot" "bow" "box" "boy" "but" "cab" "can" "cap" "car" "cat" "cog" "cop" 121 "cow" "cry" "cup" "cut" "day" "dew" "did" "die" "dig" "dim" "dip" "dog" 122 "dot" "dry" "dub" "dug" "dye" "ear" "eat" "eel" "egg" "ego" "elf" "eve" 123 "eye" "fan" "far" "fat" "fax" "fee" "few" "fin" "fit" "fix" "flu" "fly" 124 "foe" "fog" "for" "fox" "fry" "fun" "fur" "gag" "gap" "gas" "gel" "gem" 125 "get" "gig" "gin" "gnu" "god" "got" "gum" "gun" "gut" "guy" "gym" "had" 126 "hag" "ham" "has" "hat" "her" "hid" "him" "hip" "his" "hit" "hop" "hot" 127 "how" "hub" "hue" "hug" "hut" "ice" "icy" "imp" "ink" "inn" "ion" "ire" 128 "ivy" "jab" "jam" "jar" "jaw" "jet" "job" "jog" "joy" "key" "kid" "kit" 129 "lag" "lap" "lay" "let" "lid" "lie" "lip" "lit" "lob" "log" "lot" "low" 130 "mad" "man" "map" "mat" "may" "men" "met" "mix" "mob" "mop" "mud" "mug" 131 "nag" "nap" "new" "nil" "nod" "nor" "not" "now" "nun" "oak" "odd" "off" 132 "oil" "old" "one" "orb" "ore" "ork" "our" "out" "owl" "own" "pad" "pan" 133 "par" "pat" "paw" "pay" "pea" "pen" "pet" "pig" "pin" "pit" "pod" "pot" 134 "pry" "pub" "pun" "put" "rag" "ram" "ran" "rat" "raw" "ray" "red" "rib" 135 "rim" "rip" "rob" "rod" "rot" "row" "rub" "rug" "rum" "run" "sad" "sat" 136 "saw" "say" "sea" "see" "sew" "she" "shy" "sin" "sip" "sit" "six" "ski" 137 "sky" "sly" "sob" "son" "soy" "spy" "sum" "sun" "tab" "tad" "tag" "tan" 138 "tap" "tar" "tax" "tea" "the" "tie" "tin" "tip" "toe" "ton" "too" "top" 139 "toy" "try" "tub" "two" "urn" "use" "van" "war" "was" "wax" "way" "web" 140 "wed" "wet" "who" "why" "wig" "win" "wit" "woe" "won" "wry" "you" "zap" 141 "zip" "zoo") 142 "Words to use in case `avy-style' is set to `words'. 143 Every word should contain at least one vowel i.e. one of the following 144 characters: a, e, i, o, u, y 145 They do not have to be sorted but no word should be a prefix of another one." 146 :type '(repeat string)) 147 148 (defcustom avy-style 'at-full 149 "The default method of displaying the overlays. 150 Use `avy-styles-alist' to customize this per-command." 151 :type '(choice 152 (const :tag "Pre" pre) 153 (const :tag "At" at) 154 (const :tag "At Full" at-full) 155 (const :tag "Post" post) 156 (const :tag "De Bruijn" de-bruijn) 157 (const :tag "Words" words))) 158 159 (defcustom avy-styles-alist nil 160 "Alist of `avy-jump' commands to the style for each command. 161 If the commands isn't on the list, `avy-style' is used." 162 :type '(alist 163 :key-type (choice :tag "Command" 164 (const avy-goto-char) 165 (const avy-goto-char-2) 166 (const avy-isearch) 167 (const avy-goto-line) 168 (const avy-goto-subword-0) 169 (const avy-goto-subword-1) 170 (const avy-goto-word-0) 171 (const avy-goto-word-1) 172 (const avy-copy-line) 173 (const avy-copy-region) 174 (const avy-move-line) 175 (const avy-move-region) 176 (const avy-kill-whole-line) 177 (const avy-kill-region) 178 (const avy-kill-ring-save-whole-line) 179 (const avy-kill-ring-save-region) 180 (function :tag "Other command")) 181 :value-type (choice 182 (const :tag "Pre" pre) 183 (const :tag "At" at) 184 (const :tag "At Full" at-full) 185 (const :tag "Post" post) 186 (const :tag "De Bruijn" de-bruijn) 187 (const :tag "Words" words)))) 188 189 (defcustom avy-dispatch-alist 190 '((?x . avy-action-kill-move) 191 (?X . avy-action-kill-stay) 192 (?t . avy-action-teleport) 193 (?m . avy-action-mark) 194 (?n . avy-action-copy) 195 (?y . avy-action-yank) 196 (?Y . avy-action-yank-line) 197 (?i . avy-action-ispell) 198 (?z . avy-action-zap-to-char)) 199 "List of actions for `avy-handler-default'. 200 201 Each item is (KEY . ACTION). When KEY not on `avy-keys' is 202 pressed during the dispatch, ACTION is set to replace the default 203 `avy-action-goto' once a candidate is finally selected." 204 :type 205 '(alist 206 :key-type (choice (character :tag "Char")) 207 :value-type (choice 208 (const :tag "Mark" avy-action-mark) 209 (const :tag "Copy" avy-action-copy) 210 (const :tag "Kill and move point" avy-action-kill-move) 211 (const :tag "Kill" avy-action-kill-stay)))) 212 213 (defcustom avy-background nil 214 "When non-nil, a gray background will be added during the selection." 215 :type 'boolean) 216 217 (defcustom avy-all-windows t 218 "Determine the list of windows to consider in search of candidates." 219 :type 220 '(choice 221 (const :tag "All Frames" all-frames) 222 (const :tag "This Frame" t) 223 (const :tag "This Window" nil))) 224 225 (defcustom avy-case-fold-search t 226 "Non-nil if searches should ignore case." 227 :type 'boolean) 228 229 (defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]" 230 "Regexp of punctuation chars that count as word starts for `avy-goto-word-1. 231 When nil, punctuation chars will not be matched. 232 233 \"[!-/:-@[-`{-~]\" will match all printable punctuation chars." 234 :type 'regexp) 235 236 (defcustom avy-goto-word-0-regexp "\\b\\sw" 237 "Regexp that determines positions for `avy-goto-word-0'." 238 :type '(choice 239 (const :tag "Default" "\\b\\sw") 240 (const :tag "Symbol" "\\_<\\(\\sw\\|\\s_\\)") 241 (const :tag "Not whitespace" "[^ \r\n\t]+") 242 (regexp :tag "Regex"))) 243 244 (defcustom avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode) 245 "List of modes to ignore when searching for candidates. 246 Typically, these modes don't use the text representation." 247 :type 'list) 248 249 (defcustom avy-single-candidate-jump t 250 "In case there is only one candidate jumps directly to it." 251 :type 'boolean) 252 253 (defcustom avy-del-last-char-by '(?\b ?\d) 254 "List of event types, i.e. key presses, that delete the last 255 character read. The default represents `C-h' and `DEL'. See 256 `event-convert-list'." 257 :type 'list) 258 259 (defcustom avy-escape-chars '(?\e ?\C-g) 260 "List of characters that quit avy during `read-char'." 261 :type 'list) 262 263 (defvar avy-ring (make-ring 20) 264 "Hold the window and point history.") 265 266 (defvar avy-translate-char-function #'identity 267 "Function to translate user input key into another key. 268 For example, to make SPC do the same as ?a, use 269 \(lambda (c) (if (= c 32) ?a c)).") 270 271 (defface avy-lead-face-0 272 '((t (:foreground "white" :background "#4f57f9"))) 273 "Face used for first non-terminating leading chars.") 274 275 (defface avy-lead-face-1 276 '((t (:foreground "white" :background "gray"))) 277 "Face used for matched leading chars.") 278 279 (defface avy-lead-face-2 280 '((t (:foreground "white" :background "#f86bf3"))) 281 "Face used for leading chars.") 282 283 (defface avy-lead-face 284 '((t (:foreground "white" :background "#e52b50"))) 285 "Face used for the leading chars.") 286 287 (defface avy-background-face 288 '((t (:foreground "gray40"))) 289 "Face for whole window background during selection.") 290 291 (defface avy-goto-char-timer-face 292 '((t (:inherit highlight))) 293 "Face for matches during reading chars using `avy-goto-char-timer'.") 294 295 (defconst avy-lead-faces '(avy-lead-face 296 avy-lead-face-0 297 avy-lead-face-2 298 avy-lead-face 299 avy-lead-face-0 300 avy-lead-face-2) 301 "Face sequence for `avy--overlay-at-full'.") 302 303 (defvar avy-key-to-char-alist '((left . ?◀) 304 (right . ?▶) 305 (up . ?▲) 306 (down . ?▼) 307 (prior . ?△) 308 (next . ?▽)) 309 "An alist from non-character keys to printable chars used in avy overlays. 310 This alist must contain all keys used in `avy-keys' which are not 311 self-inserting keys and thus aren't read as characters.") 312 313 ;;* Internals 314 ;;** Tree 315 (defmacro avy-multipop (lst n) 316 "Remove LST's first N elements and return them." 317 `(if (<= (length ,lst) ,n) 318 (prog1 ,lst 319 (setq ,lst nil)) 320 (prog1 ,lst 321 (setcdr 322 (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst)))) 323 nil)))) 324 325 (defun avy--de-bruijn (keys n) 326 "De Bruijn sequence for alphabet KEYS and subsequences of length N." 327 (let* ((k (length keys)) 328 (a (make-list (* n k) 0)) 329 sequence) 330 (cl-labels ((db (T p) 331 (if (> T n) 332 (if (eq (% n p) 0) 333 (setq sequence 334 (append sequence 335 (cl-subseq a 1 (1+ p))))) 336 (setf (nth T a) (nth (- T p) a)) 337 (db (1+ T) p) 338 (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do 339 (setf (nth T a) j) 340 (db (1+ T) T))))) 341 (db 1 1) 342 (mapcar (lambda (n) 343 (nth n keys)) 344 sequence)))) 345 346 (defun avy--path-alist-1 (lst seq-len keys) 347 "Build a De Bruin sequence from LST. 348 SEQ-LEN is how many elements of KEYS it takes to identify a match." 349 (let ((db-seq (avy--de-bruijn keys seq-len)) 350 prev-pos prev-seq prev-win path-alist) 351 ;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to 352 ;; the end. 353 (setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len)))) 354 (cl-labels ((subseq-and-pop () 355 (when (nth (1- seq-len) db-seq) 356 (prog1 (cl-subseq db-seq 0 seq-len) 357 (pop db-seq))))) 358 (while lst 359 (let* ((cur (car lst)) 360 (pos (cond 361 ;; ace-window has matches of the form (pos . wnd) 362 ((integerp (car cur)) (car cur)) 363 ;; avy-jump have form ((start . end) . wnd) 364 ((consp (car cur)) (caar cur)) 365 (t (error "Unexpected match representation: %s" cur)))) 366 (win (cdr cur)) 367 (path (if prev-pos 368 (let ((diff (if (eq win prev-win) 369 (- pos prev-pos) 370 0))) 371 (when (and (> diff 0) (< diff seq-len)) 372 (while (and (nth (1- seq-len) db-seq) 373 (not 374 (eq 0 375 (cl-search 376 (cl-subseq prev-seq diff) 377 (cl-subseq db-seq 0 seq-len))))) 378 (pop db-seq))) 379 (subseq-and-pop)) 380 (subseq-and-pop)))) 381 (if (not path) 382 (setq lst nil 383 path-alist nil) 384 (push (cons path (car lst)) path-alist) 385 (setq prev-pos pos 386 prev-seq path 387 prev-win win 388 lst (cdr lst)))))) 389 (nreverse path-alist))) 390 391 (defun avy-order-closest (x) 392 (abs (- (if (numberp (car x)) 393 (car x) 394 (caar x)) 395 (point)))) 396 397 (defvar avy-command nil 398 "Store the current command symbol. 399 E.g. `avy-goto-line' or `avy-goto-char'.") 400 401 (defun avy-tree (lst keys) 402 "Coerce LST into a balanced tree. 403 The degree of the tree is the length of KEYS. 404 KEYS are placed appropriately on internal nodes." 405 (let* ((len (length keys)) 406 (order-fn (cdr (assq avy-command avy-orders-alist))) 407 (lst (if order-fn 408 (cl-sort lst #'< :key order-fn) 409 lst))) 410 (cl-labels 411 ((rd (ls) 412 (let ((ln (length ls))) 413 (if (< ln len) 414 (cl-pairlis keys 415 (mapcar (lambda (x) (cons 'leaf x)) ls)) 416 (let ((ks (copy-sequence keys)) 417 res) 418 (dolist (s (avy-subdiv ln len)) 419 (push (cons (pop ks) 420 (if (eq s 1) 421 (cons 'leaf (pop ls)) 422 (rd (avy-multipop ls s)))) 423 res)) 424 (nreverse res)))))) 425 (rd lst)))) 426 427 (defun avy-subdiv (n b) 428 "Distribute N in B terms in a balanced way." 429 (let* ((p (1- (floor (+ (log n b) 1e-6)))) 430 (x1 (expt b p)) 431 (x2 (* b x1)) 432 (delta (- n x2)) 433 (n2 (/ delta (- x2 x1))) 434 (n1 (- b n2 1))) 435 (append 436 (make-list n1 x1) 437 (list 438 (- n (* n1 x1) (* n2 x2))) 439 (make-list n2 x2)))) 440 441 (defun avy-traverse (tree walker &optional recur-key) 442 "Traverse TREE generated by `avy-tree'. 443 WALKER is a function that takes KEYS and LEAF. 444 445 RECUR-KEY is used in recursion. 446 447 LEAF is a member of LST argument of `avy-tree'. 448 449 KEYS is the path from the root of `avy-tree' to LEAF." 450 (dolist (br tree) 451 (let ((key (cons (car br) recur-key))) 452 (if (eq (cadr br) 'leaf) 453 (funcall walker key (cddr br)) 454 (avy-traverse (cdr br) walker key))))) 455 456 (defvar avy-action nil 457 "Function to call at the end of select.") 458 459 (defvar avy-action-oneshot nil 460 "Function to call once at the end of select.") 461 462 (defun avy-handler-default (char) 463 "The default handler for a bad CHAR." 464 (let (dispatch) 465 (cond ((setq dispatch (assoc char avy-dispatch-alist)) 466 (unless (eq avy-style 'words) 467 (setq avy-action (cdr dispatch))) 468 (throw 'done 'restart)) 469 ((memq char avy-escape-chars) 470 ;; exit silently 471 (throw 'done 'abort)) 472 ((eq char ??) 473 (avy-show-dispatch-help) 474 (throw 'done 'restart)) 475 ((mouse-event-p char) 476 (signal 'user-error (list "Mouse event not handled" char))) 477 (t 478 (message "No such candidate: %s, hit `C-g' to quit." 479 (if (characterp char) (string char) char)))))) 480 481 (defun avy-show-dispatch-help () 482 "Display action shortucts in echo area." 483 (let ((len (length "avy-action-"))) 484 (message "%s" (mapconcat 485 (lambda (x) 486 (format "%s: %s" 487 (propertize 488 (char-to-string (car x)) 489 'face 'aw-key-face) 490 (substring (symbol-name (cdr x)) len))) 491 avy-dispatch-alist 492 " ")))) 493 494 (defvar avy-handler-function 'avy-handler-default 495 "A function to call for a bad `read-key' in `avy-read'.") 496 497 (defvar avy-current-path "" 498 "Store the current incomplete path during `avy-read'.") 499 500 (defun avy-mouse-event-window (char) 501 "Return the window of mouse event CHAR if any or the selected window. 502 Return nil if CHAR is not a mouse event." 503 (when (mouse-event-p char) 504 (cond ((windowp (posn-window (event-start char))) 505 (posn-window (event-start char))) 506 ((framep (posn-window (event-start char))) 507 (frame-selected-window (posn-window (event-start char)))) 508 (t (selected-window))))) 509 510 (defun avy-read (tree display-fn cleanup-fn) 511 "Select a leaf from TREE using consecutive `read-key'. 512 513 DISPLAY-FN should take CHAR and LEAF and signify that LEAFs 514 associated with CHAR will be selected if CHAR is pressed. This is 515 commonly done by adding a CHAR overlay at LEAF position. 516 517 CLEANUP-FN should take no arguments and remove the effects of 518 multiple DISPLAY-FN invocations." 519 (catch 'done 520 (setq avy-current-path "") 521 (while tree 522 (let ((avy--leafs nil)) 523 (avy-traverse tree 524 (lambda (path leaf) 525 (push (cons path leaf) avy--leafs))) 526 (dolist (x avy--leafs) 527 (funcall display-fn (car x) (cdr x)))) 528 (let ((char (funcall avy-translate-char-function (read-key))) 529 window 530 branch) 531 (funcall cleanup-fn) 532 (if (setq window (avy-mouse-event-window char)) 533 (throw 'done (cons char window)) 534 (if (setq branch (assoc char tree)) 535 (progn 536 ;; Ensure avy-current-path stores the full path prior to 537 ;; exit so other packages can utilize its value. 538 (setq avy-current-path 539 (concat avy-current-path (string (avy--key-to-char char)))) 540 (if (eq (car (setq tree (cdr branch))) 'leaf) 541 (throw 'done (cdr tree)))) 542 (funcall avy-handler-function char))))))) 543 544 (defun avy-read-de-bruijn (lst keys) 545 "Select from LST dispatching on KEYS." 546 ;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n 547 ;; (the path length) usable as paths, thus that's the lower bound. Due to 548 ;; partially overlapping matches, not all subsequences may be usable, so it's 549 ;; possible that the path-len must be incremented, e.g., if we're matching 550 ;; for x and a buffer contains xaxbxcx only every second subsequence is 551 ;; usable for the four matches. 552 (catch 'done 553 (let* ((path-len (ceiling (log (length lst) (length keys)))) 554 (alist (avy--path-alist-1 lst path-len keys))) 555 (while (not alist) 556 (cl-incf path-len) 557 (setq alist (avy--path-alist-1 lst path-len keys))) 558 (let* ((len (length (caar alist))) 559 (i 0)) 560 (setq avy-current-path "") 561 (while (< i len) 562 (dolist (x (reverse alist)) 563 (avy--overlay-at-full (reverse (car x)) (cdr x))) 564 (let ((char (funcall avy-translate-char-function (read-key)))) 565 (avy--remove-leading-chars) 566 (setq alist 567 (delq nil 568 (mapcar (lambda (x) 569 (when (eq (caar x) char) 570 (cons (cdr (car x)) (cdr x)))) 571 alist))) 572 (setq avy-current-path 573 (concat avy-current-path (string (avy--key-to-char char)))) 574 (cl-incf i) 575 (unless alist 576 (funcall avy-handler-function char)))) 577 (cdar alist))))) 578 579 (defun avy-read-words (lst words) 580 "Select from LST using WORDS." 581 (catch 'done 582 (let ((num-words (length words)) 583 (num-entries (length lst)) 584 alist) 585 ;; If there are not enough words to cover all the candidates, 586 ;; we use a De Bruijn sequence to generate the remaining ones. 587 (when (< num-words num-entries) 588 (let ((keys avy-keys) 589 (bad-keys '(?a ?e ?i ?o ?u ?y)) 590 (path-len 1) 591 (num-remaining (- num-entries num-words)) 592 tmp-alist) 593 ;; Delete all keys which could lead to duplicates. 594 ;; We want at least three keys left to work with. 595 (dolist (x bad-keys) 596 (when (memq x keys) 597 (setq keys (delq ?a keys)))) 598 (when (< (length keys) 3) 599 (signal 'user-error 600 '("Please add more keys to the variable `avy-keys'."))) 601 ;; Generate the sequence and add the keys to the existing words. 602 (while (not tmp-alist) 603 (cl-incf path-len) 604 (setq tmp-alist (avy--path-alist-1 lst path-len keys))) 605 (while (>= (cl-decf num-remaining) 0) 606 (push (mapconcat 'string (caar tmp-alist) nil) (cdr (last words))) 607 (setq tmp-alist (cdr tmp-alist))))) 608 (dolist (x lst) 609 (push (cons (string-to-list (pop words)) x) alist)) 610 (setq avy-current-path "") 611 (while (or (> (length alist) 1) 612 (caar alist)) 613 (dolist (x (reverse alist)) 614 (avy--overlay-at-full (reverse (car x)) (cdr x))) 615 (let ((char (funcall avy-translate-char-function (read-key)))) 616 (avy--remove-leading-chars) 617 (setq alist 618 (delq nil 619 (mapcar (lambda (x) 620 (when (eq (caar x) char) 621 (cons (cdr (car x)) (cdr x)))) 622 alist))) 623 (setq avy-current-path 624 (concat avy-current-path (string (avy--key-to-char char)))) 625 (unless alist 626 (funcall avy-handler-function char)))) 627 (cdar alist)))) 628 629 ;;** Rest 630 (defun avy-window-list () 631 "Return a list of windows depending on `avy-all-windows'." 632 (cond ((eq avy-all-windows 'all-frames) 633 (cl-mapcan #'window-list (frame-list))) 634 635 ((eq avy-all-windows t) 636 (window-list)) 637 638 ((null avy-all-windows) 639 (list (selected-window))) 640 641 (t 642 (error "Unrecognized option: %S" avy-all-windows)))) 643 644 (defcustom avy-all-windows-alt nil 645 "The alternative `avy-all-windows' for use with \\[universal-argument]." 646 :type '(choice 647 (const :tag "Current window" nil) 648 (const :tag "All windows on the current frame" t) 649 (const :tag "All windows on all frames" all-frames))) 650 651 (defmacro avy-dowindows (flip &rest body) 652 "Depending on FLIP and `avy-all-windows' run BODY in each or selected window." 653 (declare (indent 1) 654 (debug (form body))) 655 `(let ((avy-all-windows (if ,flip 656 avy-all-windows-alt 657 avy-all-windows))) 658 (dolist (wnd (avy-window-list)) 659 (with-selected-window wnd 660 (unless (memq major-mode avy-ignored-modes) 661 ,@body))))) 662 663 (defun avy-resume () 664 "Stub to hold last avy command. 665 Commands using `avy-with' macro can be resumed." 666 (interactive)) 667 668 (defmacro avy-with (command &rest body) 669 "Set `avy-keys' according to COMMAND and execute BODY. 670 Set `avy-style' according to COMMAND as well." 671 (declare (indent 1) 672 (debug (form body))) 673 `(let ((avy-keys (or (cdr (assq ',command avy-keys-alist)) 674 avy-keys)) 675 (avy-style (or (cdr (assq ',command avy-styles-alist)) 676 avy-style)) 677 (avy-command ',command)) 678 (setq avy-action nil) 679 (setf (symbol-function 'avy-resume) 680 (lambda () 681 (interactive) 682 ,@(if (eq command 'avy-goto-char-timer) 683 (cdr body) 684 body))) 685 ,@body)) 686 687 (defun avy-action-goto (pt) 688 "Goto PT." 689 (let ((frame (window-frame (selected-window)))) 690 (unless (equal frame (selected-frame)) 691 (select-frame-set-input-focus frame) 692 (raise-frame frame)) 693 (goto-char pt))) 694 695 (defun avy-forward-item () 696 (if (eq avy-command 'avy-goto-line) 697 (end-of-line) 698 (forward-sexp)) 699 (point)) 700 701 (defun avy-action-mark (pt) 702 "Mark sexp at PT." 703 (goto-char pt) 704 (set-mark (point)) 705 (avy-forward-item)) 706 707 (defun avy-action-copy (pt) 708 "Copy sexp starting on PT." 709 (save-excursion 710 (let (str) 711 (goto-char pt) 712 (avy-forward-item) 713 (setq str (buffer-substring pt (point))) 714 (kill-new str) 715 (message "Copied: %s" str))) 716 (let ((dat (ring-ref avy-ring 0))) 717 (select-frame-set-input-focus 718 (window-frame (cdr dat))) 719 (select-window (cdr dat)) 720 (goto-char (car dat)))) 721 722 (defun avy-action-yank (pt) 723 "Yank sexp starting at PT at the current point." 724 (avy-action-copy pt) 725 (yank) 726 t) 727 728 (defun avy-action-yank-line (pt) 729 "Yank sexp starting at PT at the current point." 730 (let ((avy-command 'avy-goto-line)) 731 (avy-action-yank pt))) 732 733 (defun avy-action-kill-move (pt) 734 "Kill sexp at PT and move there." 735 (goto-char pt) 736 (avy-forward-item) 737 (kill-region pt (point)) 738 (message "Killed: %s" (current-kill 0)) 739 (point)) 740 741 (defun avy-action-kill-stay (pt) 742 "Kill sexp at PT." 743 (save-excursion 744 (goto-char pt) 745 (avy-forward-item) 746 (kill-region pt (point)) 747 (just-one-space)) 748 (message "Killed: %s" (current-kill 0)) 749 (select-window 750 (cdr 751 (ring-ref avy-ring 0))) 752 t) 753 754 (defun avy-action-zap-to-char (pt) 755 "Kill from point up to PT." 756 (if (> pt (point)) 757 (kill-region (point) pt) 758 (kill-region pt (point)))) 759 760 (defun avy-action-teleport (pt) 761 "Kill sexp starting on PT and yank into the current location." 762 (avy-action-kill-stay pt) 763 (select-window 764 (cdr 765 (ring-ref avy-ring 0))) 766 (save-excursion 767 (yank)) 768 t) 769 770 (declare-function flyspell-correct-word-before-point "flyspell") 771 772 (defcustom avy-flyspell-correct-function #'flyspell-correct-word-before-point 773 "Function called to correct word by `avy-action-ispell' when 774 `flyspell-mode' is enabled." 775 :type 'function) 776 777 (defun avy-action-ispell (pt) 778 "Auto correct word at PT." 779 (save-excursion 780 (goto-char pt) 781 (cond 782 ((eq avy-command 'avy-goto-line) 783 (ispell-region 784 (line-beginning-position) 785 (line-end-position))) 786 ((bound-and-true-p flyspell-mode) 787 (funcall avy-flyspell-correct-function)) 788 ((looking-at-p "\\b") 789 (ispell-word)) 790 (t 791 (progn 792 (backward-word) 793 (when (looking-at-p "\\b") 794 (ispell-word))))))) 795 796 (defvar avy-pre-action #'avy-pre-action-default 797 "Function to call before `avy-action' is called.") 798 799 (defun avy-pre-action-default (res) 800 (avy-push-mark) 801 (when (and (consp res) 802 (windowp (cdr res))) 803 (let* ((window (cdr res)) 804 (frame (window-frame window))) 805 (unless (equal frame (selected-frame)) 806 (select-frame-set-input-focus frame)) 807 (select-window window)))) 808 809 (defun avy--process-1 (candidates overlay-fn &optional cleanup-fn) 810 (let ((len (length candidates))) 811 (cond ((= len 0) 812 nil) 813 ((and (= len 1) avy-single-candidate-jump) 814 (car candidates)) 815 (t 816 (unwind-protect 817 (progn 818 (avy--make-backgrounds 819 (avy-window-list)) 820 (cond ((eq avy-style 'de-bruijn) 821 (avy-read-de-bruijn 822 candidates avy-keys)) 823 ((eq avy-style 'words) 824 (avy-read-words 825 candidates avy-words)) 826 (t 827 (avy-read (avy-tree candidates avy-keys) 828 overlay-fn 829 (or cleanup-fn #'avy--remove-leading-chars))))) 830 (avy--done)))))) 831 832 (defvar avy-last-candidates nil 833 "Store the last candidate list.") 834 835 (defun avy--last-candidates-cycle (advancer) 836 (let* ((avy-last-candidates 837 (cl-remove-if-not 838 (lambda (x) (equal (cdr x) (selected-window))) 839 avy-last-candidates)) 840 (min-dist 841 (apply #'min 842 (mapcar (lambda (x) (abs (- (if (listp (car x)) (caar x) (car x)) (point)))) avy-last-candidates))) 843 (pos 844 (cl-position-if 845 (lambda (x) 846 (= (- (if (listp (car x)) (caar x) (car x)) (point)) min-dist)) 847 avy-last-candidates))) 848 (funcall advancer pos avy-last-candidates))) 849 850 (defun avy-prev () 851 "Go to the previous candidate of the last `avy-read'." 852 (interactive) 853 (avy--last-candidates-cycle 854 (lambda (pos lst) 855 (when (> pos 0) 856 (let ((candidate (nth (1- pos) lst))) 857 (goto-char (if (listp (car candidate)) (caar candidate) (car candidate)))))))) 858 859 (defun avy-next () 860 "Go to the next candidate of the last `avy-read'." 861 (interactive) 862 (avy--last-candidates-cycle 863 (lambda (pos lst) 864 (when (< pos (1- (length lst))) 865 (let ((candidate (nth (1+ pos) lst))) 866 (goto-char (if (listp (car candidate)) (caar candidate) (car candidate)))))))) 867 868 ;;;###autoload 869 (defun avy-process (candidates &optional overlay-fn cleanup-fn) 870 "Select one of CANDIDATES using `avy-read'. 871 Use OVERLAY-FN to visualize the decision overlay. 872 CLEANUP-FN should take no arguments and remove the effects of 873 multiple OVERLAY-FN invocations." 874 (setq overlay-fn (or overlay-fn (avy--style-fn avy-style))) 875 (setq cleanup-fn (or cleanup-fn #'avy--remove-leading-chars)) 876 (unless (and (consp (car candidates)) 877 (windowp (cdar candidates))) 878 (setq candidates 879 (mapcar (lambda (x) (cons x (selected-window))) 880 candidates))) 881 (setq avy-last-candidates (copy-sequence candidates)) 882 (let ((original-cands (copy-sequence candidates)) 883 (res (avy--process-1 candidates overlay-fn cleanup-fn))) 884 (cond 885 ((null res) 886 (if (and (eq avy-style 'words) candidates) 887 (avy-process original-cands overlay-fn cleanup-fn) 888 (message "zero candidates") 889 t)) 890 ((eq res 'restart) 891 (avy-process original-cands overlay-fn cleanup-fn)) 892 ;; ignore exit from `avy-handler-function' 893 ((eq res 'exit)) 894 ((eq res 'abort) 895 nil) 896 (t 897 (funcall avy-pre-action res) 898 (setq res (car res)) 899 (let ((action (or avy-action avy-action-oneshot 'avy-action-goto))) 900 (funcall action 901 (if (consp res) 902 (car res) 903 res))) 904 res)))) 905 906 (define-obsolete-function-alias 'avy--process 'avy-process 907 "0.4.0") 908 909 (defvar avy--overlays-back nil 910 "Hold overlays for when `avy-background' is t.") 911 912 (defun avy--make-backgrounds (wnd-list) 913 "Create a dim background overlay for each window on WND-LIST." 914 (when avy-background 915 (setq avy--overlays-back 916 (mapcar (lambda (w) 917 (let ((ol (make-overlay 918 (window-start w) 919 (window-end w) 920 (window-buffer w)))) 921 (overlay-put ol 'face 'avy-background-face) 922 (overlay-put ol 'window w) 923 ol)) 924 wnd-list)))) 925 926 (defun avy--done () 927 "Clean up overlays." 928 (mapc #'delete-overlay avy--overlays-back) 929 (setq avy--overlays-back nil) 930 (avy--remove-leading-chars)) 931 932 (defun avy--visible-p (s) 933 (let ((invisible (get-char-property s 'invisible))) 934 (or (null invisible) 935 (eq t buffer-invisibility-spec) 936 (null (assoc invisible buffer-invisibility-spec))))) 937 938 (defun avy--next-visible-point () 939 "Return the next closest point without `invisible' property." 940 (let ((s (point))) 941 (while (and (not (= (point-max) (setq s (next-char-property-change s)))) 942 (not (avy--visible-p s)))) 943 s)) 944 945 (defun avy--next-invisible-point () 946 "Return the next closest point with `invisible' property." 947 (let ((s (point))) 948 (while (and (not (= (point-max) (setq s (next-char-property-change s)))) 949 (avy--visible-p s))) 950 s)) 951 952 (defun avy--find-visible-regions (rbeg rend) 953 "Return a list of all visible regions between RBEG and REND." 954 (setq rbeg (max rbeg (point-min))) 955 (setq rend (min rend (point-max))) 956 (when (< rbeg rend) 957 (let (visibles beg) 958 (save-excursion 959 (save-restriction 960 (narrow-to-region rbeg rend) 961 (setq beg (goto-char (point-min))) 962 (while (not (= (point) (point-max))) 963 (goto-char (avy--next-invisible-point)) 964 (push (cons beg (point)) visibles) 965 (setq beg (goto-char (avy--next-visible-point)))) 966 (nreverse visibles)))))) 967 968 (defun avy--regex-candidates (regex &optional beg end pred group) 969 "Return all elements that match REGEX. 970 Each element of the list is ((BEG . END) . WND) 971 When PRED is non-nil, it's a filter for matching point positions. 972 When GROUP is non-nil, (BEG . END) should delimit that regex group." 973 (setq group (or group 0)) 974 (let ((case-fold-search (or avy-case-fold-search 975 (string= regex (downcase regex)))) 976 candidates) 977 (avy-dowindows current-prefix-arg 978 (dolist (pair (avy--find-visible-regions 979 (or beg (window-start)) 980 (or end (window-end (selected-window) t)))) 981 (save-excursion 982 (goto-char (car pair)) 983 (while (re-search-forward regex (cdr pair) t) 984 (when (avy--visible-p (1- (point))) 985 (when (or (null pred) 986 (funcall pred)) 987 (push (cons 988 (if (numberp group) 989 (cons (match-beginning group) 990 (match-end group)) 991 (funcall group)) 992 wnd) candidates))))))) 993 (nreverse candidates))) 994 995 (defvar avy--overlay-offset 0 996 "The offset to apply in `avy--overlay'.") 997 998 (defvar avy--overlays-lead nil 999 "Hold overlays for leading chars.") 1000 1001 (defun avy--remove-leading-chars () 1002 "Remove leading char overlays." 1003 (mapc #'delete-overlay avy--overlays-lead) 1004 (setq avy--overlays-lead nil)) 1005 1006 (defun avy--old-str (pt wnd) 1007 "Return a one-char string at PT in WND." 1008 (let ((old-str (with-selected-window wnd 1009 (buffer-substring pt (1+ pt))))) 1010 (if avy-background 1011 (propertize old-str 'face 'avy-background-face) 1012 old-str))) 1013 1014 (defun avy--overlay (str beg end wnd &optional compose-fn) 1015 "Create an overlay with STR from BEG to END in WND. 1016 COMPOSE-FN is a lambda that concatenates the old string at BEG with STR." 1017 (let ((eob (with-selected-window wnd (point-max)))) 1018 (when (<= beg eob) 1019 (let* ((beg (+ beg avy--overlay-offset)) 1020 (ol (make-overlay beg (or end (1+ beg)) (window-buffer wnd))) 1021 (old-str (if (eq beg eob) "" (avy--old-str beg wnd))) 1022 (os-line-prefix (get-text-property 0 'line-prefix old-str)) 1023 (os-wrap-prefix (get-text-property 0 'wrap-prefix old-str)) 1024 other-ol) 1025 (unless (= (length str) 0) 1026 (when os-line-prefix 1027 (add-text-properties 0 1 `(line-prefix ,os-line-prefix) str)) 1028 (when os-wrap-prefix 1029 (add-text-properties 0 1 `(wrap-prefix ,os-wrap-prefix) str))) 1030 (when (setq other-ol (cl-find-if 1031 (lambda (o) (overlay-get o 'goto-address)) 1032 (overlays-at beg))) 1033 (add-text-properties 1034 0 (length old-str) 1035 `(face ,(overlay-get other-ol 'face)) old-str)) 1036 (overlay-put ol 'window wnd) 1037 (overlay-put ol 'category 'avy) 1038 (overlay-put ol (if (eq beg eob) 1039 'after-string 1040 'display) 1041 (funcall 1042 (or compose-fn #'concat) 1043 str old-str)) 1044 (push ol avy--overlays-lead))))) 1045 1046 (defcustom avy-highlight-first nil 1047 "When non-nil highlight the first decision char with `avy-lead-face-0'. 1048 Do this even when the char is terminating." 1049 :type 'boolean) 1050 1051 (defun avy--key-to-char (c) 1052 "If C is no character, translate it using `avy-key-to-char-alist'." 1053 (cond ((characterp c) c) 1054 ((cdr (assoc c avy-key-to-char-alist))) 1055 ((mouse-event-p c) c) 1056 (t 1057 (error "Unknown key %s" c)))) 1058 1059 (defun avy-candidate-beg (leaf) 1060 "Return the start position for LEAF." 1061 (cond ((numberp leaf) 1062 leaf) 1063 ((consp (car leaf)) 1064 (caar leaf)) 1065 (t 1066 (car leaf)))) 1067 1068 (defun avy-candidate-end (leaf) 1069 "Return the end position for LEAF." 1070 (cond ((numberp leaf) 1071 leaf) 1072 ((consp (car leaf)) 1073 (cdar leaf)) 1074 (t 1075 (car leaf)))) 1076 1077 (defun avy-candidate-wnd (leaf) 1078 "Return the window for LEAF." 1079 (if (consp leaf) 1080 (cdr leaf) 1081 (selected-window))) 1082 1083 (defun avy--overlay-pre (path leaf) 1084 "Create an overlay with PATH at LEAF. 1085 PATH is a list of keys from tree root to LEAF. 1086 LEAF is normally ((BEG . END) . WND)." 1087 (if (with-selected-window (cdr leaf) 1088 (bound-and-true-p visual-line-mode)) 1089 (avy--overlay-at-full path leaf) 1090 (let* ((path (mapcar #'avy--key-to-char path)) 1091 (str (propertize (apply #'string (reverse path)) 1092 'face 'avy-lead-face))) 1093 (when (or avy-highlight-first (> (length str) 1)) 1094 (set-text-properties 0 1 '(face avy-lead-face-0) str)) 1095 (setq str (concat 1096 (propertize avy-current-path 1097 'face 'avy-lead-face-1) 1098 str)) 1099 (avy--overlay 1100 str 1101 (avy-candidate-beg leaf) nil 1102 (avy-candidate-wnd leaf))))) 1103 1104 (defun avy--overlay-at (path leaf) 1105 "Create an overlay with PATH at LEAF. 1106 PATH is a list of keys from tree root to LEAF. 1107 LEAF is normally ((BEG . END) . WND)." 1108 (let* ((path (mapcar #'avy--key-to-char path)) 1109 (str (propertize 1110 (string (car (last path))) 1111 'face 'avy-lead-face))) 1112 (avy--overlay 1113 str 1114 (avy-candidate-beg leaf) nil 1115 (avy-candidate-wnd leaf) 1116 (lambda (str old-str) 1117 (cond ((string= old-str "\n") 1118 (concat str "\n")) 1119 ;; add padding for wide-width character 1120 ((eq (string-width old-str) 2) 1121 (concat str " ")) 1122 (t 1123 str)))))) 1124 1125 (defun avy--overlay-at-full (path leaf) 1126 "Create an overlay with PATH at LEAF. 1127 PATH is a list of keys from tree root to LEAF. 1128 LEAF is normally ((BEG . END) . WND)." 1129 (let* ((path (mapcar #'avy--key-to-char path)) 1130 (str (propertize 1131 (apply #'string (reverse path)) 1132 'face 'avy-lead-face)) 1133 (len (length path)) 1134 (beg (avy-candidate-beg leaf)) 1135 (wnd (cdr leaf)) 1136 end) 1137 (dotimes (i len) 1138 (set-text-properties i (1+ i) 1139 `(face ,(nth i avy-lead-faces)) 1140 str)) 1141 (when (eq avy-style 'de-bruijn) 1142 (setq str (concat 1143 (propertize avy-current-path 1144 'face 'avy-lead-face-1) 1145 str)) 1146 (setq len (length str))) 1147 (with-selected-window wnd 1148 (save-excursion 1149 (goto-char beg) 1150 (let* ((lep (if (bound-and-true-p visual-line-mode) 1151 (save-excursion 1152 (end-of-visual-line) 1153 (point)) 1154 (line-end-position))) 1155 ;; `end-of-visual-line' is bugged sometimes 1156 (lep (if (< lep beg) 1157 (line-end-position) 1158 lep)) 1159 (len-and-str (avy--update-offset-and-str len str lep))) 1160 (setq len (car len-and-str)) 1161 (setq str (cdr len-and-str)) 1162 (setq end (if (= beg lep) 1163 (1+ beg) 1164 (min (+ beg 1165 (if (eq (char-after) ?\t) 1166 1 1167 len)) 1168 lep))) 1169 (when (and (bound-and-true-p visual-line-mode) 1170 (> len (- end beg)) 1171 (not (eq lep beg))) 1172 (setq len (- end beg)) 1173 (let ((old-str (apply #'string (reverse path)))) 1174 (setq str 1175 (substring 1176 (propertize 1177 old-str 1178 'face 1179 (if (= (length old-str) 1) 1180 'avy-lead-face 1181 'avy-lead-face-0)) 1182 0 len))))))) 1183 (avy--overlay 1184 str beg end wnd 1185 (lambda (str old-str) 1186 (cond ((string= old-str "\n") 1187 (concat str "\n")) 1188 ((string= old-str "\t") 1189 (concat str (make-string (max (- tab-width len) 0) ?\ ))) 1190 (t 1191 ;; add padding for wide-width character 1192 (if (eq (string-width old-str) 2) 1193 (concat str " ") 1194 str))))))) 1195 1196 (defun avy--overlay-post (path leaf) 1197 "Create an overlay with PATH at LEAF. 1198 PATH is a list of keys from tree root to LEAF. 1199 LEAF is normally ((BEG . END) . WND)." 1200 (let* ((path (mapcar #'avy--key-to-char path)) 1201 (str (propertize (apply #'string (reverse path)) 1202 'face 'avy-lead-face))) 1203 (when (or avy-highlight-first (> (length str) 1)) 1204 (set-text-properties 0 1 '(face avy-lead-face-0) str)) 1205 (setq str (concat 1206 (propertize avy-current-path 1207 'face 'avy-lead-face-1) 1208 str)) 1209 (avy--overlay 1210 str 1211 (avy-candidate-end leaf) nil 1212 (avy-candidate-wnd leaf)))) 1213 1214 (defun avy--update-offset-and-str (offset str lep) 1215 "Recalculate the length of the new overlay at point. 1216 1217 OFFSET is the previous overlay length. 1218 STR is the overlay string that we wish to add. 1219 LEP is the line end position. 1220 1221 We want to add an overlay between point and END=point+OFFSET. 1222 When other overlays already exist between point and END, set 1223 OFFSET to be the difference between the start of the first 1224 overlay and point. This is equivalent to truncating our new 1225 overlay, so that it doesn't intersect with overlays that already 1226 exist." 1227 (let* ((wnd (selected-window)) 1228 (beg (point)) 1229 (oov (delq nil 1230 (mapcar 1231 (lambda (o) 1232 (and (eq (overlay-get o 'category) 'avy) 1233 (eq (overlay-get o 'window) wnd) 1234 (overlay-start o))) 1235 (overlays-in beg (min (+ beg offset) lep)))))) 1236 (when oov 1237 (setq offset (- (apply #'min oov) beg)) 1238 (setq str (substring str 0 offset))) 1239 (let ((other-ov (cl-find-if 1240 (lambda (o) 1241 (and (eq (overlay-get o 'category) 'avy) 1242 (eq (overlay-start o) beg) 1243 (not (eq (overlay-get o 'window) wnd)))) 1244 (overlays-in (point) (min (+ (point) offset) lep))))) 1245 (when (and other-ov 1246 (> (overlay-end other-ov) 1247 (+ beg offset))) 1248 (setq str (concat str (buffer-substring 1249 (+ beg offset) 1250 (overlay-end other-ov)))) 1251 (setq offset (- (overlay-end other-ov) 1252 beg)))) 1253 (cons offset str))) 1254 1255 (defun avy--style-fn (style) 1256 "Transform STYLE symbol to a style function." 1257 (cl-case style 1258 (pre #'avy--overlay-pre) 1259 (at #'avy--overlay-at) 1260 (at-full 'avy--overlay-at-full) 1261 (post #'avy--overlay-post) 1262 (de-bruijn #'avy--overlay-at-full) 1263 (words #'avy--overlay-at-full) 1264 (ignore #'ignore) 1265 (t (error "Unexpected style %S" style)))) 1266 1267 (cl-defun avy-jump (regex &key window-flip beg end action pred group) 1268 "Jump to REGEX. 1269 The window scope is determined by `avy-all-windows'. 1270 When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'. 1271 BEG and END narrow the scope where candidates are searched. 1272 ACTION is a function that takes point position as an argument. 1273 When PRED is non-nil, it's a filter for matching point positions. 1274 When GROUP is non-nil, it's either a match group in REGEX, or a function 1275 that returns a cons of match beginning and end." 1276 (setq avy-action (or action avy-action)) 1277 (let ((avy-all-windows 1278 (if window-flip 1279 (not avy-all-windows) 1280 avy-all-windows))) 1281 (avy-process 1282 (avy--regex-candidates regex beg end pred group)))) 1283 1284 (defun avy--generic-jump (regex window-flip &optional beg end) 1285 "Jump to REGEX. 1286 The window scope is determined by `avy-all-windows'. 1287 When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'. 1288 BEG and END narrow the scope where candidates are searched." 1289 (declare (obsolete avy-jump "0.4.0")) 1290 (let ((avy-all-windows 1291 (if window-flip 1292 (not avy-all-windows) 1293 avy-all-windows))) 1294 (avy-process 1295 (avy--regex-candidates regex beg end)))) 1296 1297 ;;* Commands 1298 ;;;###autoload 1299 (defun avy-goto-char (char &optional arg) 1300 "Jump to the currently visible CHAR. 1301 The window scope is determined by `avy-all-windows' (ARG negates it)." 1302 (interactive (list (read-char "char: " t) 1303 current-prefix-arg)) 1304 (avy-with avy-goto-char 1305 (avy-jump 1306 (if (= 13 char) 1307 "\n" 1308 (regexp-quote (string char))) 1309 :window-flip arg))) 1310 1311 ;;;###autoload 1312 (defun avy-goto-char-in-line (char) 1313 "Jump to the currently visible CHAR in the current line." 1314 (interactive (list (read-char "char: " t))) 1315 (avy-with avy-goto-char 1316 (avy-jump 1317 (regexp-quote (string char)) 1318 :beg (line-beginning-position) 1319 :end (line-end-position)))) 1320 1321 ;;;###autoload 1322 (defun avy-goto-char-2 (char1 char2 &optional arg beg end) 1323 "Jump to the currently visible CHAR1 followed by CHAR2. 1324 The window scope is determined by `avy-all-windows'. 1325 When ARG is non-nil, do the opposite of `avy-all-windows'. 1326 BEG and END narrow the scope where candidates are searched." 1327 (interactive (list (let ((c1 (read-char "char 1: " t))) 1328 (if (memq c1 '(? ?\b)) 1329 (keyboard-quit) 1330 c1)) 1331 (let ((c2 (read-char "char 2: " t))) 1332 (cond ((eq c2 ?) 1333 (keyboard-quit)) 1334 ((memq c2 avy-del-last-char-by) 1335 (keyboard-escape-quit) 1336 (call-interactively 'avy-goto-char-2)) 1337 (t 1338 c2))) 1339 current-prefix-arg 1340 nil nil)) 1341 (when (eq char1 ?) 1342 (setq char1 ?\n)) 1343 (when (eq char2 ?) 1344 (setq char2 ?\n)) 1345 (avy-with avy-goto-char-2 1346 (avy-jump 1347 (regexp-quote (string char1 char2)) 1348 :window-flip arg 1349 :beg beg 1350 :end end))) 1351 1352 ;;;###autoload 1353 (defun avy-goto-char-2-above (char1 char2 &optional arg) 1354 "Jump to the currently visible CHAR1 followed by CHAR2. 1355 This is a scoped version of `avy-goto-char-2', where the scope is 1356 the visible part of the current buffer up to point. 1357 The window scope is determined by `avy-all-windows'. 1358 When ARG is non-nil, do the opposite of `avy-all-windows'." 1359 (interactive (list (read-char "char 1: " t) 1360 (read-char "char 2: " t) 1361 current-prefix-arg)) 1362 (avy-with avy-goto-char-2-above 1363 (avy-goto-char-2 1364 char1 char2 arg 1365 (window-start) (point)))) 1366 1367 ;;;###autoload 1368 (defun avy-goto-char-2-below (char1 char2 &optional arg) 1369 "Jump to the currently visible CHAR1 followed by CHAR2. 1370 This is a scoped version of `avy-goto-char-2', where the scope is 1371 the visible part of the current buffer following point. 1372 The window scope is determined by `avy-all-windows'. 1373 When ARG is non-nil, do the opposite of `avy-all-windows'." 1374 (interactive (list (read-char "char 1: " t) 1375 (read-char "char 2: " t) 1376 current-prefix-arg)) 1377 (avy-with avy-goto-char-2-below 1378 (avy-goto-char-2 1379 char1 char2 arg 1380 (point) (window-end (selected-window) t)))) 1381 1382 ;;;###autoload 1383 (defun avy-isearch () 1384 "Jump to one of the current isearch candidates." 1385 (interactive) 1386 (avy-with avy-isearch 1387 (let ((avy-background nil) 1388 (avy-case-fold-search case-fold-search)) 1389 (prog1 1390 (avy-process 1391 (avy--regex-candidates (if isearch-regexp 1392 isearch-string 1393 (regexp-quote isearch-string)))) 1394 (isearch-done))))) 1395 1396 ;;;###autoload 1397 (defun avy-goto-word-0 (arg &optional beg end) 1398 "Jump to a word start. 1399 The window scope is determined by `avy-all-windows'. 1400 When ARG is non-nil, do the opposite of `avy-all-windows'. 1401 BEG and END narrow the scope where candidates are searched." 1402 (interactive "P") 1403 (avy-with avy-goto-word-0 1404 (avy-jump avy-goto-word-0-regexp 1405 :window-flip arg 1406 :beg beg 1407 :end end))) 1408 1409 ;;;###autoload 1410 (defun avy-goto-whitespace-end (arg &optional beg end) 1411 "Jump to the end of a whitespace sequence. 1412 The window scope is determined by `avy-all-windows'. 1413 When ARG is non-nil, do the opposite of `avy-all-windows'. 1414 BEG and END narrow the scope where candidates are searched." 1415 (interactive "P") 1416 (avy-with avy-goto-whitespace-end 1417 (avy-jump "[ \t]+\\|\n[ \t]*" 1418 :window-flip arg 1419 :beg beg 1420 :end end 1421 :group (lambda () (cons (point) (1+ (point))))))) 1422 1423 (defun avy-goto-word-0-above (arg) 1424 "Jump to a word start between window start and point. 1425 The window scope is determined by `avy-all-windows'. 1426 When ARG is non-nil, do the opposite of `avy-all-windows'." 1427 (interactive "P") 1428 (avy-with avy-goto-word-0 1429 (avy-goto-word-0 arg (window-start) (point)))) 1430 1431 (defun avy-goto-word-0-below (arg) 1432 "Jump to a word start between point and window end. 1433 The window scope is determined by `avy-all-windows'. 1434 When ARG is non-nil, do the opposite of `avy-all-windows'." 1435 (interactive "P") 1436 (avy-with avy-goto-word-0 1437 (avy-goto-word-0 arg (point) (window-end (selected-window) t)))) 1438 1439 (defun avy-goto-whitespace-end-above (arg) 1440 "Jump to the end of a whitespace sequence between point and window end. 1441 The window scope is determined by `avy-all-windows'. 1442 When ARG is non-nil, do the opposite of `avy-all-windows'." 1443 (interactive "P") 1444 (avy-with avy-goto-whitespace-end 1445 (avy-goto-whitespace-end arg (window-start) (point)))) 1446 1447 (defun avy-goto-whitespace-end-below (arg) 1448 "Jump to the end of a whitespace sequence between window start and point. 1449 The window scope is determined by `avy-all-windows'. 1450 When ARG is non-nil, do the opposite of `avy-all-windows'." 1451 (interactive "P") 1452 (avy-with avy-goto-whitespace-end 1453 (avy-goto-whitespace-end arg (point) (window-end (selected-window) t)))) 1454 1455 ;;;###autoload 1456 (defun avy-goto-word-1 (char &optional arg beg end symbol) 1457 "Jump to the currently visible CHAR at a word start. 1458 The window scope is determined by `avy-all-windows'. 1459 When ARG is non-nil, do the opposite of `avy-all-windows'. 1460 BEG and END narrow the scope where candidates are searched. 1461 When SYMBOL is non-nil, jump to symbol start instead of word start." 1462 (interactive (list (read-char "char: " t) 1463 current-prefix-arg)) 1464 (avy-with avy-goto-word-1 1465 (let* ((str (string char)) 1466 (regex (cond ((string= str ".") 1467 "\\.") 1468 ((and avy-word-punc-regexp 1469 (string-match avy-word-punc-regexp str)) 1470 (regexp-quote str)) 1471 ((<= char 26) 1472 str) 1473 (t 1474 (concat 1475 (if symbol "\\_<" "\\b") 1476 str))))) 1477 (avy-jump regex 1478 :window-flip arg 1479 :beg beg 1480 :end end)))) 1481 1482 ;;;###autoload 1483 (defun avy-goto-word-1-above (char &optional arg) 1484 "Jump to the currently visible CHAR at a word start. 1485 This is a scoped version of `avy-goto-word-1', where the scope is 1486 the visible part of the current buffer up to point. 1487 The window scope is determined by `avy-all-windows'. 1488 When ARG is non-nil, do the opposite of `avy-all-windows'." 1489 (interactive (list (read-char "char: " t) 1490 current-prefix-arg)) 1491 (avy-with avy-goto-word-1 1492 (avy-goto-word-1 char arg (window-start) (point)))) 1493 1494 ;;;###autoload 1495 (defun avy-goto-word-1-below (char &optional arg) 1496 "Jump to the currently visible CHAR at a word start. 1497 This is a scoped version of `avy-goto-word-1', where the scope is 1498 the visible part of the current buffer following point. 1499 The window scope is determined by `avy-all-windows'. 1500 When ARG is non-nil, do the opposite of `avy-all-windows'." 1501 (interactive (list (read-char "char: " t) 1502 current-prefix-arg)) 1503 (avy-with avy-goto-word-1 1504 (avy-goto-word-1 char arg (point) (window-end (selected-window) t)))) 1505 1506 ;;;###autoload 1507 (defun avy-goto-symbol-1 (char &optional arg) 1508 "Jump to the currently visible CHAR at a symbol start. 1509 The window scope is determined by `avy-all-windows'. 1510 When ARG is non-nil, do the opposite of `avy-all-windows'." 1511 (interactive (list (read-char "char: " t) 1512 current-prefix-arg)) 1513 (avy-with avy-goto-symbol-1 1514 (avy-goto-word-1 char arg nil nil t))) 1515 1516 ;;;###autoload 1517 (defun avy-goto-symbol-1-above (char &optional arg) 1518 "Jump to the currently visible CHAR at a symbol start. 1519 This is a scoped version of `avy-goto-symbol-1', where the scope is 1520 the visible part of the current buffer up to point. 1521 The window scope is determined by `avy-all-windows'. 1522 When ARG is non-nil, do the opposite of `avy-all-windows'." 1523 (interactive (list (read-char "char: " t) 1524 current-prefix-arg)) 1525 (avy-with avy-goto-symbol-1-above 1526 (avy-goto-word-1 char arg (window-start) (point) t))) 1527 1528 ;;;###autoload 1529 (defun avy-goto-symbol-1-below (char &optional arg) 1530 "Jump to the currently visible CHAR at a symbol start. 1531 This is a scoped version of `avy-goto-symbol-1', where the scope is 1532 the visible part of the current buffer following point. 1533 The window scope is determined by `avy-all-windows'. 1534 When ARG is non-nil, do the opposite of `avy-all-windows'." 1535 (interactive (list (read-char "char: " t) 1536 current-prefix-arg)) 1537 (avy-with avy-goto-symbol-1-below 1538 (avy-goto-word-1 char arg (point) (window-end (selected-window) t) t))) 1539 1540 (declare-function subword-backward "subword") 1541 (defvar subword-backward-regexp) 1542 1543 (defcustom avy-subword-extra-word-chars '(?{ ?= ?} ?* ?: ?> ?<) 1544 "A list of characters that should temporarily match \"\\w\". 1545 This variable is used by `avy-goto-subword-0' and `avy-goto-subword-1'." 1546 :type '(repeat character)) 1547 1548 ;;;###autoload 1549 (defun avy-goto-subword-0 (&optional arg predicate beg end) 1550 "Jump to a word or subword start. 1551 The window scope is determined by `avy-all-windows' (ARG negates it). 1552 1553 When PREDICATE is non-nil it's a function of zero parameters that 1554 should return true. 1555 1556 BEG and END narrow the scope where candidates are searched." 1557 (interactive "P") 1558 (require 'subword) 1559 (avy-with avy-goto-subword-0 1560 (let ((case-fold-search nil) 1561 (subword-backward-regexp 1562 "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)") 1563 candidates) 1564 (avy-dowindows arg 1565 (let ((syn-tbl (copy-syntax-table))) 1566 (dolist (char avy-subword-extra-word-chars) 1567 (modify-syntax-entry char "w" syn-tbl)) 1568 (with-syntax-table syn-tbl 1569 (let ((ws (or beg (window-start))) 1570 window-cands) 1571 (save-excursion 1572 (goto-char (or end (window-end (selected-window) t))) 1573 (subword-backward) 1574 (while (> (point) ws) 1575 (when (or (null predicate) 1576 (and predicate (funcall predicate))) 1577 (unless (not (avy--visible-p (point))) 1578 (push (cons (cons (point) (1+ (point))) 1579 (selected-window)) window-cands))) 1580 (subword-backward)) 1581 (and (= (point) ws) 1582 (or (null predicate) 1583 (and predicate (funcall predicate))) 1584 (not (get-char-property (point) 'invisible)) 1585 (push (cons (cons (point) (1+ (point))) 1586 (selected-window)) window-cands))) 1587 (setq candidates (nconc candidates window-cands)))))) 1588 (avy-process candidates)))) 1589 1590 ;;;###autoload 1591 (defun avy-goto-subword-1 (char &optional arg) 1592 "Jump to the currently visible CHAR at a subword start. 1593 The window scope is determined by `avy-all-windows' (ARG negates it). 1594 The case of CHAR is ignored." 1595 (interactive (list (read-char "char: " t) 1596 current-prefix-arg)) 1597 (avy-with avy-goto-subword-1 1598 (let ((char (downcase char))) 1599 (avy-goto-subword-0 1600 arg (lambda () 1601 (and (char-after) 1602 (eq (downcase (char-after)) char))))))) 1603 1604 ;;;###autoload 1605 (defun avy-goto-word-or-subword-1 () 1606 "Forward to `avy-goto-subword-1' or `avy-goto-word-1'. 1607 Which one depends on variable `subword-mode'." 1608 (interactive) 1609 (if (bound-and-true-p subword-mode) 1610 (call-interactively #'avy-goto-subword-1) 1611 (call-interactively #'avy-goto-word-1))) 1612 1613 (defvar visual-line-mode) 1614 1615 (defcustom avy-indent-line-overlay nil 1616 "When non-nil, display line overlay next to the first non-whitespace character. 1617 This affects `avy-goto-line'." 1618 :type 'boolean) 1619 1620 (defun avy--line-cands (&optional arg beg end bottom-up) 1621 "Get candidates for selecting a line. 1622 The window scope is determined by `avy-all-windows'. 1623 When ARG is non-nil, do the opposite of `avy-all-windows'. 1624 BEG and END narrow the scope where candidates are searched. 1625 When BOTTOM-UP is non-nil, display avy candidates from top to bottom" 1626 (let (candidates) 1627 (avy-dowindows arg 1628 (let ((ws (or beg (window-start)))) 1629 (save-excursion 1630 (save-restriction 1631 (narrow-to-region ws (or end (window-end (selected-window) t))) 1632 (goto-char (point-min)) 1633 (while (< (point) (point-max)) 1634 (when (member (get-char-property 1635 (max (1- (point)) ws) 'invisible) '(nil org-link)) 1636 (push (cons 1637 (if (eq avy-style 'post) 1638 (line-end-position) 1639 (save-excursion 1640 (when avy-indent-line-overlay 1641 (skip-chars-forward " \t")) 1642 (point))) 1643 (selected-window)) candidates)) 1644 (if visual-line-mode 1645 (line-move-visual 1 t) 1646 (forward-line 1))))))) 1647 (if bottom-up 1648 candidates 1649 (nreverse candidates)))) 1650 1651 (defun avy--linum-strings () 1652 "Get strings for `avy-linum-mode'." 1653 (let* ((lines (mapcar #'car (avy--line-cands))) 1654 (line-tree (avy-tree lines avy-keys)) 1655 (line-list nil)) 1656 (avy-traverse 1657 line-tree 1658 (lambda (path _leaf) 1659 (let ((str (propertize (apply #'string (reverse path)) 1660 'face 'avy-lead-face))) 1661 (when (> (length str) 1) 1662 (set-text-properties 0 1 '(face avy-lead-face-0) str)) 1663 (push str line-list)))) 1664 (nreverse line-list))) 1665 1666 (defvar linum-available) 1667 (defvar linum-overlays) 1668 (defvar linum-format) 1669 (declare-function linum--face-width "linum") 1670 (declare-function linum-mode "linum") 1671 1672 (define-minor-mode avy-linum-mode 1673 "Minor mode that uses avy hints for `linum-mode'." 1674 :group 'avy 1675 (if avy-linum-mode 1676 (progn 1677 (require 'linum) 1678 (advice-add 'linum-update-window :around 'avy--linum-update-window) 1679 (linum-mode 1)) 1680 (advice-remove 'linum-update-window 'avy--linum-update-window) 1681 (linum-mode -1))) 1682 1683 (defun avy--linum-update-window (_ win) 1684 "Update line numbers for the portion visible in window WIN." 1685 (goto-char (window-start win)) 1686 (let ((line (line-number-at-pos)) 1687 (limit (window-end win t)) 1688 (fmt (cond ((stringp linum-format) linum-format) 1689 ((eq linum-format 'dynamic) 1690 (let ((w (length (number-to-string 1691 (count-lines (point-min) (point-max)))))) 1692 (concat "%" (number-to-string w) "d"))))) 1693 (width 0) 1694 (avy-strs (when avy-linum-mode 1695 (avy--linum-strings)))) 1696 (run-hooks 'linum-before-numbering-hook) 1697 ;; Create an overlay (or reuse an existing one) for each 1698 ;; line visible in this window, if necessary. 1699 (while (and (not (eobp)) (< (point) limit)) 1700 (let* ((str 1701 (cond (avy-linum-mode 1702 (pop avy-strs)) 1703 (fmt 1704 (propertize (format fmt line) 'face 'linum)) 1705 (t 1706 (funcall linum-format line)))) 1707 (visited (catch 'visited 1708 (dolist (o (overlays-in (point) (point))) 1709 (when (equal-including-properties 1710 (overlay-get o 'linum-str) str) 1711 (unless (memq o linum-overlays) 1712 (push o linum-overlays)) 1713 (setq linum-available (delq o linum-available)) 1714 (throw 'visited t)))))) 1715 (setq width (max width (length str))) 1716 (unless visited 1717 (let ((ov (if (null linum-available) 1718 (make-overlay (point) (point)) 1719 (move-overlay (pop linum-available) (point) (point))))) 1720 (push ov linum-overlays) 1721 (overlay-put ov 'before-string 1722 (propertize " " 'display `((margin left-margin) ,str))) 1723 (overlay-put ov 'linum-str str)))) 1724 ;; Text may contain those nasty intangible properties, but that 1725 ;; shouldn't prevent us from counting those lines. 1726 (let ((inhibit-point-motion-hooks t)) 1727 (forward-line)) 1728 (setq line (1+ line))) 1729 (when (display-graphic-p) 1730 (setq width (ceiling 1731 (/ (* width 1.0 (linum--face-width 'linum)) 1732 (frame-char-width))))) 1733 (set-window-margins win width (cdr (window-margins win))))) 1734 1735 (defun avy--line (&optional arg beg end bottom-up) 1736 "Select a line. 1737 The window scope is determined by `avy-all-windows'. 1738 When ARG is non-nil, do the opposite of `avy-all-windows'. 1739 BEG and END narrow the scope where candidates are searched. 1740 When BOTTOM-UP is non-nil, display avy candidates from top to bottom" 1741 (setq avy-action (or avy-action #'identity)) 1742 (let ((avy-style (if avy-linum-mode 1743 (progn 1744 (message "Goto line:") 1745 'ignore) 1746 avy-style))) 1747 (avy-process 1748 (avy--line-cands arg beg end bottom-up)))) 1749 1750 ;;;###autoload 1751 (defun avy-goto-line (&optional arg) 1752 "Jump to a line start in current buffer. 1753 1754 When ARG is 1, jump to lines currently visible, with the option 1755 to cancel to `goto-line' by entering a number. 1756 1757 When ARG is 4, negate the window scope determined by 1758 `avy-all-windows'. 1759 1760 Otherwise, forward to `goto-line' with ARG." 1761 (interactive "p") 1762 (setq arg (or arg 1)) 1763 (if (not (memq arg '(1 4))) 1764 (progn 1765 (goto-char (point-min)) 1766 (forward-line (1- arg))) 1767 (avy-with avy-goto-line 1768 (let* ((avy-handler-old avy-handler-function) 1769 (avy-handler-function 1770 (lambda (char) 1771 (if (or (< char ?0) 1772 (> char ?9)) 1773 (funcall avy-handler-old char) 1774 (let ((line (read-from-minibuffer 1775 "Goto line: " (string char)))) 1776 (when line 1777 (avy-push-mark) 1778 (save-restriction 1779 (widen) 1780 (goto-char (point-min)) 1781 (forward-line (1- (string-to-number line)))) 1782 (throw 'done 'exit)))))) 1783 (r (avy--line (eq arg 4)))) 1784 (when (and (not (memq r '(t nil))) (eq avy-action #'identity)) 1785 (avy-action-goto r)))))) 1786 1787 ;;;###autoload 1788 (defun avy-goto-line-above (&optional offset bottom-up) 1789 "Goto visible line above the cursor. 1790 OFFSET changes the distance between the closest key to the cursor and 1791 the cursor 1792 When BOTTOM-UP is non-nil, display avy candidates from top to bottom" 1793 (interactive) 1794 (if offset 1795 (setq offset (+ 2 (- offset)))) 1796 (let* ((avy-all-windows nil) 1797 (r (avy--line nil (window-start) 1798 (line-beginning-position (or offset 1)) 1799 bottom-up))) 1800 (unless (eq r t) 1801 (avy-action-goto r)))) 1802 1803 ;;;###autoload 1804 (defun avy-goto-line-below (&optional offset bottom-up) 1805 "Goto visible line below the cursor. 1806 OFFSET changes the distance between the closest key to the cursor and 1807 the cursor 1808 When BOTTOM-UP is non-nil, display avy candidates from top to bottom" 1809 (interactive) 1810 (if offset 1811 (setq offset (+ offset 1))) 1812 (let* ((avy-all-windows nil) 1813 (r (avy--line 1814 nil (line-beginning-position (or offset 2)) 1815 (window-end (selected-window) t) 1816 bottom-up))) 1817 (unless (eq r t) 1818 (avy-action-goto r)))) 1819 1820 (defcustom avy-line-insert-style 'above 1821 "How to insert the newly copied/cut line." 1822 :type '(choice 1823 (const :tag "Above" above) 1824 (const :tag "Below" below))) 1825 1826 ;;;###autoload 1827 (defun avy-goto-end-of-line (&optional arg) 1828 "Call `avy-goto-line' and move to the end of the line." 1829 (interactive "p") 1830 (avy-goto-line arg) 1831 (end-of-line)) 1832 1833 ;;;###autoload 1834 (defun avy-copy-line (arg) 1835 "Copy a selected line above the current line. 1836 ARG lines can be used." 1837 (interactive "p") 1838 (let ((initial-window (selected-window))) 1839 (avy-with avy-copy-line 1840 (let* ((start (avy--line)) 1841 (str (buffer-substring-no-properties 1842 start 1843 (save-excursion 1844 (goto-char start) 1845 (move-end-of-line arg) 1846 (point))))) 1847 (select-window initial-window) 1848 (cond ((eq avy-line-insert-style 'above) 1849 (beginning-of-line) 1850 (save-excursion 1851 (insert str "\n"))) 1852 ((eq avy-line-insert-style 'below) 1853 (end-of-line) 1854 (insert "\n" str) 1855 (beginning-of-line)) 1856 (t 1857 (user-error "Unexpected `avy-line-insert-style'"))))))) 1858 1859 ;;;###autoload 1860 (defun avy-move-line (arg) 1861 "Move a selected line above the current line. 1862 ARG lines can be used." 1863 (interactive "p") 1864 (let ((initial-window (selected-window))) 1865 (avy-with avy-move-line 1866 (let ((start (avy--line))) 1867 (save-excursion 1868 (goto-char start) 1869 (kill-whole-line arg)) 1870 (select-window initial-window) 1871 (cond ((eq avy-line-insert-style 'above) 1872 (beginning-of-line) 1873 (save-excursion 1874 (insert 1875 (current-kill 0)))) 1876 ((eq avy-line-insert-style 'below) 1877 (end-of-line) 1878 (newline) 1879 (save-excursion 1880 (insert (substring (current-kill 0) 0 -1)))) 1881 (t 1882 (user-error "Unexpected `avy-line-insert-style'"))))))) 1883 1884 ;;;###autoload 1885 (defun avy-copy-region (arg) 1886 "Select two lines and copy the text between them to point. 1887 1888 The window scope is determined by `avy-all-windows' or 1889 `avy-all-windows-alt' when ARG is non-nil." 1890 (interactive "P") 1891 (let ((initial-window (selected-window))) 1892 (avy-with avy-copy-region 1893 (let* ((beg (save-selected-window 1894 (avy--line arg))) 1895 (end (avy--line arg)) 1896 (str (buffer-substring-no-properties 1897 beg 1898 (save-excursion 1899 (goto-char end) 1900 (line-end-position))))) 1901 (select-window initial-window) 1902 (cond ((eq avy-line-insert-style 'above) 1903 (beginning-of-line) 1904 (save-excursion 1905 (insert str "\n"))) 1906 ((eq avy-line-insert-style 'below) 1907 (end-of-line) 1908 (newline) 1909 (save-excursion 1910 (insert str))) 1911 (t 1912 (user-error "Unexpected `avy-line-insert-style'"))))))) 1913 1914 ;;;###autoload 1915 (defun avy-move-region () 1916 "Select two lines and move the text between them above the current line." 1917 (interactive) 1918 (avy-with avy-move-region 1919 (let* ((initial-window (selected-window)) 1920 (beg (avy--line)) 1921 (end (avy--line)) 1922 text) 1923 (when (> beg end) 1924 (cl-rotatef beg end)) 1925 (setq end (save-excursion 1926 (goto-char end) 1927 (1+ (line-end-position)))) 1928 (setq text (buffer-substring beg end)) 1929 (move-beginning-of-line nil) 1930 (delete-region beg end) 1931 (select-window initial-window) 1932 (insert text)))) 1933 1934 ;;;###autoload 1935 (defun avy-kill-region (arg) 1936 "Select two lines and kill the region between them. 1937 1938 The window scope is determined by `avy-all-windows' or 1939 `avy-all-windows-alt' when ARG is non-nil." 1940 (interactive "P") 1941 (let ((initial-window (selected-window))) 1942 (avy-with avy-kill-region 1943 (let* ((beg (save-selected-window 1944 (list (avy--line arg) (selected-window)))) 1945 (end (list (avy--line arg) (selected-window)))) 1946 (cond 1947 ((not (numberp (car beg))) 1948 (user-error "Fail to select the beginning of region")) 1949 ((not (numberp (car end))) 1950 (user-error "Fail to select the end of region")) 1951 ;; Restrict operation to same window. It's better if it can be 1952 ;; different windows but same buffer; however, then the cloned 1953 ;; buffers with different narrowed regions might cause problem. 1954 ((not (equal (cdr beg) (cdr end))) 1955 (user-error "Selected points are not in the same window")) 1956 ((< (car beg) (car end)) 1957 (save-excursion 1958 (kill-region 1959 (car beg) 1960 (progn (goto-char (car end)) (forward-visible-line 1) (point))))) 1961 (t 1962 (save-excursion 1963 (kill-region 1964 (progn (goto-char (car beg)) (forward-visible-line 1) (point)) 1965 (car end))))))) 1966 (select-window initial-window))) 1967 1968 ;;;###autoload 1969 (defun avy-kill-ring-save-region (arg) 1970 "Select two lines and save the region between them to the kill ring. 1971 The window scope is determined by `avy-all-windows'. 1972 When ARG is non-nil, do the opposite of `avy-all-windows'." 1973 (interactive "P") 1974 (let ((initial-window (selected-window))) 1975 (avy-with avy-kill-ring-save-region 1976 (let* ((beg (save-selected-window 1977 (list (avy--line arg) (selected-window)))) 1978 (end (list (avy--line arg) (selected-window)))) 1979 (cond 1980 ((not (numberp (car beg))) 1981 (user-error "Fail to select the beginning of region")) 1982 ((not (numberp (car end))) 1983 (user-error "Fail to select the end of region")) 1984 ((not (equal (cdr beg) (cdr end))) 1985 (user-error "Selected points are not in the same window")) 1986 ((< (car beg) (car end)) 1987 (save-excursion 1988 (kill-ring-save 1989 (car beg) 1990 (progn (goto-char (car end)) (forward-visible-line 1) (point))))) 1991 (t 1992 (save-excursion 1993 (kill-ring-save 1994 (progn (goto-char (car beg)) (forward-visible-line 1) (point)) 1995 (car end))))))) 1996 (select-window initial-window))) 1997 1998 ;;;###autoload 1999 (defun avy-kill-whole-line (arg) 2000 "Select line and kill the whole selected line. 2001 2002 With a numerical prefix ARG, kill ARG line(s) starting from the 2003 selected line. If ARG is negative, kill backward. 2004 2005 If ARG is zero, kill the selected line but exclude the trailing 2006 newline. 2007 2008 \\[universal-argument] 3 \\[avy-kil-whole-line] kill three lines 2009 starting from the selected line. \\[universal-argument] -3 2010 2011 \\[avy-kill-whole-line] kill three lines backward including the 2012 selected line." 2013 (interactive "P") 2014 (let ((initial-window (selected-window))) 2015 (avy-with avy-kill-whole-line 2016 (let* ((start (avy--line))) 2017 (if (not (numberp start)) 2018 (user-error "Fail to select the line to kill") 2019 (save-excursion (goto-char start) 2020 (kill-whole-line arg))))) 2021 (select-window initial-window))) 2022 2023 ;;;###autoload 2024 (defun avy-kill-ring-save-whole-line (arg) 2025 "Select line and save the whole selected line as if killed, but don’t kill it. 2026 2027 This command is similar to `avy-kill-whole-line', except that it 2028 saves the line(s) as if killed, but does not kill it(them). 2029 2030 With a numerical prefix ARG, kill ARG line(s) starting from the 2031 selected line. If ARG is negative, kill backward. 2032 2033 If ARG is zero, kill the selected line but exclude the trailing 2034 newline." 2035 (interactive "P") 2036 (let ((initial-window (selected-window))) 2037 (avy-with avy-kill-ring-save-whole-line 2038 (let* ((start (avy--line))) 2039 (if (not (numberp start)) 2040 (user-error "Fail to select the line to kill") 2041 (save-excursion 2042 (let ((kill-read-only-ok t) 2043 (buffer-read-only t)) 2044 (goto-char start) 2045 (kill-whole-line arg)))))) 2046 (select-window initial-window))) 2047 2048 ;;;###autoload 2049 (defun avy-setup-default () 2050 "Setup the default shortcuts." 2051 (eval-after-load "isearch" 2052 '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch))) 2053 2054 (defcustom avy-timeout-seconds 0.5 2055 "How many seconds to wait for the second char." 2056 :type 'float) 2057 2058 (defcustom avy-enter-times-out t 2059 "Whether enter exits avy-goto-char-timer early. If nil it matches newline" 2060 :type 'boolean) 2061 2062 (defvar avy-text "" 2063 "Store the input read by `avy--read-candidates'.") 2064 2065 (defun avy--read-candidates (&optional re-builder) 2066 "Read as many chars as possible and return their occurrences. 2067 At least one char must be read, and then repeatedly one next char 2068 may be read if it is entered before `avy-timeout-seconds'. DEL 2069 deletes the last char entered, and RET exits with the currently 2070 read string immediately instead of waiting for another char for 2071 `avy-timeout-seconds'. 2072 The format of the result is the same as that of `avy--regex-candidates'. 2073 This function obeys `avy-all-windows' setting. 2074 RE-BUILDER is a function that takes a string and returns a regex. 2075 When nil, `regexp-quote' is used. 2076 If a group is captured, the first group is highlighted. 2077 Otherwise, the whole regex is highlighted." 2078 (setq avy-text "") 2079 (let ((re-builder (or re-builder #'regexp-quote)) 2080 char break overlays regex) 2081 (unwind-protect 2082 (progn 2083 (avy--make-backgrounds 2084 (avy-window-list)) 2085 (while (and (not break) 2086 (setq char 2087 (read-char (format "%d char%s: " 2088 (length overlays) 2089 (if (string= avy-text "") 2090 avy-text 2091 (format " (%s)" avy-text))) 2092 t 2093 (and (not (string= avy-text "")) 2094 avy-timeout-seconds)))) 2095 ;; Unhighlight 2096 (dolist (ov overlays) 2097 (delete-overlay ov)) 2098 (setq overlays nil) 2099 (cond 2100 ;; Handle RET 2101 ((= char 13) 2102 (if avy-enter-times-out 2103 (setq break t) 2104 (setq avy-text (concat avy-text (list ?\n))))) 2105 ;; Handle C-h, DEL 2106 ((memq char avy-del-last-char-by) 2107 (let ((l (length avy-text))) 2108 (when (>= l 1) 2109 (setq avy-text (substring avy-text 0 (1- l)))))) 2110 ;; Handle ESC 2111 ((= char 27) 2112 (keyboard-quit)) 2113 (t 2114 (setq avy-text (concat avy-text (list char))))) 2115 ;; Highlight 2116 (when (>= (length avy-text) 1) 2117 (let ((case-fold-search 2118 (or avy-case-fold-search (string= avy-text (downcase avy-text)))) 2119 found) 2120 (avy-dowindows current-prefix-arg 2121 (dolist (pair (avy--find-visible-regions 2122 (window-start) 2123 (window-end (selected-window) t))) 2124 (save-excursion 2125 (goto-char (car pair)) 2126 (setq regex (funcall re-builder avy-text)) 2127 (while (re-search-forward regex (cdr pair) t) 2128 (unless (not (avy--visible-p (1- (point)))) 2129 (let* ((idx (if (= (length (match-data)) 4) 1 0)) 2130 (ov (make-overlay 2131 (match-beginning idx) (match-end idx)))) 2132 (setq found t) 2133 (push ov overlays) 2134 (overlay-put 2135 ov 'window (selected-window)) 2136 (overlay-put 2137 ov 'face 'avy-goto-char-timer-face))))))) 2138 ;; No matches at all, so there's surely a typo in the input. 2139 (unless found (beep))))) 2140 (nreverse (mapcar (lambda (ov) 2141 (cons (cons (overlay-start ov) 2142 (overlay-end ov)) 2143 (overlay-get ov 'window))) 2144 overlays))) 2145 (dolist (ov overlays) 2146 (delete-overlay ov)) 2147 (avy--done)))) 2148 2149 (defvar avy--old-cands nil) 2150 2151 ;;;###autoload 2152 (defun avy-goto-char-timer (&optional arg) 2153 "Read one or many consecutive chars and jump to the first one. 2154 The window scope is determined by `avy-all-windows' (ARG negates it)." 2155 (interactive "P") 2156 (let ((avy-all-windows (if arg 2157 (not avy-all-windows) 2158 avy-all-windows))) 2159 (avy-with avy-goto-char-timer 2160 (setq avy--old-cands (avy--read-candidates)) 2161 (avy-process avy--old-cands)))) 2162 2163 (defun avy-push-mark () 2164 "Store the current point and window." 2165 (let ((inhibit-message t)) 2166 (ring-insert avy-ring 2167 (cons (point) (selected-window))) 2168 (unless (region-active-p) 2169 (push-mark)))) 2170 2171 (defun avy-pop-mark () 2172 "Jump back to the last location of `avy-push-mark'." 2173 (interactive) 2174 (let (res) 2175 (condition-case nil 2176 (progn 2177 (while (not (window-live-p 2178 (cdr (setq res (ring-remove avy-ring 0)))))) 2179 (let* ((window (cdr res)) 2180 (frame (window-frame window))) 2181 (when (and (frame-live-p frame) 2182 (not (eq frame (selected-frame)))) 2183 (select-frame-set-input-focus frame)) 2184 (select-window window) 2185 (goto-char (car res)))) 2186 (error 2187 (set-mark-command 4))))) 2188 2189 ;;;###autoload 2190 (defun avy-transpose-lines-in-region () 2191 "Transpose lines in the active region." 2192 (interactive) 2193 (when (and (use-region-p) (> (count-lines (region-beginning) (region-end)) 1)) 2194 (let ((avy-all-windows nil) 2195 (fst-line-point (avy--line nil (region-beginning) (region-end)))) 2196 (when fst-line-point 2197 (let ((snd-line-point (avy--line nil (region-beginning) (region-end)))) 2198 (when snd-line-point 2199 (save-mark-and-excursion 2200 (push-mark fst-line-point) 2201 (goto-char snd-line-point) 2202 (transpose-lines 0)) 2203 (avy-transpose-lines-in-region))))))) 2204 2205 ;; ** Org-mode 2206 (defvar org-reverse-note-order) 2207 (declare-function org-refile "org") 2208 (declare-function org-back-to-heading "org") 2209 (declare-function org-reveal "org") 2210 2211 (defvar org-after-refile-insert-hook) 2212 2213 (defun avy-org-refile-as-child () 2214 "Refile current heading as first child of heading selected with `avy.'" 2215 ;; Inspired by `org-teleport': http://kitchingroup.cheme.cmu.edu/blog/2016/03/18/Org-teleport-headlines/ 2216 (interactive) 2217 (let* ((org-reverse-note-order t) 2218 (marker (save-excursion 2219 (avy-with avy-goto-line 2220 (unless (eq 't (avy-jump (rx bol (1+ "*") (1+ space)))) 2221 ;; `avy-jump' returns t when aborted with C-g. 2222 (point-marker))))) 2223 (filename (buffer-file-name (or (buffer-base-buffer (marker-buffer marker)) 2224 (marker-buffer marker)))) 2225 (rfloc (list nil filename nil marker)) 2226 ;; Ensure the refiled heading is visible. 2227 (org-after-refile-insert-hook (if (member 'org-reveal org-after-refile-insert-hook) 2228 org-after-refile-insert-hook 2229 (cons #'org-reveal org-after-refile-insert-hook)))) 2230 (when marker 2231 ;; Only attempt refile if avy session was not aborted. 2232 (org-refile nil nil rfloc)))) 2233 2234 (defun avy-org-goto-heading-timer (&optional arg) 2235 "Read one or many characters and jump to matching Org headings. 2236 The window scope is determined by `avy-all-windows' (ARG negates it)." 2237 (interactive "P") 2238 (let ((avy-all-windows (if arg 2239 (not avy-all-windows) 2240 avy-all-windows))) 2241 (avy-with avy-goto-char-timer 2242 (avy-process 2243 (avy--read-candidates 2244 (lambda (input) 2245 (format "^\\*+ .*\\(%s\\)" input)))) 2246 (org-back-to-heading)))) 2247 2248 (provide 'avy) 2249 2250 ;;; avy.el ends here