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