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