Personal emacs config
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

2145 lines
78 KiB

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