2018-09-10 20:51:14 +02:00
|
|
|
|
;;; avy.el --- Jump to arbitrary positions in visible text and select text quickly. -*- lexical-binding: t -*-
|
|
|
|
|
|
|
|
|
|
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
|
|
|
|
|
|
|
|
|
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
|
|
|
|
|
;; URL: https://github.com/abo-abo/avy
|
2018-10-02 15:54:39 +02:00
|
|
|
|
;; Package-Version: 20180814.2121
|
2018-09-10 20:51:14 +02:00
|
|
|
|
;; Version: 0.4.0
|
|
|
|
|
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
|
|
|
|
|
;; Keywords: point, location
|
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
|
|
|
;; any later version.
|
|
|
|
|
|
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; For a full copy of the GNU General Public License
|
|
|
|
|
;; see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
;;
|
|
|
|
|
;; With Avy, you can move point to any position in Emacs – even in a
|
|
|
|
|
;; different window – using very few keystrokes. For this, you look at
|
|
|
|
|
;; the position where you want point to be, invoke Avy, and then enter
|
|
|
|
|
;; the sequence of characters displayed at that position.
|
|
|
|
|
;;
|
|
|
|
|
;; If the position you want to jump to can be determined after only
|
|
|
|
|
;; issuing a single keystroke, point is moved to the desired position
|
|
|
|
|
;; immediately after that keystroke. In case this isn't possible, the
|
|
|
|
|
;; sequence of keystrokes you need to enter is comprised of more than
|
|
|
|
|
;; one character. Avy uses a decision tree where each candidate position
|
|
|
|
|
;; is a leaf and each edge is described by a character which is distinct
|
|
|
|
|
;; per level of the tree. By entering those characters, you navigate the
|
|
|
|
|
;; tree, quickly arriving at the desired candidate position, such that
|
|
|
|
|
;; Avy can move point to it.
|
|
|
|
|
;;
|
|
|
|
|
;; Note that this only makes sense for positions you are able to see
|
|
|
|
|
;; when invoking Avy. These kinds of positions are supported:
|
|
|
|
|
;;
|
|
|
|
|
;; * character positions
|
|
|
|
|
;; * word or subword start positions
|
|
|
|
|
;; * line beginning positions
|
|
|
|
|
;; * link positions
|
|
|
|
|
;; * window positions
|
|
|
|
|
;;
|
|
|
|
|
;; If you're familiar with the popular `ace-jump-mode' package, this
|
|
|
|
|
;; package does all that and more, without the implementation
|
|
|
|
|
;; headache.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
(require 'cl-lib)
|
|
|
|
|
(require 'ring)
|
|
|
|
|
|
|
|
|
|
;;* Customization
|
|
|
|
|
(defgroup avy nil
|
|
|
|
|
"Jump to things tree-style."
|
|
|
|
|
:group 'convenience
|
|
|
|
|
:prefix "avy-")
|
|
|
|
|
|
|
|
|
|
(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
|
|
|
|
|
"Default keys for jumping.
|
|
|
|
|
Any key is either a character representing a self-inserting
|
|
|
|
|
key (letters, digits, punctuation, etc.) or a symbol denoting a
|
|
|
|
|
non-printing key like an arrow key (left, right, up, down). For
|
|
|
|
|
non-printing keys, a corresponding entry in
|
|
|
|
|
`avy-key-to-char-alist' must exist in order to visualize the key
|
|
|
|
|
in the avy overlays.
|
|
|
|
|
|
|
|
|
|
If `avy-style' is set to words, make sure there are at least three
|
|
|
|
|
keys different than the following: a, e, i, o, u, y"
|
|
|
|
|
:type '(repeat :tag "Keys" (choice
|
|
|
|
|
(character :tag "char")
|
|
|
|
|
(symbol :tag "non-printing key"))))
|
|
|
|
|
|
2018-10-02 15:54:39 +02:00
|
|
|
|
(defconst avy--key-type
|
|
|
|
|
'(choice :tag "Command"
|
|
|
|
|
(const avy-goto-char)
|
|
|
|
|
(const avy-goto-char-2)
|
|
|
|
|
(const avy-isearch)
|
|
|
|
|
(const avy-goto-line)
|
|
|
|
|
(const avy-goto-subword-0)
|
|
|
|
|
(const avy-goto-subword-1)
|
|
|
|
|
(const avy-goto-word-0)
|
|
|
|
|
(const avy-goto-word-1)
|
|
|
|
|
(const avy-copy-line)
|
|
|
|
|
(const avy-copy-region)
|
|
|
|
|
(const avy-move-line)
|
|
|
|
|
(const avy-move-region)
|
|
|
|
|
(const avy-kill-whole-line)
|
|
|
|
|
(const avy-kill-region)
|
|
|
|
|
(const avy-kill-ring-save-whole-line)
|
|
|
|
|
(const avy-kill-ring-save-region)
|
|
|
|
|
(function :tag "Other command")))
|
|
|
|
|
|
2018-09-10 20:51:14 +02:00
|
|
|
|
(defcustom avy-keys-alist nil
|
|
|
|
|
"Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
|
2018-10-02 15:54:39 +02:00
|
|
|
|
:type `(alist
|
|
|
|
|
:key-type ,avy--key-type
|
2018-09-10 20:51:14 +02:00
|
|
|
|
:value-type (repeat :tag "Keys" character)))
|
|
|
|
|
|
2018-10-02 15:54:39 +02:00
|
|
|
|
(defcustom avy-orders-alist '((avy-goto-char . avy-order-closest))
|
|
|
|
|
"Alist of candidate ordering functions.
|
|
|
|
|
Usually, candidates appear in their point position order."
|
|
|
|
|
:type `(alist
|
|
|
|
|
:key-type ,avy--key-type
|
|
|
|
|
:value-type function))
|
|
|
|
|
|
2018-09-10 20:51:14 +02:00
|
|
|
|
(defcustom avy-words
|
|
|
|
|
'("am" "by" "if" "is" "it" "my" "ox" "up"
|
|
|
|
|
"ace" "act" "add" "age" "ago" "aim" "air" "ale" "all" "and" "ant" "any"
|
|
|
|
|
"ape" "apt" "arc" "are" "arm" "art" "ash" "ate" "awe" "axe" "bad" "bag"
|
|
|
|
|
"ban" "bar" "bat" "bay" "bed" "bee" "beg" "bet" "bid" "big" "bit" "bob"
|
|
|
|
|
"bot" "bow" "box" "boy" "but" "cab" "can" "cap" "car" "cat" "cog" "cop"
|
|
|
|
|
"cow" "cry" "cup" "cut" "day" "dew" "did" "die" "dig" "dim" "dip" "dog"
|
|
|
|
|
"dot" "dry" "dub" "dug" "dye" "ear" "eat" "eel" "egg" "ego" "elf" "eve"
|
|
|
|
|
"eye" "fan" "far" "fat" "fax" "fee" "few" "fin" "fit" "fix" "flu" "fly"
|
|
|
|
|
"foe" "fog" "for" "fox" "fry" "fun" "fur" "gag" "gap" "gas" "gel" "gem"
|
|
|
|
|
"get" "gig" "gin" "gnu" "god" "got" "gum" "gun" "gut" "guy" "gym" "had"
|
|
|
|
|
"hag" "ham" "has" "hat" "her" "hid" "him" "hip" "his" "hit" "hop" "hot"
|
|
|
|
|
"how" "hub" "hue" "hug" "hut" "ice" "icy" "imp" "ink" "inn" "ion" "ire"
|
|
|
|
|
"ivy" "jab" "jam" "jar" "jaw" "jet" "job" "jog" "joy" "key" "kid" "kit"
|
|
|
|
|
"lag" "lap" "lay" "let" "lid" "lie" "lip" "lit" "lob" "log" "lot" "low"
|
|
|
|
|
"mad" "man" "map" "mat" "may" "men" "met" "mix" "mob" "mop" "mud" "mug"
|
|
|
|
|
"nag" "nap" "new" "nil" "nod" "nor" "not" "now" "nun" "oak" "odd" "off"
|
|
|
|
|
"oil" "old" "one" "orb" "ore" "ork" "our" "out" "owl" "own" "pad" "pan"
|
|
|
|
|
"par" "pat" "paw" "pay" "pea" "pen" "pet" "pig" "pin" "pit" "pod" "pot"
|
|
|
|
|
"pry" "pub" "pun" "put" "rag" "ram" "ran" "rat" "raw" "ray" "red" "rib"
|
|
|
|
|
"rim" "rip" "rob" "rod" "rot" "row" "rub" "rug" "rum" "run" "sad" "sat"
|
|
|
|
|
"saw" "say" "sea" "see" "sew" "she" "shy" "sin" "sip" "sit" "six" "ski"
|
|
|
|
|
"sky" "sly" "sob" "son" "soy" "spy" "sum" "sun" "tab" "tad" "tag" "tan"
|
|
|
|
|
"tap" "tar" "tax" "tea" "the" "tie" "tin" "tip" "toe" "ton" "too" "top"
|
|
|
|
|
"toy" "try" "tub" "two" "urn" "use" "van" "war" "was" "wax" "way" "web"
|
|
|
|
|
"wed" "wet" "who" "why" "wig" "win" "wit" "woe" "won" "wry" "you" "zap"
|
|
|
|
|
"zip" "zoo")
|
|
|
|
|
"Words to use in case `avy-style' is set to `words'.
|
|
|
|
|
Every word should contain at least one vowel i.e. one of the following
|
|
|
|
|
characters: a, e, i, o, u, y
|
|
|
|
|
They do not have to be sorted but no word should be a prefix of another one."
|
|
|
|
|
:type '(repeat string))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-style 'at-full
|
|
|
|
|
"The default method of displaying the overlays.
|
|
|
|
|
Use `avy-styles-alist' to customize this per-command."
|
|
|
|
|
:type '(choice
|
|
|
|
|
(const :tag "Pre" pre)
|
|
|
|
|
(const :tag "At" at)
|
|
|
|
|
(const :tag "At Full" at-full)
|
|
|
|
|
(const :tag "Post" post)
|
|
|
|
|
(const :tag "De Bruijn" de-bruijn)
|
|
|
|
|
(const :tag "Words" words)))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-styles-alist nil
|
|
|
|
|
"Alist of avy-jump commands to the style for each command.
|
|
|
|
|
If the commands isn't on the list, `avy-style' is used."
|
|
|
|
|
:type '(alist
|
|
|
|
|
:key-type (choice :tag "Command"
|
|
|
|
|
(const avy-goto-char)
|
|
|
|
|
(const avy-goto-char-2)
|
|
|
|
|
(const avy-isearch)
|
|
|
|
|
(const avy-goto-line)
|
|
|
|
|
(const avy-goto-subword-0)
|
|
|
|
|
(const avy-goto-subword-1)
|
|
|
|
|
(const avy-goto-word-0)
|
|
|
|
|
(const avy-goto-word-1)
|
|
|
|
|
(const avy-copy-line)
|
|
|
|
|
(const avy-copy-region)
|
|
|
|
|
(const avy-move-line)
|
|
|
|
|
(const avy-move-region)
|
|
|
|
|
(const avy-kill-whole-line)
|
|
|
|
|
(const avy-kill-region)
|
|
|
|
|
(const avy-kill-ring-save-whole-line)
|
|
|
|
|
(const avy-kill-ring-save-region)
|
|
|
|
|
(function :tag "Other command"))
|
|
|
|
|
:value-type (choice
|
|
|
|
|
(const :tag "Pre" pre)
|
|
|
|
|
(const :tag "At" at)
|
|
|
|
|
(const :tag "At Full" at-full)
|
|
|
|
|
(const :tag "Post" post)
|
|
|
|
|
(const :tag "De Bruijn" de-bruijn)
|
|
|
|
|
(const :tag "Words" words))))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-dispatch-alist
|
|
|
|
|
'((?x . avy-action-kill-move)
|
|
|
|
|
(?X . avy-action-kill-stay)
|
|
|
|
|
(?t . avy-action-teleport)
|
|
|
|
|
(?m . avy-action-mark)
|
|
|
|
|
(?n . avy-action-copy)
|
|
|
|
|
(?y . avy-action-yank)
|
|
|
|
|
(?i . avy-action-ispell)
|
|
|
|
|
(?z . avy-action-zap-to-char))
|
|
|
|
|
"List of actions for `avy-handler-default'.
|
|
|
|
|
|
|
|
|
|
Each item is (KEY . ACTION). When KEY not on `avy-keys' is
|
|
|
|
|
pressed during the dispatch, ACTION is set to replace the default
|
|
|
|
|
`avy-action-goto' once a candidate is finally selected."
|
|
|
|
|
:type
|
|
|
|
|
'(alist
|
|
|
|
|
:key-type (choice (character :tag "Char"))
|
|
|
|
|
:value-type (choice
|
|
|
|
|
(const :tag "Mark" avy-action-mark)
|
|
|
|
|
(const :tag "Copy" avy-action-copy)
|
|
|
|
|
(const :tag "Kill and move point" avy-action-kill-move)
|
|
|
|
|
(const :tag "Kill" avy-action-kill-stay))))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-background nil
|
|
|
|
|
"When non-nil, a gray background will be added during the selection."
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom avy-all-windows t
|
|
|
|
|
"Determine the list of windows to consider in search of candidates."
|
|
|
|
|
:type
|
|
|
|
|
'(choice
|
|
|
|
|
(const :tag "All Frames" all-frames)
|
|
|
|
|
(const :tag "This Frame" t)
|
|
|
|
|
(const :tag "This Window" nil)))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-case-fold-search t
|
|
|
|
|
"Non-nil if searches should ignore case."
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]"
|
|
|
|
|
"Regexp of punctuation chars that count as word starts for `avy-goto-word-1.
|
|
|
|
|
When nil, punctuation chars will not be matched.
|
|
|
|
|
|
|
|
|
|
\"[!-/:-@[-`{-~]\" will match all printable punctuation chars."
|
|
|
|
|
:type 'regexp)
|
|
|
|
|
|
|
|
|
|
(defcustom avy-goto-word-0-regexp "\\b\\sw"
|
|
|
|
|
"Regexp that determines positions for `avy-goto-word-0'."
|
|
|
|
|
:type '(choice
|
|
|
|
|
(const :tag "Default" "\\b\\sw")
|
|
|
|
|
(const :tag "Symbol" "\\_<\\(\\sw\\|\\s_\\)")
|
|
|
|
|
(const :tag "Not whitespace" "[^ \r\n\t]+")
|
|
|
|
|
(regexp :tag "Regex")))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode)
|
|
|
|
|
"List of modes to ignore when searching for candidates.
|
|
|
|
|
Typically, these modes don't use the text representation."
|
|
|
|
|
:type 'list)
|
|
|
|
|
|
|
|
|
|
(defvar avy-ring (make-ring 20)
|
|
|
|
|
"Hold the window and point history.")
|
|
|
|
|
|
|
|
|
|
(defvar avy-translate-char-function #'identity
|
|
|
|
|
"Function to translate user input key into another key.
|
|
|
|
|
For example, to make SPC do the same as ?a, use
|
|
|
|
|
\(lambda (c) (if (= c 32) ?a c)).")
|
|
|
|
|
|
|
|
|
|
(defface avy-lead-face-0
|
|
|
|
|
'((t (:foreground "white" :background "#4f57f9")))
|
|
|
|
|
"Face used for first non-terminating leading chars.")
|
|
|
|
|
|
|
|
|
|
(defface avy-lead-face-1
|
|
|
|
|
'((t (:foreground "white" :background "gray")))
|
|
|
|
|
"Face used for matched leading chars.")
|
|
|
|
|
|
|
|
|
|
(defface avy-lead-face-2
|
|
|
|
|
'((t (:foreground "white" :background "#f86bf3")))
|
|
|
|
|
"Face used for leading chars.")
|
|
|
|
|
|
|
|
|
|
(defface avy-lead-face
|
|
|
|
|
'((t (:foreground "white" :background "#e52b50")))
|
|
|
|
|
"Face used for the leading chars.")
|
|
|
|
|
|
|
|
|
|
(defface avy-background-face
|
|
|
|
|
'((t (:foreground "gray40")))
|
|
|
|
|
"Face for whole window background during selection.")
|
|
|
|
|
|
|
|
|
|
(defface avy-goto-char-timer-face
|
|
|
|
|
'((t (:inherit highlight)))
|
|
|
|
|
"Face for matches during reading chars using `avy-goto-char-timer'.")
|
|
|
|
|
|
|
|
|
|
(defconst avy-lead-faces '(avy-lead-face
|
|
|
|
|
avy-lead-face-0
|
|
|
|
|
avy-lead-face-2
|
|
|
|
|
avy-lead-face
|
|
|
|
|
avy-lead-face-0
|
|
|
|
|
avy-lead-face-2)
|
|
|
|
|
"Face sequence for `avy--overlay-at-full'.")
|
|
|
|
|
|
|
|
|
|
(defvar avy-key-to-char-alist '((left . ?◀)
|
|
|
|
|
(right . ?▶)
|
|
|
|
|
(up . ?▲)
|
|
|
|
|
(down . ?▼)
|
|
|
|
|
(prior . ?△)
|
|
|
|
|
(next . ?▽))
|
|
|
|
|
"An alist from non-character keys to printable chars used in avy overlays.
|
|
|
|
|
This alist must contain all keys used in `avy-keys' which are not
|
|
|
|
|
self-inserting keys and thus aren't read as characters.")
|
|
|
|
|
|
|
|
|
|
;;* Internals
|
|
|
|
|
;;** Tree
|
|
|
|
|
(defmacro avy-multipop (lst n)
|
|
|
|
|
"Remove LST's first N elements and return them."
|
|
|
|
|
`(if (<= (length ,lst) ,n)
|
|
|
|
|
(prog1 ,lst
|
|
|
|
|
(setq ,lst nil))
|
|
|
|
|
(prog1 ,lst
|
|
|
|
|
(setcdr
|
|
|
|
|
(nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
|
|
|
|
|
nil))))
|
|
|
|
|
|
|
|
|
|
(defun avy--de-bruijn (keys n)
|
|
|
|
|
"De Bruijn sequence for alphabet KEYS and subsequences of length N."
|
|
|
|
|
(let* ((k (length keys))
|
|
|
|
|
(a (make-list (* n k) 0))
|
|
|
|
|
sequence)
|
|
|
|
|
(cl-labels ((db (T p)
|
|
|
|
|
(if (> T n)
|
|
|
|
|
(if (eq (% n p) 0)
|
|
|
|
|
(setq sequence
|
|
|
|
|
(append sequence
|
|
|
|
|
(cl-subseq a 1 (1+ p)))))
|
|
|
|
|
(setf (nth T a) (nth (- T p) a))
|
|
|
|
|
(db (1+ T) p)
|
|
|
|
|
(cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
|
|
|
|
|
(setf (nth T a) j)
|
|
|
|
|
(db (1+ T) T)))))
|
|
|
|
|
(db 1 1)
|
|
|
|
|
(mapcar (lambda (n)
|
|
|
|
|
(nth n keys))
|
|
|
|
|
sequence))))
|
|
|
|
|
|
|
|
|
|
(defun avy--path-alist-1 (lst seq-len keys)
|
|
|
|
|
"Build a De Bruin sequence from LST.
|
|
|
|
|
SEQ-LEN is how many elements of KEYS it takes to identify a match."
|
|
|
|
|
(let ((db-seq (avy--de-bruijn keys seq-len))
|
|
|
|
|
prev-pos prev-seq prev-win path-alist)
|
|
|
|
|
;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to
|
|
|
|
|
;; the end.
|
|
|
|
|
(setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len))))
|
|
|
|
|
(cl-labels ((subseq-and-pop ()
|
|
|
|
|
(when (nth (1- seq-len) db-seq)
|
|
|
|
|
(prog1 (cl-subseq db-seq 0 seq-len)
|
|
|
|
|
(pop db-seq)))))
|
|
|
|
|
(while lst
|
|
|
|
|
(let* ((cur (car lst))
|
|
|
|
|
(pos (cond
|
|
|
|
|
;; ace-window has matches of the form (pos . wnd)
|
|
|
|
|
((integerp (car cur)) (car cur))
|
|
|
|
|
;; avy-jump have form ((start . end) . wnd)
|
|
|
|
|
((consp (car cur)) (caar cur))
|
|
|
|
|
(t (error "Unexpected match representation: %s" cur))))
|
|
|
|
|
(win (cdr cur))
|
|
|
|
|
(path (if prev-pos
|
|
|
|
|
(let ((diff (if (eq win prev-win)
|
|
|
|
|
(- pos prev-pos)
|
|
|
|
|
0)))
|
|
|
|
|
(when (and (> diff 0) (< diff seq-len))
|
|
|
|
|
(while (and (nth (1- seq-len) db-seq)
|
|
|
|
|
(not
|
|
|
|
|
(eq 0
|
|
|
|
|
(cl-search
|
|
|
|
|
(cl-subseq prev-seq diff)
|
|
|
|
|
(cl-subseq db-seq 0 seq-len)))))
|
|
|
|
|
(pop db-seq)))
|
|
|
|
|
(subseq-and-pop))
|
|
|
|
|
(subseq-and-pop))))
|
|
|
|
|
(if (not path)
|
|
|
|
|
(setq lst nil
|
|
|
|
|
path-alist nil)
|
|
|
|
|
(push (cons path (car lst)) path-alist)
|
|
|
|
|
(setq prev-pos pos
|
|
|
|
|
prev-seq path
|
|
|
|
|
prev-win win
|
|
|
|
|
lst (cdr lst))))))
|
|
|
|
|
(nreverse path-alist)))
|
|
|
|
|
|
2018-10-02 15:54:39 +02:00
|
|
|
|
(defun avy-order-closest (x)
|
|
|
|
|
(abs (- (caar x) (point))))
|
|
|
|
|
|
|
|
|
|
(defvar avy-command nil
|
|
|
|
|
"Store the current command symbol.
|
|
|
|
|
E.g. 'avy-goto-line or 'avy-goto-char.")
|
|
|
|
|
|
2018-09-10 20:51:14 +02:00
|
|
|
|
(defun avy-tree (lst keys)
|
|
|
|
|
"Coerce LST into a balanced tree.
|
|
|
|
|
The degree of the tree is the length of KEYS.
|
|
|
|
|
KEYS are placed appropriately on internal nodes."
|
2018-10-02 15:54:39 +02:00
|
|
|
|
(let* ((len (length keys))
|
|
|
|
|
(order-fn (cdr (assq avy-command avy-orders-alist)))
|
|
|
|
|
(lst (if order-fn
|
|
|
|
|
(cl-sort lst #'< :key order-fn)
|
|
|
|
|
lst)))
|
2018-09-10 20:51:14 +02:00
|
|
|
|
(cl-labels
|
|
|
|
|
((rd (ls)
|
|
|
|
|
(let ((ln (length ls)))
|
|
|
|
|
(if (< ln len)
|
|
|
|
|
(cl-pairlis keys
|
|
|
|
|
(mapcar (lambda (x) (cons 'leaf x)) ls))
|
|
|
|
|
(let ((ks (copy-sequence keys))
|
|
|
|
|
res)
|
|
|
|
|
(dolist (s (avy-subdiv ln len))
|
|
|
|
|
(push (cons (pop ks)
|
|
|
|
|
(if (eq s 1)
|
|
|
|
|
(cons 'leaf (pop ls))
|
|
|
|
|
(rd (avy-multipop ls s))))
|
|
|
|
|
res))
|
|
|
|
|
(nreverse res))))))
|
|
|
|
|
(rd lst))))
|
|
|
|
|
|
|
|
|
|
(defun avy-subdiv (n b)
|
|
|
|
|
"Distribute N in B terms in a balanced way."
|
|
|
|
|
(let* ((p (1- (floor (+ (log n b) 1e-6))))
|
|
|
|
|
(x1 (expt b p))
|
|
|
|
|
(x2 (* b x1))
|
|
|
|
|
(delta (- n x2))
|
|
|
|
|
(n2 (/ delta (- x2 x1)))
|
|
|
|
|
(n1 (- b n2 1)))
|
|
|
|
|
(append
|
|
|
|
|
(make-list n1 x1)
|
|
|
|
|
(list
|
|
|
|
|
(- n (* n1 x1) (* n2 x2)))
|
|
|
|
|
(make-list n2 x2))))
|
|
|
|
|
|
|
|
|
|
(defun avy-traverse (tree walker &optional recur-key)
|
|
|
|
|
"Traverse TREE generated by `avy-tree'.
|
|
|
|
|
WALKER is a function that takes KEYS and LEAF.
|
|
|
|
|
|
|
|
|
|
RECUR-KEY is used in recursion.
|
|
|
|
|
|
|
|
|
|
LEAF is a member of LST argument of `avy-tree'.
|
|
|
|
|
|
|
|
|
|
KEYS is the path from the root of `avy-tree' to LEAF."
|
|
|
|
|
(dolist (br tree)
|
|
|
|
|
(let ((key (cons (car br) recur-key)))
|
|
|
|
|
(if (eq (cadr br) 'leaf)
|
|
|
|
|
(funcall walker key (cddr br))
|
|
|
|
|
(avy-traverse (cdr br) walker key)))))
|
|
|
|
|
|
|
|
|
|
(defvar avy-action nil
|
|
|
|
|
"Function to call at the end of select.")
|
|
|
|
|
|
|
|
|
|
(defun avy-handler-default (char)
|
|
|
|
|
"The default handler for a bad CHAR."
|
|
|
|
|
(let (dispatch)
|
|
|
|
|
(cond ((setq dispatch (assoc char avy-dispatch-alist))
|
|
|
|
|
(setq avy-action (cdr dispatch))
|
|
|
|
|
(throw 'done 'restart))
|
|
|
|
|
((memq char '(27 ?\C-g))
|
|
|
|
|
;; exit silently
|
|
|
|
|
(throw 'done 'exit))
|
|
|
|
|
((mouse-event-p char)
|
|
|
|
|
(signal 'user-error (list "Mouse event not handled" char)))
|
|
|
|
|
(t
|
|
|
|
|
(signal 'user-error (list "No such candidate"
|
|
|
|
|
(if (characterp char) (string char) char)))
|
|
|
|
|
(throw 'done nil)))))
|
|
|
|
|
|
|
|
|
|
(defvar avy-handler-function 'avy-handler-default
|
|
|
|
|
"A function to call for a bad `read-key' in `avy-read'.")
|
|
|
|
|
|
|
|
|
|
(defvar avy-current-path ""
|
|
|
|
|
"Store the current incomplete path during `avy-read'.")
|
|
|
|
|
|
|
|
|
|
(defun avy-mouse-event-window (char)
|
|
|
|
|
"If CHAR is a mouse event, return the window of the event if any or the selected window.
|
|
|
|
|
Return nil if not a mouse event."
|
|
|
|
|
(when (mouse-event-p char)
|
|
|
|
|
(cond ((windowp (posn-window (event-start char)))
|
|
|
|
|
(posn-window (event-start char)))
|
|
|
|
|
((framep (posn-window (event-start char)))
|
|
|
|
|
(frame-selected-window (posn-window (event-start char))))
|
|
|
|
|
(t (selected-window)))))
|
|
|
|
|
|
|
|
|
|
(defun avy-read (tree display-fn cleanup-fn)
|
|
|
|
|
"Select a leaf from TREE using consecutive `read-char'.
|
|
|
|
|
|
|
|
|
|
DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
|
|
|
|
|
associated with CHAR will be selected if CHAR is pressed. This is
|
|
|
|
|
commonly done by adding a CHAR overlay at LEAF position.
|
|
|
|
|
|
|
|
|
|
CLEANUP-FN should take no arguments and remove the effects of
|
|
|
|
|
multiple DISPLAY-FN invocations."
|
|
|
|
|
(catch 'done
|
|
|
|
|
(setq avy-current-path "")
|
|
|
|
|
(while tree
|
|
|
|
|
(let ((avy--leafs nil))
|
|
|
|
|
(avy-traverse tree
|
|
|
|
|
(lambda (path leaf)
|
|
|
|
|
(push (cons path leaf) avy--leafs)))
|
|
|
|
|
(dolist (x avy--leafs)
|
|
|
|
|
(funcall display-fn (car x) (cdr x))))
|
|
|
|
|
(let ((char (funcall avy-translate-char-function (read-key)))
|
|
|
|
|
window
|
|
|
|
|
branch)
|
|
|
|
|
(funcall cleanup-fn)
|
|
|
|
|
(if (setq window (avy-mouse-event-window char))
|
|
|
|
|
(throw 'done (cons char window))
|
|
|
|
|
;; Ensure avy-current-path stores the full path prior to
|
|
|
|
|
;; exit so other packages can utilize its value.
|
|
|
|
|
(setq avy-current-path
|
|
|
|
|
(concat avy-current-path (string (avy--key-to-char char))))
|
|
|
|
|
(if (setq branch (assoc char tree))
|
|
|
|
|
(if (eq (car (setq tree (cdr branch))) 'leaf)
|
|
|
|
|
(throw 'done (cdr tree)))
|
|
|
|
|
(funcall avy-handler-function char)))))))
|
|
|
|
|
|
|
|
|
|
(defun avy-read-de-bruijn (lst keys)
|
|
|
|
|
"Select from LST dispatching on KEYS."
|
|
|
|
|
;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n
|
|
|
|
|
;; (the path length) usable as paths, thus that's the lower bound. Due to
|
|
|
|
|
;; partially overlapping matches, not all subsequences may be usable, so it's
|
|
|
|
|
;; possible that the path-len must be incremented, e.g., if we're matching
|
|
|
|
|
;; for x and a buffer contains xaxbxcx only every second subsequence is
|
|
|
|
|
;; usable for the four matches.
|
|
|
|
|
(catch 'done
|
|
|
|
|
(let* ((path-len (ceiling (log (length lst) (length keys))))
|
|
|
|
|
(alist (avy--path-alist-1 lst path-len keys)))
|
|
|
|
|
(while (not alist)
|
|
|
|
|
(cl-incf path-len)
|
|
|
|
|
(setq alist (avy--path-alist-1 lst path-len keys)))
|
|
|
|
|
(let* ((len (length (caar alist)))
|
|
|
|
|
(i 0))
|
|
|
|
|
(setq avy-current-path "")
|
|
|
|
|
(while (< i len)
|
|
|
|
|
(dolist (x (reverse alist))
|
|
|
|
|
(avy--overlay-at-full (reverse (car x)) (cdr x)))
|
|
|
|
|
(let ((char (funcall avy-translate-char-function (read-key))))
|
|
|
|
|
(avy--remove-leading-chars)
|
|
|
|
|
(setq alist
|
|
|
|
|
(delq nil
|
|
|
|
|
(mapcar (lambda (x)
|
|
|
|
|
(when (eq (caar x) char)
|
|
|
|
|
(cons (cdr (car x)) (cdr x))))
|
|
|
|
|
alist)))
|
|
|
|
|
(setq avy-current-path
|
|
|
|
|
(concat avy-current-path (string (avy--key-to-char char))))
|
|
|
|
|
(cl-incf i)
|
|
|
|
|
(unless alist
|
|
|
|
|
(funcall avy-handler-function char))))
|
|
|
|
|
(cdar alist)))))
|
|
|
|
|
|
|
|
|
|
(defun avy-read-words (lst words)
|
|
|
|
|
"Select from LST using WORDS."
|
|
|
|
|
(catch 'done
|
|
|
|
|
(let ((num-words (length words))
|
|
|
|
|
(num-entries (length lst))
|
|
|
|
|
alist)
|
|
|
|
|
;; If there are not enough words to cover all the candidates,
|
|
|
|
|
;; we use a De Bruijn sequence to generate the remaining ones.
|
|
|
|
|
(when (< num-words num-entries)
|
|
|
|
|
(let ((keys avy-keys)
|
|
|
|
|
(bad-keys '(?a ?e ?i ?o ?u ?y))
|
|
|
|
|
(path-len 1)
|
|
|
|
|
(num-remaining (- num-entries num-words))
|
|
|
|
|
tmp-alist)
|
|
|
|
|
;; Delete all keys which could lead to duplicates.
|
|
|
|
|
;; We want at least three keys left to work with.
|
|
|
|
|
(dolist (x bad-keys)
|
|
|
|
|
(when (memq x keys)
|
|
|
|
|
(setq keys (delq ?a keys))))
|
|
|
|
|
(when (< (length keys) 3)
|
|
|
|
|
(signal 'user-error
|
|
|
|
|
'("Please add more keys to the variable `avy-keys'.")))
|
|
|
|
|
;; Generate the sequence and add the keys to the existing words.
|
|
|
|
|
(while (not tmp-alist)
|
|
|
|
|
(cl-incf path-len)
|
|
|
|
|
(setq tmp-alist (avy--path-alist-1 lst path-len keys)))
|
|
|
|
|
(while (>= (cl-decf num-remaining) 0)
|
|
|
|
|
(push (mapconcat 'string (caar tmp-alist) nil) (cdr (last words)))
|
|
|
|
|
(setq tmp-alist (cdr tmp-alist)))))
|
|
|
|
|
(dolist (x lst)
|
|
|
|
|
(push (cons (string-to-list (pop words)) x) alist))
|
|
|
|
|
(setq avy-current-path "")
|
|
|
|
|
(while (or (> (length alist) 1)
|
|
|
|
|
(caar alist))
|
|
|
|
|
(dolist (x (reverse alist))
|
|
|
|
|
(avy--overlay-at-full (reverse (car x)) (cdr x)))
|
|
|
|
|
(let ((char (funcall avy-translate-char-function (read-key))))
|
|
|
|
|
(avy--remove-leading-chars)
|
|
|
|
|
(setq alist
|
|
|
|
|
(delq nil
|
|
|
|
|
(mapcar (lambda (x)
|
|
|
|
|
(when (eq (caar x) char)
|
|
|
|
|
(cons (cdr (car x)) (cdr x))))
|
|
|
|
|
alist)))
|
|
|
|
|
(setq avy-current-path
|
|
|
|
|
(concat avy-current-path (string (avy--key-to-char char))))
|
|
|
|
|
(unless alist
|
|
|
|
|
(funcall avy-handler-function char))))
|
|
|
|
|
(cdar alist))))
|
|
|
|
|
|
|
|
|
|
;;** Rest
|
|
|
|
|
(defun avy-window-list ()
|
|
|
|
|
"Return a list of windows depending on `avy-all-windows'."
|
|
|
|
|
(cond ((eq avy-all-windows 'all-frames)
|
|
|
|
|
(cl-mapcan #'window-list (frame-list)))
|
|
|
|
|
|
|
|
|
|
((eq avy-all-windows t)
|
|
|
|
|
(window-list))
|
|
|
|
|
|
|
|
|
|
((null avy-all-windows)
|
|
|
|
|
(list (selected-window)))
|
|
|
|
|
|
|
|
|
|
(t
|
|
|
|
|
(error "Unrecognized option: %S" avy-all-windows))))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-all-windows-alt nil
|
|
|
|
|
"The alternative `avy-all-windows' for use with \\[universal-argument]."
|
|
|
|
|
:type '(choice
|
|
|
|
|
(const :tag "Current window" nil)
|
|
|
|
|
(const :tag "All windows on the current frame" t)
|
|
|
|
|
(const :tag "All windows on all frames" all-frames)))
|
|
|
|
|
|
|
|
|
|
(defmacro avy-dowindows (flip &rest body)
|
|
|
|
|
"Depending on FLIP and `avy-all-windows' run BODY in each or selected window."
|
|
|
|
|
(declare (indent 1)
|
|
|
|
|
(debug (form body)))
|
|
|
|
|
`(let ((avy-all-windows (if ,flip
|
|
|
|
|
avy-all-windows-alt
|
|
|
|
|
avy-all-windows)))
|
|
|
|
|
(dolist (wnd (avy-window-list))
|
|
|
|
|
(with-selected-window wnd
|
|
|
|
|
(unless (memq major-mode avy-ignored-modes)
|
|
|
|
|
,@body)))))
|
|
|
|
|
|
|
|
|
|
(defun avy-resume ()
|
|
|
|
|
"Stub to hold last avy command.
|
|
|
|
|
Commands using `avy-with' macro can be resumed."
|
|
|
|
|
(interactive))
|
|
|
|
|
|
|
|
|
|
(defmacro avy-with (command &rest body)
|
|
|
|
|
"Set `avy-keys' according to COMMAND and execute BODY.
|
|
|
|
|
Set `avy-style' according to COMMMAND as well."
|
|
|
|
|
(declare (indent 1)
|
|
|
|
|
(debug (form body)))
|
|
|
|
|
`(let ((avy-keys (or (cdr (assq ',command avy-keys-alist))
|
|
|
|
|
avy-keys))
|
|
|
|
|
(avy-style (or (cdr (assq ',command avy-styles-alist))
|
|
|
|
|
avy-style))
|
|
|
|
|
(avy-command ',command))
|
|
|
|
|
(setq avy-action nil)
|
|
|
|
|
(setf (symbol-function 'avy-resume)
|
|
|
|
|
(lambda ()
|
|
|
|
|
(interactive)
|
|
|
|
|
,@body))
|
|
|
|
|
,@body))
|
|
|
|
|
|
|
|
|
|
(defun avy-action-goto (pt)
|
|
|
|
|
"Goto PT."
|
|
|
|
|
(let ((frame (window-frame (selected-window))))
|
|
|
|
|
(unless (equal frame (selected-frame))
|
|
|
|
|
(select-frame-set-input-focus frame)
|
|
|
|
|
(raise-frame frame))
|
|
|
|
|
(goto-char pt)))
|
|
|
|
|
|
|
|
|
|
(defun avy-forward-item ()
|
|
|
|
|
(if (eq avy-command 'avy-goto-line)
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(forward-sexp))
|
|
|
|
|
(point))
|
|
|
|
|
|
|
|
|
|
(defun avy-action-mark (pt)
|
|
|
|
|
"Mark sexp at PT."
|
|
|
|
|
(goto-char pt)
|
|
|
|
|
(set-mark (point))
|
|
|
|
|
(avy-forward-item))
|
|
|
|
|
|
|
|
|
|
(defun avy-action-copy (pt)
|
|
|
|
|
"Copy sexp starting on PT."
|
|
|
|
|
(save-excursion
|
|
|
|
|
(let (str)
|
|
|
|
|
(goto-char pt)
|
|
|
|
|
(avy-forward-item)
|
|
|
|
|
(setq str (buffer-substring pt (point)))
|
|
|
|
|
(kill-new str)
|
|
|
|
|
(message "Copied: %s" str)))
|
|
|
|
|
(let ((dat (ring-ref avy-ring 0)))
|
|
|
|
|
(select-frame-set-input-focus
|
|
|
|
|
(window-frame (cdr dat)))
|
|
|
|
|
(select-window (cdr dat))
|
|
|
|
|
(goto-char (car dat))))
|
|
|
|
|
|
|
|
|
|
(defun avy-action-yank (pt)
|
|
|
|
|
"Yank sexp starting at PT at the current point."
|
|
|
|
|
(avy-action-copy pt)
|
|
|
|
|
(yank)
|
|
|
|
|
t)
|
|
|
|
|
|
|
|
|
|
(defun avy-action-kill-move (pt)
|
|
|
|
|
"Kill sexp at PT and move there."
|
|
|
|
|
(goto-char pt)
|
|
|
|
|
(avy-forward-item)
|
|
|
|
|
(kill-region pt (point))
|
|
|
|
|
(message "Killed: %s" (current-kill 0))
|
|
|
|
|
(point))
|
|
|
|
|
|
|
|
|
|
(defun avy-action-kill-stay (pt)
|
|
|
|
|
"Kill sexp at PT."
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char pt)
|
|
|
|
|
(avy-forward-item)
|
|
|
|
|
(kill-region pt (point))
|
|
|
|
|
(just-one-space))
|
|
|
|
|
(message "Killed: %s" (current-kill 0))
|
|
|
|
|
(select-window
|
|
|
|
|
(cdr
|
|
|
|
|
(ring-ref avy-ring 0)))
|
|
|
|
|
t)
|
|
|
|
|
|
|
|
|
|
(defun avy-action-zap-to-char (pt)
|
|
|
|
|
"Kill from point up to PT."
|
|
|
|
|
(if (> pt (point))
|
|
|
|
|
(kill-region (point) pt)
|
|
|
|
|
(kill-region pt (point))))
|
|
|
|
|
|
|
|
|
|
(defun avy-action-teleport (pt)
|
|
|
|
|
"Kill sexp starting on PT and yank into the current location."
|
|
|
|
|
(avy-action-kill-stay pt)
|
|
|
|
|
(select-window
|
|
|
|
|
(cdr
|
|
|
|
|
(ring-ref avy-ring 0)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(yank))
|
|
|
|
|
t)
|
|
|
|
|
|
|
|
|
|
(declare-function flyspell-correct-word-before-point "flyspell")
|
|
|
|
|
|
|
|
|
|
(defun avy-action-ispell (pt)
|
|
|
|
|
"Auto correct word at PT."
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char pt)
|
|
|
|
|
(cond
|
|
|
|
|
((eq avy-command 'avy-goto-line)
|
|
|
|
|
(ispell-region
|
|
|
|
|
(line-beginning-position)
|
|
|
|
|
(line-end-position)))
|
|
|
|
|
((bound-and-true-p flyspell-mode)
|
|
|
|
|
(flyspell-correct-word-before-point))
|
|
|
|
|
((looking-at-p "\\b")
|
|
|
|
|
(ispell-word))
|
|
|
|
|
(t
|
|
|
|
|
(progn
|
|
|
|
|
(backward-word)
|
|
|
|
|
(when (looking-at-p "\\b")
|
|
|
|
|
(ispell-word)))))))
|
|
|
|
|
|
|
|
|
|
(defun avy--process-1 (candidates overlay-fn)
|
|
|
|
|
(let ((len (length candidates)))
|
|
|
|
|
(cond ((= len 0)
|
|
|
|
|
nil)
|
|
|
|
|
((= len 1)
|
|
|
|
|
(car candidates))
|
|
|
|
|
(t
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(avy--make-backgrounds
|
|
|
|
|
(avy-window-list))
|
|
|
|
|
(cond ((eq avy-style 'de-bruijn)
|
|
|
|
|
(avy-read-de-bruijn
|
|
|
|
|
candidates avy-keys))
|
|
|
|
|
((eq avy-style 'words)
|
|
|
|
|
(avy-read-words
|
|
|
|
|
candidates avy-words))
|
|
|
|
|
(t
|
|
|
|
|
(avy-read (avy-tree candidates avy-keys)
|
|
|
|
|
overlay-fn
|
|
|
|
|
#'avy--remove-leading-chars))))
|
|
|
|
|
(avy--done))))))
|
|
|
|
|
|
|
|
|
|
(defun avy--process (candidates overlay-fn)
|
|
|
|
|
"Select one of CANDIDATES using `avy-read'.
|
|
|
|
|
Use OVERLAY-FN to visualize the decision overlay."
|
|
|
|
|
(unless (and (consp (car candidates))
|
|
|
|
|
(windowp (cdar candidates)))
|
|
|
|
|
(setq candidates
|
|
|
|
|
(mapcar (lambda (x) (cons x (selected-window)))
|
|
|
|
|
candidates)))
|
|
|
|
|
(let ((original-cands (copy-sequence candidates))
|
|
|
|
|
(res (avy--process-1 candidates overlay-fn)))
|
|
|
|
|
(cond
|
|
|
|
|
((null res)
|
|
|
|
|
(message "zero candidates")
|
|
|
|
|
t)
|
|
|
|
|
((eq res 'restart)
|
|
|
|
|
(avy--process original-cands overlay-fn))
|
|
|
|
|
;; ignore exit from `avy-handler-function'
|
|
|
|
|
((eq res 'exit))
|
|
|
|
|
(t
|
|
|
|
|
(avy-push-mark)
|
|
|
|
|
(when (and (consp res)
|
|
|
|
|
(windowp (cdr res)))
|
|
|
|
|
(let* ((window (cdr res))
|
|
|
|
|
(frame (window-frame window)))
|
|
|
|
|
(unless (equal frame (selected-frame))
|
|
|
|
|
(select-frame-set-input-focus frame))
|
|
|
|
|
(select-window window))
|
|
|
|
|
(setq res (car res)))
|
|
|
|
|
|
|
|
|
|
(funcall (or avy-action 'avy-action-goto)
|
|
|
|
|
(if (consp res)
|
|
|
|
|
(car res)
|
|
|
|
|
res))))))
|
|
|
|
|
|
|
|
|
|
(defvar avy--overlays-back nil
|
|
|
|
|
"Hold overlays for when `avy-background' is t.")
|
|
|
|
|
|
|
|
|
|
(defun avy--make-backgrounds (wnd-list)
|
|
|
|
|
"Create a dim background overlay for each window on WND-LIST."
|
|
|
|
|
(when avy-background
|
|
|
|
|
(setq avy--overlays-back
|
|
|
|
|
(mapcar (lambda (w)
|
|
|
|
|
(let ((ol (make-overlay
|
|
|
|
|
(window-start w)
|
|
|
|
|
(window-end w)
|
|
|
|
|
(window-buffer w))))
|
|
|
|
|
(overlay-put ol 'face 'avy-background-face)
|
|
|
|
|
(overlay-put ol 'window w)
|
|
|
|
|
ol))
|
|
|
|
|
wnd-list))))
|
|
|
|
|
|
|
|
|
|
(defun avy--done ()
|
|
|
|
|
"Clean up overlays."
|
|
|
|
|
(mapc #'delete-overlay avy--overlays-back)
|
|
|
|
|
(setq avy--overlays-back nil)
|
|
|
|
|
(avy--remove-leading-chars))
|
|
|
|
|
|
|
|
|
|
(defun avy--next-visible-point ()
|
|
|
|
|
"Return the next closest point without 'invisible property."
|
|
|
|
|
(let ((s (point)))
|
|
|
|
|
(while (and (not (= (point-max) (setq s (next-char-property-change s))))
|
|
|
|
|
(get-char-property s 'invisible)))
|
|
|
|
|
s))
|
|
|
|
|
|
|
|
|
|
(defun avy--next-invisible-point ()
|
|
|
|
|
"Return the next closest point with 'invisible property."
|
|
|
|
|
(let ((s (point)))
|
|
|
|
|
(while (and (not (= (point-max) (setq s (next-char-property-change s))))
|
|
|
|
|
(not (get-char-property s 'invisible))))
|
|
|
|
|
s))
|
|
|
|
|
|
|
|
|
|
(defun avy--find-visible-regions (rbeg rend)
|
|
|
|
|
"Return a list of all visible regions between RBEG and REND."
|
|
|
|
|
(setq rbeg (max rbeg (point-min)))
|
|
|
|
|
(setq rend (min rend (point-max)))
|
|
|
|
|
(when (< rbeg rend)
|
|
|
|
|
(let (visibles beg)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region rbeg rend)
|
|
|
|
|
(setq beg (goto-char (point-min)))
|
|
|
|
|
(while (not (= (point) (point-max)))
|
|
|
|
|
(goto-char (avy--next-invisible-point))
|
|
|
|
|
(push (cons beg (point)) visibles)
|
|
|
|
|
(setq beg (goto-char (avy--next-visible-point))))
|
|
|
|
|
(nreverse visibles))))))
|
|
|
|
|
|
|
|
|
|
(defun avy--regex-candidates (regex &optional beg end pred group)
|
|
|
|
|
"Return all elements that match REGEX.
|
|
|
|
|
Each element of the list is ((BEG . END) . WND)
|
|
|
|
|
When PRED is non-nil, it's a filter for matching point positions.
|
|
|
|
|
When GROUP is non-nil, (BEG . END) should delimit that regex group."
|
|
|
|
|
(setq group (or group 0))
|
|
|
|
|
(let ((case-fold-search (or avy-case-fold-search
|
|
|
|
|
(string= regex (downcase regex))))
|
|
|
|
|
candidates)
|
|
|
|
|
(avy-dowindows current-prefix-arg
|
|
|
|
|
(dolist (pair (avy--find-visible-regions
|
|
|
|
|
(or beg (window-start))
|
|
|
|
|
(or end (window-end (selected-window) t))))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (car pair))
|
|
|
|
|
(while (re-search-forward regex (cdr pair) t)
|
|
|
|
|
(unless (get-char-property (1- (point)) 'invisible)
|
|
|
|
|
(when (or (null pred)
|
|
|
|
|
(funcall pred))
|
|
|
|
|
(push (cons (cons (match-beginning group)
|
|
|
|
|
(match-end group))
|
|
|
|
|
wnd) candidates)))))))
|
|
|
|
|
(nreverse candidates)))
|
|
|
|
|
|
|
|
|
|
(defvar avy--overlay-offset 0
|
|
|
|
|
"The offset to apply in `avy--overlay'.")
|
|
|
|
|
|
|
|
|
|
(defvar avy--overlays-lead nil
|
|
|
|
|
"Hold overlays for leading chars.")
|
|
|
|
|
|
|
|
|
|
(defun avy--remove-leading-chars ()
|
|
|
|
|
"Remove leading char overlays."
|
|
|
|
|
(mapc #'delete-overlay avy--overlays-lead)
|
|
|
|
|
(setq avy--overlays-lead nil))
|
|
|
|
|
|
|
|
|
|
(defun avy--old-str (pt wnd)
|
|
|
|
|
"Return a one-char string at PT in WND."
|
|
|
|
|
(let ((old-str (with-selected-window wnd
|
|
|
|
|
(buffer-substring pt (1+ pt)))))
|
|
|
|
|
(if avy-background
|
|
|
|
|
(propertize old-str 'face 'avy-background-face)
|
|
|
|
|
old-str)))
|
|
|
|
|
|
|
|
|
|
(defun avy--overlay (str beg end wnd &optional compose-fn)
|
|
|
|
|
"Create an overlay with STR from BEG to END in WND.
|
|
|
|
|
COMPOSE-FN is a lambda that concatenates the old string at BEG with STR."
|
|
|
|
|
(let ((eob (with-selected-window wnd (point-max))))
|
|
|
|
|
(when (<= beg eob)
|
|
|
|
|
(let* ((beg (+ beg avy--overlay-offset))
|
|
|
|
|
(ol (make-overlay beg (or end (1+ beg)) (window-buffer wnd)))
|
|
|
|
|
(old-str (if (eq beg eob) "" (avy--old-str beg wnd)))
|
|
|
|
|
(os-line-prefix (get-text-property 0 'line-prefix old-str))
|
|
|
|
|
(os-wrap-prefix (get-text-property 0 'wrap-prefix old-str))
|
|
|
|
|
other-ol)
|
|
|
|
|
(when os-line-prefix
|
|
|
|
|
(add-text-properties 0 1 `(line-prefix ,os-line-prefix) str))
|
|
|
|
|
(when os-wrap-prefix
|
|
|
|
|
(add-text-properties 0 1 `(wrap-prefix ,os-wrap-prefix) str))
|
|
|
|
|
(when (setq other-ol (cl-find-if
|
|
|
|
|
(lambda (o) (overlay-get o 'goto-address))
|
|
|
|
|
(overlays-at beg)))
|
|
|
|
|
(add-text-properties
|
|
|
|
|
0 (length old-str)
|
|
|
|
|
`(face ,(overlay-get other-ol 'face)) old-str))
|
|
|
|
|
(overlay-put ol 'window wnd)
|
|
|
|
|
(overlay-put ol 'category 'avy)
|
|
|
|
|
(overlay-put ol (if (eq beg eob)
|
|
|
|
|
'after-string
|
|
|
|
|
'display)
|
|
|
|
|
(funcall
|
|
|
|
|
(or compose-fn #'concat)
|
|
|
|
|
str old-str))
|
|
|
|
|
(push ol avy--overlays-lead)))))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-highlight-first nil
|
|
|
|
|
"When non-nil highlight the first decision char with `avy-lead-face-0'.
|
|
|
|
|
Do this even when the char is terminating."
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defun avy--key-to-char (c)
|
|
|
|
|
"If C is no character, translate it using `avy-key-to-char-alist'."
|
|
|
|
|
(cond ((characterp c) c)
|
|
|
|
|
((cdr (assoc c avy-key-to-char-alist)))
|
|
|
|
|
((mouse-event-p c) c)
|
|
|
|
|
(t
|
|
|
|
|
(error "Unknown key %s" c))))
|
|
|
|
|
|
|
|
|
|
(defun avy-candidate-beg (leaf)
|
|
|
|
|
"Return the start position for LEAF."
|
|
|
|
|
(cond ((numberp leaf)
|
|
|
|
|
leaf)
|
|
|
|
|
((consp (car leaf))
|
|
|
|
|
(caar leaf))
|
|
|
|
|
(t
|
|
|
|
|
(car leaf))))
|
|
|
|
|
|
|
|
|
|
(defun avy-candidate-end (leaf)
|
|
|
|
|
"Return the end position for LEAF."
|
|
|
|
|
(cond ((numberp leaf)
|
|
|
|
|
leaf)
|
|
|
|
|
((consp (car leaf))
|
|
|
|
|
(cdar leaf))
|
|
|
|
|
(t
|
|
|
|
|
(car leaf))))
|
|
|
|
|
|
|
|
|
|
(defun avy-candidate-wnd (leaf)
|
|
|
|
|
"Return the window for LEAF."
|
|
|
|
|
(if (consp leaf)
|
|
|
|
|
(cdr leaf)
|
|
|
|
|
(selected-window)))
|
|
|
|
|
|
|
|
|
|
(defun avy--overlay-pre (path leaf)
|
|
|
|
|
"Create an overlay with PATH at LEAF.
|
|
|
|
|
PATH is a list of keys from tree root to LEAF.
|
|
|
|
|
LEAF is normally ((BEG . END) . WND)."
|
|
|
|
|
(let* ((path (mapcar #'avy--key-to-char path))
|
|
|
|
|
(str (propertize (apply #'string (reverse path))
|
|
|
|
|
'face 'avy-lead-face)))
|
|
|
|
|
(when (or avy-highlight-first (> (length str) 1))
|
|
|
|
|
(set-text-properties 0 1 '(face avy-lead-face-0) str))
|
|
|
|
|
(setq str (concat
|
|
|
|
|
(propertize avy-current-path
|
|
|
|
|
'face 'avy-lead-face-1)
|
|
|
|
|
str))
|
|
|
|
|
(avy--overlay
|
|
|
|
|
str
|
|
|
|
|
(avy-candidate-beg leaf) nil
|
|
|
|
|
(avy-candidate-wnd leaf))))
|
|
|
|
|
|
|
|
|
|
(defun avy--overlay-at (path leaf)
|
|
|
|
|
"Create an overlay with PATH at LEAF.
|
|
|
|
|
PATH is a list of keys from tree root to LEAF.
|
|
|
|
|
LEAF is normally ((BEG . END) . WND)."
|
|
|
|
|
(let* ((path (mapcar #'avy--key-to-char path))
|
|
|
|
|
(str (propertize
|
|
|
|
|
(string (car (last path)))
|
|
|
|
|
'face 'avy-lead-face)))
|
|
|
|
|
(avy--overlay
|
|
|
|
|
str
|
|
|
|
|
(avy-candidate-beg leaf) nil
|
|
|
|
|
(avy-candidate-wnd leaf)
|
|
|
|
|
(lambda (str old-str)
|
|
|
|
|
(cond ((string= old-str "\n")
|
|
|
|
|
(concat str "\n"))
|
|
|
|
|
;; add padding for wide-width character
|
|
|
|
|
((eq (string-width old-str) 2)
|
|
|
|
|
(concat str " "))
|
|
|
|
|
(t
|
|
|
|
|
str))))))
|
|
|
|
|
|
|
|
|
|
(defun avy--overlay-at-full (path leaf)
|
|
|
|
|
"Create an overlay with PATH at LEAF.
|
|
|
|
|
PATH is a list of keys from tree root to LEAF.
|
|
|
|
|
LEAF is normally ((BEG . END) . WND)."
|
|
|
|
|
(let* ((path (mapcar #'avy--key-to-char path))
|
|
|
|
|
(str (propertize
|
|
|
|
|
(apply #'string (reverse path))
|
|
|
|
|
'face 'avy-lead-face))
|
|
|
|
|
(len (length path))
|
|
|
|
|
(beg (avy-candidate-beg leaf))
|
|
|
|
|
(wnd (cdr leaf))
|
|
|
|
|
end)
|
|
|
|
|
(dotimes (i len)
|
|
|
|
|
(set-text-properties (- len i 1) (- len i)
|
|
|
|
|
`(face ,(nth i avy-lead-faces))
|
|
|
|
|
str))
|
|
|
|
|
(when (eq avy-style 'de-bruijn)
|
|
|
|
|
(setq str (concat
|
|
|
|
|
(propertize avy-current-path
|
|
|
|
|
'face 'avy-lead-face-1)
|
|
|
|
|
str))
|
|
|
|
|
(setq len (length str)))
|
|
|
|
|
(with-selected-window wnd
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char beg)
|
|
|
|
|
(let* ((lep (if (bound-and-true-p visual-line-mode)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(end-of-visual-line)
|
|
|
|
|
(point))
|
|
|
|
|
(line-end-position)))
|
|
|
|
|
;; `end-of-visual-line' is bugged sometimes
|
|
|
|
|
(lep (if (< lep beg)
|
|
|
|
|
(line-end-position)
|
|
|
|
|
lep))
|
|
|
|
|
(len-and-str (avy--update-offset-and-str len str lep)))
|
|
|
|
|
(setq len (car len-and-str))
|
|
|
|
|
(setq str (cdr len-and-str))
|
|
|
|
|
(setq end (if (= beg lep)
|
|
|
|
|
(1+ beg)
|
|
|
|
|
(min (+ beg
|
|
|
|
|
(if (eq (char-after) ?\t)
|
|
|
|
|
1
|
|
|
|
|
len))
|
|
|
|
|
lep)))
|
|
|
|
|
(when (and (bound-and-true-p visual-line-mode)
|
|
|
|
|
(> len (- end beg))
|
|
|
|
|
(not (eq lep beg)))
|
|
|
|
|
(setq len (- end beg))
|
|
|
|
|
(let ((old-str (apply #'string (reverse path))))
|
|
|
|
|
(setq str
|
|
|
|
|
(substring
|
|
|
|
|
(propertize
|
|
|
|
|
old-str
|
|
|
|
|
'face
|
|
|
|
|
(if (= (length old-str) 1)
|
|
|
|
|
'avy-lead-face
|
|
|
|
|
'avy-lead-face-0))
|
|
|
|
|
0 len)))))))
|
|
|
|
|
(avy--overlay
|
|
|
|
|
str beg end wnd
|
|
|
|
|
(lambda (str old-str)
|
|
|
|
|
(cond ((string= old-str "\n")
|
|
|
|
|
(concat str "\n"))
|
|
|
|
|
((string= old-str "\t")
|
|
|
|
|
(concat str (make-string (max (- tab-width len) 0) ?\ )))
|
|
|
|
|
(t
|
|
|
|
|
;; add padding for wide-width character
|
|
|
|
|
(if (eq (string-width old-str) 2)
|
|
|
|
|
(concat str " ")
|
|
|
|
|
str)))))))
|
|
|
|
|
|
|
|
|
|
(defun avy--overlay-post (path leaf)
|
|
|
|
|
"Create an overlay with PATH at LEAF.
|
|
|
|
|
PATH is a list of keys from tree root to LEAF.
|
|
|
|
|
LEAF is normally ((BEG . END) . WND)."
|
|
|
|
|
(let* ((path (mapcar #'avy--key-to-char path))
|
|
|
|
|
(str (propertize (apply #'string (reverse path))
|
|
|
|
|
'face 'avy-lead-face)))
|
|
|
|
|
(when (or avy-highlight-first (> (length str) 1))
|
|
|
|
|
(set-text-properties 0 1 '(face avy-lead-face-0) str))
|
|
|
|
|
(setq str (concat
|
|
|
|
|
(propertize avy-current-path
|
|
|
|
|
'face 'avy-lead-face-1)
|
|
|
|
|
str))
|
|
|
|
|
(avy--overlay
|
|
|
|
|
str
|
|
|
|
|
(avy-candidate-end leaf) nil
|
|
|
|
|
(avy-candidate-wnd leaf))))
|
|
|
|
|
|
|
|
|
|
(defun avy--update-offset-and-str (offset str lep)
|
|
|
|
|
"Recalculate the length of the new overlay at point.
|
|
|
|
|
|
|
|
|
|
OFFSET is the previous overlay length.
|
|
|
|
|
STR is the overlay string that we wish to add.
|
|
|
|
|
LEP is the line end position.
|
|
|
|
|
|
|
|
|
|
We want to add an overlay between point and END=point+OFFSET.
|
|
|
|
|
When other overlays already exist between point and END, set
|
|
|
|
|
OFFSET to be the difference between the start of the first
|
|
|
|
|
overlay and point. This is equivalent to truncating our new
|
|
|
|
|
overlay, so that it doesn't intersect with overlays that already
|
|
|
|
|
exist."
|
|
|
|
|
(let* ((wnd (selected-window))
|
|
|
|
|
(beg (point))
|
|
|
|
|
(oov (delq nil
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (o)
|
|
|
|
|
(and (eq (overlay-get o 'category) 'avy)
|
|
|
|
|
(eq (overlay-get o 'window) wnd)
|
|
|
|
|
(overlay-start o)))
|
|
|
|
|
(overlays-in beg (min (+ beg offset) lep))))))
|
|
|
|
|
(when oov
|
|
|
|
|
(setq offset (- (apply #'min oov) beg))
|
|
|
|
|
(setq str (substring str 0 offset)))
|
|
|
|
|
(let ((other-ov (cl-find-if
|
|
|
|
|
(lambda (o)
|
|
|
|
|
(and (eq (overlay-get o 'category) 'avy)
|
|
|
|
|
(eq (overlay-start o) beg)
|
|
|
|
|
(not (eq (overlay-get o 'window) wnd))))
|
|
|
|
|
(overlays-in (point) (min (+ (point) offset) lep)))))
|
|
|
|
|
(when (and other-ov
|
|
|
|
|
(> (overlay-end other-ov)
|
|
|
|
|
(+ beg offset)))
|
|
|
|
|
(setq str (concat str (buffer-substring
|
|
|
|
|
(+ beg offset)
|
|
|
|
|
(overlay-end other-ov))))
|
|
|
|
|
(setq offset (- (overlay-end other-ov)
|
|
|
|
|
beg))))
|
|
|
|
|
(cons offset str)))
|
|
|
|
|
|
|
|
|
|
(defun avy--style-fn (style)
|
|
|
|
|
"Transform STYLE symbol to a style function."
|
|
|
|
|
(cl-case style
|
|
|
|
|
(pre #'avy--overlay-pre)
|
|
|
|
|
(at #'avy--overlay-at)
|
|
|
|
|
(at-full 'avy--overlay-at-full)
|
|
|
|
|
(post #'avy--overlay-post)
|
|
|
|
|
(de-bruijn #'avy--overlay-at-full)
|
|
|
|
|
(words #'avy--overlay-at-full)
|
|
|
|
|
(t (error "Unexpected style %S" style))))
|
|
|
|
|
|
|
|
|
|
(defun avy--generic-jump (regex window-flip style &optional beg end)
|
|
|
|
|
"Jump to REGEX.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
|
|
|
|
|
STYLE determines the leading char overlay style.
|
|
|
|
|
BEG and END narrow the scope where candidates are searched."
|
|
|
|
|
(let ((avy-all-windows
|
|
|
|
|
(if window-flip
|
|
|
|
|
(not avy-all-windows)
|
|
|
|
|
avy-all-windows)))
|
|
|
|
|
(avy--process
|
|
|
|
|
(avy--regex-candidates regex beg end)
|
|
|
|
|
(avy--style-fn style))))
|
|
|
|
|
|
|
|
|
|
;;* Commands
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-char (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR.
|
|
|
|
|
The window scope is determined by `avy-all-windows' (ARG negates it)."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-char
|
|
|
|
|
(avy--generic-jump
|
|
|
|
|
(if (= 13 char)
|
|
|
|
|
"\n"
|
|
|
|
|
(regexp-quote (string char)))
|
|
|
|
|
arg
|
|
|
|
|
avy-style)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-char-in-line (char)
|
|
|
|
|
"Jump to the currently visible CHAR in the current line."
|
|
|
|
|
(interactive (list (read-char "char: " t)))
|
|
|
|
|
(avy-with avy-goto-char
|
|
|
|
|
(avy--generic-jump
|
|
|
|
|
(regexp-quote (string char))
|
|
|
|
|
avy-all-windows
|
|
|
|
|
avy-style
|
|
|
|
|
(line-beginning-position)
|
|
|
|
|
(line-end-position))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-char-2 (char1 char2 &optional arg beg end)
|
|
|
|
|
"Jump to the currently visible CHAR1 followed by CHAR2.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'.
|
|
|
|
|
BEG and END narrow the scope where candidates are searched."
|
|
|
|
|
(interactive (list (read-char "char 1: " t)
|
|
|
|
|
(read-char "char 2: " t)
|
|
|
|
|
current-prefix-arg
|
|
|
|
|
nil nil))
|
|
|
|
|
(when (eq char1 ?
)
|
|
|
|
|
(setq char1 ?\n))
|
|
|
|
|
(when (eq char2 ?
)
|
|
|
|
|
(setq char2 ?\n))
|
|
|
|
|
(avy-with avy-goto-char-2
|
|
|
|
|
(avy--generic-jump
|
|
|
|
|
(regexp-quote (string char1 char2))
|
|
|
|
|
arg
|
|
|
|
|
avy-style
|
|
|
|
|
beg end)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-char-2-above (char1 char2 &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR1 followed by CHAR2.
|
|
|
|
|
This is a scoped version of `avy-goto-char-2', where the scope is
|
|
|
|
|
the visible part of the current buffer up to point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char 1: " t)
|
|
|
|
|
(read-char "char 2: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-char-2-above
|
|
|
|
|
(avy-goto-char-2
|
|
|
|
|
char1 char2 arg
|
|
|
|
|
(window-start) (point))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-char-2-below (char1 char2 &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR1 followed by CHAR2.
|
|
|
|
|
This is a scoped version of `avy-goto-char-2', where the scope is
|
|
|
|
|
the visible part of the current buffer following point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char 1: " t)
|
|
|
|
|
(read-char "char 2: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-char-2-below
|
|
|
|
|
(avy-goto-char-2
|
|
|
|
|
char1 char2 arg
|
|
|
|
|
(point) (window-end (selected-window) t))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-isearch ()
|
|
|
|
|
"Jump to one of the current isearch candidates."
|
|
|
|
|
(interactive)
|
|
|
|
|
(avy-with avy-isearch
|
|
|
|
|
(let ((avy-background nil))
|
|
|
|
|
(avy--process
|
|
|
|
|
(avy--regex-candidates (if isearch-regexp
|
|
|
|
|
isearch-string
|
|
|
|
|
(regexp-quote isearch-string)))
|
|
|
|
|
(avy--style-fn avy-style))
|
|
|
|
|
(isearch-done))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-word-0 (arg &optional beg end)
|
|
|
|
|
"Jump to a word start.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'.
|
|
|
|
|
BEG and END narrow the scope where candidates are searched."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(avy-with avy-goto-word-0
|
|
|
|
|
(avy--generic-jump avy-goto-word-0-regexp arg avy-style beg end)))
|
|
|
|
|
|
|
|
|
|
(defun avy-goto-word-0-above (arg)
|
|
|
|
|
"Jump to a word start between window start and point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(avy-with avy-goto-word-0
|
|
|
|
|
(avy-goto-word-0 arg (window-start) (point))))
|
|
|
|
|
|
|
|
|
|
(defun avy-goto-word-0-below (arg)
|
|
|
|
|
"Jump to a word start between point and window end.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(avy-with avy-goto-word-0
|
|
|
|
|
(avy-goto-word-0 arg (point) (window-end (selected-window) t))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-word-1 (char &optional arg beg end symbol)
|
|
|
|
|
"Jump to the currently visible CHAR at a word start.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'.
|
|
|
|
|
BEG and END narrow the scope where candidates are searched.
|
|
|
|
|
When SYMBOL is non-nil, jump to symbol start instead of word start."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-word-1
|
|
|
|
|
(let* ((str (string char))
|
|
|
|
|
(regex (cond ((string= str ".")
|
|
|
|
|
"\\.")
|
|
|
|
|
((and avy-word-punc-regexp
|
|
|
|
|
(string-match avy-word-punc-regexp str))
|
|
|
|
|
(regexp-quote str))
|
|
|
|
|
((<= char 26)
|
|
|
|
|
str)
|
|
|
|
|
(t
|
|
|
|
|
(concat
|
|
|
|
|
(if symbol "\\_<" "\\b")
|
|
|
|
|
str)))))
|
|
|
|
|
(avy--generic-jump regex arg avy-style beg end))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-word-1-above (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR at a word start.
|
|
|
|
|
This is a scoped version of `avy-goto-word-1', where the scope is
|
|
|
|
|
the visible part of the current buffer up to point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-word-1
|
|
|
|
|
(avy-goto-word-1 char arg (window-start) (point))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-word-1-below (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR at a word start.
|
|
|
|
|
This is a scoped version of `avy-goto-word-1', where the scope is
|
|
|
|
|
the visible part of the current buffer following point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-word-1
|
|
|
|
|
(avy-goto-word-1 char arg (point) (window-end (selected-window) t))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-symbol-1 (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR at a symbol start.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-symbol-1
|
|
|
|
|
(avy-goto-word-1 char arg nil nil t)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-symbol-1-above (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR at a symbol start.
|
|
|
|
|
This is a scoped version of `avy-goto-symbol-1', where the scope is
|
|
|
|
|
the visible part of the current buffer up to point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-symbol-1-above
|
|
|
|
|
(avy-goto-word-1 char arg (window-start) (point) t)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-symbol-1-below (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR at a symbol start.
|
|
|
|
|
This is a scoped version of `avy-goto-symbol-1', where the scope is
|
|
|
|
|
the visible part of the current buffer following point.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-symbol-1-below
|
|
|
|
|
(avy-goto-word-1 char arg (point) (window-end (selected-window) t) t)))
|
|
|
|
|
|
|
|
|
|
(declare-function subword-backward "subword")
|
|
|
|
|
(defvar subword-backward-regexp)
|
|
|
|
|
|
|
|
|
|
(defcustom avy-subword-extra-word-chars '(?{ ?= ?} ?* ?: ?> ?<)
|
|
|
|
|
"A list of characters that should temporarily match \"\\w\".
|
|
|
|
|
This variable is used by `avy-goto-subword-0' and `avy-goto-subword-1'."
|
|
|
|
|
:type '(repeat character))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-subword-0 (&optional arg predicate beg end)
|
|
|
|
|
"Jump to a word or subword start.
|
|
|
|
|
The window scope is determined by `avy-all-windows' (ARG negates it).
|
|
|
|
|
|
|
|
|
|
When PREDICATE is non-nil it's a function of zero parameters that
|
|
|
|
|
should return true.
|
|
|
|
|
|
|
|
|
|
BEG and END narrow the scope where candidates are searched."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(require 'subword)
|
|
|
|
|
(avy-with avy-goto-subword-0
|
|
|
|
|
(let ((case-fold-search nil)
|
|
|
|
|
(subword-backward-regexp
|
|
|
|
|
"\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)")
|
|
|
|
|
candidates)
|
|
|
|
|
(avy-dowindows arg
|
|
|
|
|
(let ((syn-tbl (copy-syntax-table)))
|
|
|
|
|
(dolist (char avy-subword-extra-word-chars)
|
|
|
|
|
(modify-syntax-entry char "w" syn-tbl))
|
|
|
|
|
(with-syntax-table syn-tbl
|
|
|
|
|
(let ((ws (or beg (window-start)))
|
|
|
|
|
window-cands)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (or end (window-end (selected-window) t)))
|
|
|
|
|
(subword-backward)
|
|
|
|
|
(while (> (point) ws)
|
|
|
|
|
(when (or (null predicate)
|
|
|
|
|
(and predicate (funcall predicate)))
|
|
|
|
|
(unless (get-char-property (point) 'invisible)
|
|
|
|
|
(push (cons (point) (selected-window)) window-cands)))
|
|
|
|
|
(subword-backward))
|
|
|
|
|
(and (= (point) ws)
|
|
|
|
|
(or (null predicate)
|
|
|
|
|
(and predicate (funcall predicate)))
|
|
|
|
|
(not (get-char-property (point) 'invisible))
|
|
|
|
|
(push (cons (point) (selected-window)) window-cands)))
|
|
|
|
|
(setq candidates (nconc candidates window-cands))))))
|
|
|
|
|
(avy--process candidates (avy--style-fn avy-style)))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-subword-1 (char &optional arg)
|
|
|
|
|
"Jump to the currently visible CHAR at a subword start.
|
|
|
|
|
The window scope is determined by `avy-all-windows' (ARG negates it).
|
|
|
|
|
The case of CHAR is ignored."
|
|
|
|
|
(interactive (list (read-char "char: " t)
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
(avy-with avy-goto-subword-1
|
|
|
|
|
(let ((char (downcase char)))
|
|
|
|
|
(avy-goto-subword-0
|
|
|
|
|
arg (lambda ()
|
|
|
|
|
(and (char-after)
|
|
|
|
|
(eq (downcase (char-after)) char)))))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-word-or-subword-1 ()
|
|
|
|
|
"Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
|
|
|
|
|
Which one depends on variable `subword-mode'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (bound-and-true-p subword-mode)
|
|
|
|
|
(call-interactively #'avy-goto-subword-1)
|
|
|
|
|
(call-interactively #'avy-goto-word-1)))
|
|
|
|
|
|
|
|
|
|
(defvar visual-line-mode)
|
|
|
|
|
|
2018-10-02 15:54:39 +02:00
|
|
|
|
(defcustom avy-indent-line-overlay nil
|
|
|
|
|
"When non-nil, `avy-goto-line' will display the line overlay next to the first non-whitespace character of each line."
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
2018-09-10 20:51:14 +02:00
|
|
|
|
(defun avy--line-cands (&optional arg beg end bottom-up)
|
|
|
|
|
"Get candidates for selecting a line.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'.
|
|
|
|
|
BEG and END narrow the scope where candidates are searched.
|
|
|
|
|
When BOTTOM-UP is non-nil, display avy candidates from top to bottom"
|
|
|
|
|
(let (candidates)
|
|
|
|
|
(avy-dowindows arg
|
|
|
|
|
(let ((ws (or beg (window-start))))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region ws (or end (window-end (selected-window) t)))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (< (point) (point-max))
|
|
|
|
|
(unless (get-char-property
|
|
|
|
|
(max (1- (point)) ws) 'invisible)
|
|
|
|
|
(push (cons
|
|
|
|
|
(if (eq avy-style 'post)
|
|
|
|
|
(line-end-position)
|
2018-10-02 15:54:39 +02:00
|
|
|
|
(save-excursion
|
|
|
|
|
(when avy-indent-line-overlay
|
|
|
|
|
(skip-chars-forward " \t"))
|
|
|
|
|
(point)))
|
2018-09-10 20:51:14 +02:00
|
|
|
|
(selected-window)) candidates))
|
|
|
|
|
(if visual-line-mode
|
|
|
|
|
(progn
|
|
|
|
|
(setq temporary-goal-column 0)
|
|
|
|
|
(line-move-visual 1 t))
|
|
|
|
|
(forward-line 1)))))))
|
|
|
|
|
(if bottom-up
|
|
|
|
|
candidates
|
|
|
|
|
(nreverse candidates))))
|
|
|
|
|
|
|
|
|
|
(defun avy--linum-strings ()
|
|
|
|
|
"Get strings for `avy-linum-mode'."
|
|
|
|
|
(let* ((lines (mapcar #'car (avy--line-cands)))
|
|
|
|
|
(line-tree (avy-tree lines avy-keys))
|
|
|
|
|
(line-list nil))
|
|
|
|
|
(avy-traverse
|
|
|
|
|
line-tree
|
|
|
|
|
(lambda (path _leaf)
|
|
|
|
|
(let ((str (propertize (apply #'string (reverse path))
|
|
|
|
|
'face 'avy-lead-face)))
|
|
|
|
|
(when (> (length str) 1)
|
|
|
|
|
(set-text-properties 0 1 '(face avy-lead-face-0) str))
|
|
|
|
|
(push str line-list))))
|
|
|
|
|
(nreverse line-list)))
|
|
|
|
|
|
|
|
|
|
(defvar linum-available)
|
|
|
|
|
(defvar linum-overlays)
|
|
|
|
|
(defvar linum-format)
|
|
|
|
|
(declare-function linum--face-width "linum")
|
|
|
|
|
|
|
|
|
|
(define-minor-mode avy-linum-mode
|
|
|
|
|
"Minor mode that uses avy hints for `linum-mode'."
|
|
|
|
|
:group 'avy
|
|
|
|
|
(if avy-linum-mode
|
|
|
|
|
(progn
|
|
|
|
|
(require 'linum)
|
|
|
|
|
(advice-add 'linum-update-window :around 'avy--linum-update-window)
|
|
|
|
|
(linum-mode 1))
|
|
|
|
|
(advice-remove 'linum-update-window 'avy--linum-update-window)
|
|
|
|
|
(linum-mode -1)))
|
|
|
|
|
|
|
|
|
|
(defun avy--linum-update-window (_ win)
|
|
|
|
|
"Update line numbers for the portion visible in window WIN."
|
|
|
|
|
(goto-char (window-start win))
|
|
|
|
|
(let ((line (line-number-at-pos))
|
|
|
|
|
(limit (window-end win t))
|
|
|
|
|
(fmt (cond ((stringp linum-format) linum-format)
|
|
|
|
|
((eq linum-format 'dynamic)
|
|
|
|
|
(let ((w (length (number-to-string
|
|
|
|
|
(count-lines (point-min) (point-max))))))
|
|
|
|
|
(concat "%" (number-to-string w) "d")))))
|
|
|
|
|
(width 0)
|
|
|
|
|
(avy-strs (when avy-linum-mode
|
|
|
|
|
(avy--linum-strings))))
|
|
|
|
|
(run-hooks 'linum-before-numbering-hook)
|
|
|
|
|
;; Create an overlay (or reuse an existing one) for each
|
|
|
|
|
;; line visible in this window, if necessary.
|
|
|
|
|
(while (and (not (eobp)) (< (point) limit))
|
|
|
|
|
(let* ((str
|
|
|
|
|
(cond (avy-linum-mode
|
|
|
|
|
(pop avy-strs))
|
|
|
|
|
(fmt
|
|
|
|
|
(propertize (format fmt line) 'face 'linum))
|
|
|
|
|
(t
|
|
|
|
|
(funcall linum-format line))))
|
|
|
|
|
(visited (catch 'visited
|
|
|
|
|
(dolist (o (overlays-in (point) (point)))
|
|
|
|
|
(when (equal-including-properties
|
|
|
|
|
(overlay-get o 'linum-str) str)
|
|
|
|
|
(unless (memq o linum-overlays)
|
|
|
|
|
(push o linum-overlays))
|
|
|
|
|
(setq linum-available (delq o linum-available))
|
|
|
|
|
(throw 'visited t))))))
|
|
|
|
|
(setq width (max width (length str)))
|
|
|
|
|
(unless visited
|
|
|
|
|
(let ((ov (if (null linum-available)
|
|
|
|
|
(make-overlay (point) (point))
|
|
|
|
|
(move-overlay (pop linum-available) (point) (point)))))
|
|
|
|
|
(push ov linum-overlays)
|
|
|
|
|
(overlay-put ov 'before-string
|
|
|
|
|
(propertize " " 'display `((margin left-margin) ,str)))
|
|
|
|
|
(overlay-put ov 'linum-str str))))
|
|
|
|
|
;; Text may contain those nasty intangible properties, but that
|
|
|
|
|
;; shouldn't prevent us from counting those lines.
|
|
|
|
|
(let ((inhibit-point-motion-hooks t))
|
|
|
|
|
(forward-line))
|
|
|
|
|
(setq line (1+ line)))
|
|
|
|
|
(when (display-graphic-p)
|
|
|
|
|
(setq width (ceiling
|
|
|
|
|
(/ (* width 1.0 (linum--face-width 'linum))
|
|
|
|
|
(frame-char-width)))))
|
|
|
|
|
(set-window-margins win width (cdr (window-margins win)))))
|
|
|
|
|
|
|
|
|
|
(defun avy--line (&optional arg beg end bottom-up)
|
|
|
|
|
"Select a line.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'.
|
|
|
|
|
BEG and END narrow the scope where candidates are searched.
|
|
|
|
|
When BOTTOM-UP is non-nil, display avy candidates from top to bottom"
|
|
|
|
|
(let ((avy-action #'identity))
|
|
|
|
|
(avy--process
|
|
|
|
|
(avy--line-cands arg beg end bottom-up)
|
|
|
|
|
(if avy-linum-mode
|
|
|
|
|
(progn (message "Goto line:")
|
|
|
|
|
'ignore)
|
|
|
|
|
(avy--style-fn avy-style)))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-line (&optional arg)
|
|
|
|
|
"Jump to a line start in current buffer.
|
|
|
|
|
|
|
|
|
|
When ARG is 1, jump to lines currently visible, with the option
|
|
|
|
|
to cancel to `goto-line' by entering a number.
|
|
|
|
|
|
|
|
|
|
When ARG is 4, negate the window scope determined by
|
|
|
|
|
`avy-all-windows'.
|
|
|
|
|
|
|
|
|
|
Otherwise, forward to `goto-line' with ARG."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(setq arg (or arg 1))
|
|
|
|
|
(if (not (memq arg '(1 4)))
|
|
|
|
|
(progn
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(forward-line (1- arg)))
|
|
|
|
|
(avy-with avy-goto-line
|
|
|
|
|
(let* ((avy-handler-old avy-handler-function)
|
|
|
|
|
(avy-handler-function
|
|
|
|
|
(lambda (char)
|
|
|
|
|
(if (or (< char ?0)
|
|
|
|
|
(> char ?9))
|
|
|
|
|
(funcall avy-handler-old char)
|
|
|
|
|
(let ((line (read-from-minibuffer
|
|
|
|
|
"Goto line: " (string char))))
|
|
|
|
|
(when line
|
|
|
|
|
(avy-push-mark)
|
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(forward-line (1- (string-to-number line))))
|
|
|
|
|
(throw 'done 'exit))))))
|
|
|
|
|
(r (avy--line (eq arg 4))))
|
|
|
|
|
(unless (eq r t)
|
|
|
|
|
(avy-action-goto r))))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-line-above (&optional offset bottom-up)
|
|
|
|
|
"Goto visible line above the cursor.
|
|
|
|
|
OFFSET changes the distance between the closest key to the cursor and
|
|
|
|
|
the cursor
|
|
|
|
|
When BOTTOM-UP is non-nil, display avy candidates from top to bottom"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if offset
|
|
|
|
|
(setq offset (+ 2 (- offset))))
|
|
|
|
|
(let* ((avy-all-windows nil)
|
|
|
|
|
(r (avy--line nil (window-start)
|
|
|
|
|
(line-beginning-position (or offset 1))
|
|
|
|
|
bottom-up)))
|
|
|
|
|
(unless (eq r t)
|
|
|
|
|
(avy-action-goto r))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-line-below (&optional offset bottom-up)
|
|
|
|
|
"Goto visible line below the cursor.
|
|
|
|
|
OFFSET changes the distance between the closest key to the cursor and
|
|
|
|
|
the cursor
|
|
|
|
|
When BOTTOM-UP is non-nil, display avy candidates from top to bottom"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if offset
|
|
|
|
|
(setq offset (+ offset 1)))
|
|
|
|
|
(let* ((avy-all-windows nil)
|
|
|
|
|
(r (avy--line
|
|
|
|
|
nil (line-beginning-position (or offset 2))
|
|
|
|
|
(window-end (selected-window) t)
|
|
|
|
|
bottom-up)))
|
|
|
|
|
(unless (eq r t)
|
|
|
|
|
(avy-action-goto r))))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-line-insert-style 'above
|
|
|
|
|
"How to insert the newly copied/cut line."
|
|
|
|
|
:type '(choice
|
|
|
|
|
(const :tag "Above" above)
|
|
|
|
|
(const :tag "Below" below)))
|
|
|
|
|
|
2018-10-02 15:54:39 +02:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-end-of-line (&optional arg)
|
|
|
|
|
"Call `avy-goto-line' and move to the end of the line."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(avy-goto-line arg)
|
|
|
|
|
(end-of-line))
|
|
|
|
|
|
2018-09-10 20:51:14 +02:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-copy-line (arg)
|
|
|
|
|
"Copy a selected line above the current line.
|
|
|
|
|
ARG lines can be used."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-copy-line
|
|
|
|
|
(let* ((start (avy--line))
|
|
|
|
|
(str (buffer-substring-no-properties
|
|
|
|
|
start
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char start)
|
|
|
|
|
(move-end-of-line arg)
|
|
|
|
|
(point)))))
|
|
|
|
|
(select-window initial-window)
|
|
|
|
|
(cond ((eq avy-line-insert-style 'above)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert str "\n")))
|
|
|
|
|
((eq avy-line-insert-style 'below)
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(insert "\n" str)
|
|
|
|
|
(beginning-of-line))
|
|
|
|
|
(t
|
|
|
|
|
(user-error "Unexpected `avy-line-insert-style'")))))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-move-line (arg)
|
|
|
|
|
"Move a selected line above the current line.
|
|
|
|
|
ARG lines can be used."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-move-line
|
|
|
|
|
(let ((start (avy--line)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char start)
|
|
|
|
|
(kill-whole-line arg))
|
|
|
|
|
(select-window initial-window)
|
|
|
|
|
(cond ((eq avy-line-insert-style 'above)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert
|
|
|
|
|
(current-kill 0))))
|
|
|
|
|
((eq avy-line-insert-style 'below)
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(newline)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert (substring (current-kill 0) 0 -1))))
|
|
|
|
|
(t
|
|
|
|
|
(user-error "Unexpected `avy-line-insert-style'")))))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-copy-region (arg)
|
|
|
|
|
"Select two lines and copy the text between them to point.
|
|
|
|
|
|
|
|
|
|
The window scope is determined by `avy-all-windows' or
|
|
|
|
|
`avy-all-windows-alt' when ARG is non-nil."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-copy-region
|
|
|
|
|
(let* ((beg (save-selected-window
|
|
|
|
|
(avy--line arg)))
|
|
|
|
|
(end (avy--line arg))
|
|
|
|
|
(str (buffer-substring-no-properties
|
|
|
|
|
beg
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char end)
|
|
|
|
|
(line-end-position)))))
|
|
|
|
|
(select-window initial-window)
|
|
|
|
|
(cond ((eq avy-line-insert-style 'above)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert str "\n")))
|
|
|
|
|
((eq avy-line-insert-style 'below)
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(newline)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert str)))
|
|
|
|
|
(t
|
|
|
|
|
(user-error "Unexpected `avy-line-insert-style'")))))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-move-region ()
|
|
|
|
|
"Select two lines and move the text between them above the current line."
|
|
|
|
|
(interactive)
|
|
|
|
|
(avy-with avy-move-region
|
|
|
|
|
(let* ((initial-window (selected-window))
|
|
|
|
|
(beg (avy--line))
|
|
|
|
|
(end (avy--line))
|
|
|
|
|
text)
|
|
|
|
|
(when (> beg end)
|
|
|
|
|
(cl-rotatef beg end))
|
|
|
|
|
(setq end (save-excursion
|
|
|
|
|
(goto-char end)
|
|
|
|
|
(1+ (line-end-position))))
|
|
|
|
|
(setq text (buffer-substring beg end))
|
|
|
|
|
(move-beginning-of-line nil)
|
|
|
|
|
(delete-region beg end)
|
|
|
|
|
(select-window initial-window)
|
|
|
|
|
(insert text))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-kill-region (arg)
|
|
|
|
|
"Select two lines and kill the region between them.
|
|
|
|
|
|
|
|
|
|
The window scope is determined by `avy-all-windows' or
|
|
|
|
|
`avy-all-windows-alt' when ARG is non-nil."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-kill-region
|
|
|
|
|
(let* ((beg (save-selected-window
|
|
|
|
|
(list (avy--line arg) (selected-window))))
|
|
|
|
|
(end (list (avy--line arg) (selected-window))))
|
|
|
|
|
(cond
|
|
|
|
|
((not (numberp (car beg)))
|
|
|
|
|
(user-error "Fail to select the beginning of region"))
|
|
|
|
|
((not (numberp (car end)))
|
|
|
|
|
(user-error "Fail to select the end of region"))
|
|
|
|
|
;; Restrict operation to same window. It's better if it can be
|
|
|
|
|
;; different windows but same buffer; however, then the cloned
|
|
|
|
|
;; buffers with different narrowed regions might cause problem.
|
|
|
|
|
((not (equal (cdr beg) (cdr end)))
|
|
|
|
|
(user-error "Selected points are not in the same window"))
|
|
|
|
|
((< (car beg) (car end))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-region
|
|
|
|
|
(car beg)
|
|
|
|
|
(progn (goto-char (car end)) (forward-visible-line 1) (point)))))
|
|
|
|
|
(t
|
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-region
|
|
|
|
|
(progn (goto-char (car beg)) (forward-visible-line 1) (point))
|
|
|
|
|
(car end)))))))
|
|
|
|
|
(select-window initial-window)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-kill-ring-save-region (arg)
|
|
|
|
|
"Select two lines and save the region between them to the kill ring.
|
|
|
|
|
The window scope is determined by `avy-all-windows'.
|
|
|
|
|
When ARG is non-nil, do the opposite of `avy-all-windows'."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-kill-ring-save-region
|
|
|
|
|
(let* ((beg (save-selected-window
|
|
|
|
|
(list (avy--line arg) (selected-window))))
|
|
|
|
|
(end (list (avy--line arg) (selected-window))))
|
|
|
|
|
(cond
|
|
|
|
|
((not (numberp (car beg)))
|
|
|
|
|
(user-error "Fail to select the beginning of region"))
|
|
|
|
|
((not (numberp (car end)))
|
|
|
|
|
(user-error "Fail to select the end of region"))
|
|
|
|
|
((not (equal (cdr beg) (cdr end)))
|
|
|
|
|
(user-error "Selected points are not in the same window"))
|
|
|
|
|
((< (car beg) (car end))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-ring-save
|
|
|
|
|
(car beg)
|
|
|
|
|
(progn (goto-char (car end)) (forward-visible-line 1) (point)))))
|
|
|
|
|
(t
|
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-ring-save
|
|
|
|
|
(progn (goto-char (car beg)) (forward-visible-line 1) (point))
|
|
|
|
|
(car end)))))))
|
|
|
|
|
(select-window initial-window)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-kill-whole-line (arg)
|
|
|
|
|
"Select line and kill the whole selected line.
|
|
|
|
|
|
|
|
|
|
With a numerical prefix ARG, kill ARG line(s) starting from the
|
|
|
|
|
selected line. If ARG is negative, kill backward.
|
|
|
|
|
|
|
|
|
|
If ARG is zero, kill the selected line but exclude the trailing
|
|
|
|
|
newline.
|
|
|
|
|
|
|
|
|
|
\\[universal-argument] 3 \\[avy-kil-whole-line] kill three lines
|
|
|
|
|
starting from the selected line. \\[universal-argument] -3
|
|
|
|
|
|
|
|
|
|
\\[avy-kill-whole-line] kill three lines backward including the
|
|
|
|
|
selected line."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-kill-whole-line
|
|
|
|
|
(let* ((start (avy--line)))
|
|
|
|
|
(if (not (numberp start))
|
|
|
|
|
(user-error "Fail to select the line to kill")
|
|
|
|
|
(save-excursion (goto-char start)
|
|
|
|
|
(kill-whole-line arg)))))
|
|
|
|
|
(select-window initial-window)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-kill-ring-save-whole-line (arg)
|
|
|
|
|
"Select line and save the whole selected line as if killed, but don’t kill it.
|
|
|
|
|
|
|
|
|
|
This command is similar to `avy-kill-whole-line', except that it
|
|
|
|
|
saves the line(s) as if killed, but does not kill it(them).
|
|
|
|
|
|
|
|
|
|
With a numerical prefix ARG, kill ARG line(s) starting from the
|
|
|
|
|
selected line. If ARG is negative, kill backward.
|
|
|
|
|
|
|
|
|
|
If ARG is zero, kill the selected line but exclude the trailing
|
|
|
|
|
newline."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((initial-window (selected-window)))
|
|
|
|
|
(avy-with avy-kill-ring-save-whole-line
|
|
|
|
|
(let* ((start (avy--line)))
|
|
|
|
|
(if (not (numberp start))
|
|
|
|
|
(user-error "Fail to select the line to kill")
|
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((kill-read-only-ok t)
|
|
|
|
|
(buffer-read-only t))
|
|
|
|
|
(goto-char start)
|
|
|
|
|
(kill-whole-line arg))))))
|
|
|
|
|
(select-window initial-window)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-setup-default ()
|
|
|
|
|
"Setup the default shortcuts."
|
|
|
|
|
(eval-after-load "isearch"
|
|
|
|
|
'(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
|
|
|
|
|
|
|
|
|
|
(defcustom avy-timeout-seconds 0.5
|
|
|
|
|
"How many seconds to wait for the second char."
|
|
|
|
|
:type 'float)
|
|
|
|
|
|
|
|
|
|
(defcustom avy-enter-times-out t
|
|
|
|
|
"Whether enter exits avy-goto-char-timer early. If nil it matches newline"
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defun avy--read-candidates (&optional re-builder)
|
|
|
|
|
"Read as many chars as possible and return their occurrences.
|
|
|
|
|
At least one char must be read, and then repeatedly one next char
|
|
|
|
|
may be read if it is entered before `avy-timeout-seconds'. `C-h'
|
|
|
|
|
or `DEL' deletes the last char entered, and `RET' exits with the
|
|
|
|
|
currently read string immediately instead of waiting for another
|
|
|
|
|
char for `avy-timeout-seconds'.
|
|
|
|
|
The format of the result is the same as that of `avy--regex-candidates'.
|
|
|
|
|
This function obeys `avy-all-windows' setting.
|
|
|
|
|
RE-BUILDER is a function that takes a string and returns a regex.
|
|
|
|
|
When nil, `regexp-quote' is used.
|
|
|
|
|
If a group is captured, the first group is highlighted.
|
|
|
|
|
Otherwise, the whole regex is highlighted."
|
|
|
|
|
(let ((str "")
|
|
|
|
|
(re-builder (or re-builder #'regexp-quote))
|
|
|
|
|
char break overlays regex)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(while (and (not break)
|
|
|
|
|
(setq char
|
|
|
|
|
(read-char (format "char%s: "
|
|
|
|
|
(if (string= str "")
|
|
|
|
|
str
|
|
|
|
|
(format " (%s)" str)))
|
|
|
|
|
t
|
|
|
|
|
(and (not (string= str ""))
|
|
|
|
|
avy-timeout-seconds))))
|
|
|
|
|
;; Unhighlight
|
|
|
|
|
(dolist (ov overlays)
|
|
|
|
|
(delete-overlay ov))
|
|
|
|
|
(setq overlays nil)
|
|
|
|
|
(cond
|
|
|
|
|
;; Handle RET
|
|
|
|
|
((= char 13)
|
|
|
|
|
(if avy-enter-times-out
|
|
|
|
|
(setq break t)
|
|
|
|
|
(setq str (concat str (list ?\n)))))
|
|
|
|
|
;; Handle C-h, DEL
|
|
|
|
|
((memq char '(8 127))
|
|
|
|
|
(let ((l (length str)))
|
|
|
|
|
(when (>= l 1)
|
|
|
|
|
(setq str (substring str 0 (1- l))))))
|
|
|
|
|
(t
|
|
|
|
|
(setq str (concat str (list char)))))
|
|
|
|
|
;; Highlight
|
|
|
|
|
(when (>= (length str) 1)
|
|
|
|
|
(let ((case-fold-search
|
|
|
|
|
(or avy-case-fold-search (string= str (downcase str))))
|
|
|
|
|
found)
|
|
|
|
|
(avy-dowindows current-prefix-arg
|
|
|
|
|
(dolist (pair (avy--find-visible-regions
|
|
|
|
|
(window-start)
|
|
|
|
|
(window-end (selected-window) t)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (car pair))
|
|
|
|
|
(setq regex (funcall re-builder str))
|
|
|
|
|
(while (re-search-forward regex (cdr pair) t)
|
|
|
|
|
(unless (get-char-property (1- (point)) 'invisible)
|
|
|
|
|
(let* ((idx (if (= (length (match-data)) 4) 1 0))
|
|
|
|
|
(ov (make-overlay
|
|
|
|
|
(match-beginning idx) (match-end idx))))
|
|
|
|
|
(setq found t)
|
|
|
|
|
(push ov overlays)
|
|
|
|
|
(overlay-put
|
|
|
|
|
ov 'window (selected-window))
|
|
|
|
|
(overlay-put
|
|
|
|
|
ov 'face 'avy-goto-char-timer-face)))))))
|
|
|
|
|
;; No matches at all, so there's surely a typo in the input.
|
|
|
|
|
(unless found (beep)))))
|
|
|
|
|
(nreverse (mapcar (lambda (ov)
|
|
|
|
|
(cons (cons (overlay-start ov)
|
|
|
|
|
(overlay-end ov))
|
|
|
|
|
(overlay-get ov 'window)))
|
|
|
|
|
overlays)))
|
|
|
|
|
(dolist (ov overlays)
|
|
|
|
|
(delete-overlay ov)))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun avy-goto-char-timer (&optional arg)
|
|
|
|
|
"Read one or many consecutive chars and jump to the first one.
|
|
|
|
|
The window scope is determined by `avy-all-windows' (ARG negates it)."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((avy-all-windows (if arg
|
|
|
|
|
(not avy-all-windows)
|
|
|
|
|
avy-all-windows)))
|
|
|
|
|
(avy-with avy-goto-char-timer
|
|
|
|
|
(avy--process
|
|
|
|
|
(avy--read-candidates)
|
|
|
|
|
(avy--style-fn avy-style)))))
|
|
|
|
|
|
|
|
|
|
(defun avy-push-mark ()
|
|
|
|
|
"Store the current point and window."
|
|
|
|
|
(ring-insert avy-ring
|
|
|
|
|
(cons (point) (selected-window)))
|
|
|
|
|
(unless (region-active-p)
|
|
|
|
|
(push-mark)))
|
|
|
|
|
|
|
|
|
|
(defun avy-pop-mark ()
|
|
|
|
|
"Jump back to the last location of `avy-push-mark'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let (res)
|
|
|
|
|
(condition-case nil
|
|
|
|
|
(progn
|
|
|
|
|
(while (not (window-live-p
|
|
|
|
|
(cdr (setq res (ring-remove avy-ring 0))))))
|
|
|
|
|
(let* ((window (cdr res))
|
|
|
|
|
(frame (window-frame window)))
|
|
|
|
|
(when (and (frame-live-p frame)
|
|
|
|
|
(not (eq frame (selected-frame))))
|
|
|
|
|
(select-frame-set-input-focus frame))
|
|
|
|
|
(select-window window)
|
|
|
|
|
(goto-char (car res))))
|
|
|
|
|
(error
|
|
|
|
|
(set-mark-command 4)))))
|
|
|
|
|
|
|
|
|
|
;; ** Org-mode
|
|
|
|
|
(defvar org-reverse-note-order)
|
|
|
|
|
(declare-function org-refile "org")
|
|
|
|
|
(declare-function org-back-to-heading "org")
|
|
|
|
|
|
|
|
|
|
(defun avy-org-refile-as-child ()
|
|
|
|
|
"Refile current heading as first child of heading selected with `avy.'"
|
|
|
|
|
;; Inspired by `org-teleport': http://kitchingroup.cheme.cmu.edu/blog/2016/03/18/Org-teleport-headlines/
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((rfloc (save-excursion
|
|
|
|
|
(let* ((org-reverse-note-order t)
|
|
|
|
|
(pos (avy-with avy-goto-line
|
|
|
|
|
(avy--generic-jump (rx bol (1+ "*") (1+ space))
|
|
|
|
|
nil avy-style)
|
|
|
|
|
(point)))
|
|
|
|
|
(filename (buffer-file-name (or (buffer-base-buffer (current-buffer))
|
|
|
|
|
(current-buffer)))))
|
|
|
|
|
(list nil filename nil pos)))))
|
|
|
|
|
;; org-refile must be called outside of the excursion
|
|
|
|
|
(org-refile nil nil rfloc)))
|
|
|
|
|
|
|
|
|
|
(defun avy-org-goto-heading-timer (&optional arg)
|
|
|
|
|
"Read one or many characters and jump to matching Org headings.
|
|
|
|
|
The window scope is determined by `avy-all-windows' (ARG negates it)."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((avy-all-windows (if arg
|
|
|
|
|
(not avy-all-windows)
|
|
|
|
|
avy-all-windows)))
|
|
|
|
|
(avy-with avy-goto-char-timer
|
|
|
|
|
(avy--process
|
|
|
|
|
(avy--read-candidates
|
|
|
|
|
(lambda (input)
|
|
|
|
|
(format "^\\*+ .*\\(%s\\)" input)))
|
|
|
|
|
(avy--style-fn avy-style))
|
|
|
|
|
(org-back-to-heading))))
|
|
|
|
|
|
|
|
|
|
(provide 'avy)
|
|
|
|
|
|
|
|
|
|
;;; avy.el ends here
|