mirror of
https://github.com/abo-abo/avy.git
synced 2025-10-13 05:23:05 +00:00
Initial import
This commit is contained in:
Oleh Krehel
commit
5d2979b911
20
Makefile
Normal file
20
Makefile
Normal file
@ -0,0 +1,20 @@
|
||||
emacs ?= emacs
|
||||
# EMACS = emacs-24.3
|
||||
|
||||
LOAD = -l avy.el -l avy-test.el
|
||||
|
||||
.PHONY: all test clean
|
||||
|
||||
all: test
|
||||
|
||||
test:
|
||||
$(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit
|
||||
|
||||
compile:
|
||||
$(emacs) -batch -l avy-init.el
|
||||
|
||||
run:
|
||||
$(emacs) -Q -l avy-init.el
|
||||
|
||||
clean:
|
||||
rm -f *.elc
|
||||
27
avy-init.el
Normal file
27
avy-init.el
Normal file
@ -0,0 +1,27 @@
|
||||
;;; avy-init.el --- bare avy init
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(add-to-list 'load-path default-directory)
|
||||
(mapc #'byte-compile-file '("avy.el" "avy-jump.el" "ace-window.el"))
|
||||
(require 'ace-window)
|
||||
(require 'avy-jump)
|
||||
(global-set-key (kbd "C-c j") 'avi-goto-char)
|
||||
(global-set-key (kbd "C-'") 'avi-goto-char-2)
|
||||
383
avy-jump.el
Normal file
383
avy-jump.el
Normal file
@ -0,0 +1,383 @@
|
||||
;;; avy-jump.el --- jump to things tree-style
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; This package offers various commands for navigating to things using `avy'.
|
||||
;; They are in the "Commands" outline.
|
||||
|
||||
;;; Code:
|
||||
;;* Requires
|
||||
(require 'avy)
|
||||
|
||||
;;* Customization
|
||||
(defgroup avy-jump nil
|
||||
"Jump to things tree-style."
|
||||
:group 'convenience
|
||||
:prefix "avi-")
|
||||
|
||||
(defcustom avi-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
|
||||
"Keys for jumping.")
|
||||
|
||||
(defcustom avi-background nil
|
||||
"When non-nil, a gray background will be added during the selection."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom avi-word-punc-regexp "[!-/:-@[-`{-~]"
|
||||
"Regexp of punctuation characters that should be matched when calling
|
||||
`avi-goto-word-1' command. When nil, punctuation chars will not be matched.
|
||||
|
||||
\"[!-/:-@[-`{-~]\" will match all printable punctuation chars.")
|
||||
|
||||
(defface avi-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.")
|
||||
|
||||
;;* Internals
|
||||
(defun avi--goto (x)
|
||||
"Goto X.
|
||||
X is (POS . WND)
|
||||
POS is either a position or (BEG . END)."
|
||||
(if (null x)
|
||||
(message "zero candidates")
|
||||
(select-window (cdr x))
|
||||
(let ((pt (car x)))
|
||||
(when (consp pt)
|
||||
(setq pt (car pt)))
|
||||
(unless (= pt (point)) (push-mark))
|
||||
(goto-char pt))))
|
||||
|
||||
(defun avi--process (candidates overlay-fn)
|
||||
"Select one of CANDIDATES using `avy-read'."
|
||||
(unwind-protect
|
||||
(cl-case (length candidates)
|
||||
(0
|
||||
nil)
|
||||
(1
|
||||
(car candidates))
|
||||
(t
|
||||
(avy--make-backgrounds (list (selected-window)))
|
||||
(avy-read (avy-tree candidates avi-keys)
|
||||
overlay-fn
|
||||
#'avy--remove-leading-chars)))
|
||||
(avy--done)))
|
||||
|
||||
(defvar avy--overlays-back nil
|
||||
"Hold overlays for when `avi-background' is t.")
|
||||
|
||||
(defun avy--make-backgrounds (wnd-list)
|
||||
"Create a dim background overlay for each window on WND-LIST."
|
||||
(when avi-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)
|
||||
ol))
|
||||
wnd-list))))
|
||||
|
||||
(defun avy--done ()
|
||||
"Clean up overlays."
|
||||
(mapc #'delete-overlay avy--overlays-back)
|
||||
(setq avy--overlays-back nil)
|
||||
(avy--remove-leading-chars))
|
||||
|
||||
(defcustom avi-all-windows t
|
||||
"When non-nil, loop though all windows for candidates."
|
||||
:type 'boolean)
|
||||
|
||||
(defun avi--regex-candidates (regex &optional wnd beg end pred)
|
||||
"Return all elements that match REGEX in WND.
|
||||
Each element of the list is ((BEG . END) . WND)
|
||||
When PRED is non-nil, it's a filter for matching point positions."
|
||||
(let (candidates)
|
||||
(dolist (wnd (if avi-all-windows
|
||||
(window-list)
|
||||
(list (selected-window))))
|
||||
(with-selected-window wnd
|
||||
(let ((we (or end (window-end (selected-window) t))))
|
||||
(save-excursion
|
||||
(goto-char (or beg (window-start)))
|
||||
(while (re-search-forward regex we t)
|
||||
(unless (get-char-property (point) 'invisible)
|
||||
(when (or (null pred)
|
||||
(funcall pred))
|
||||
(push (cons (cons (match-beginning 0)
|
||||
(match-end 0))
|
||||
wnd) candidates))))))))
|
||||
(nreverse candidates)))
|
||||
|
||||
(defvar avi--overlay-offset 0
|
||||
"The offset to apply in `avi--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 avi--overlay (str pt wnd)
|
||||
"Create an overlay with STR at PT in WND."
|
||||
(let* ((pt (+ pt avi--overlay-offset))
|
||||
(ol (make-overlay pt (1+ pt) (window-buffer wnd)))
|
||||
(old-str (with-selected-window wnd
|
||||
(buffer-substring pt (1+ pt)))))
|
||||
(when avi-background
|
||||
(setq old-str (propertize
|
||||
old-str 'face 'avy-background-face)))
|
||||
(overlay-put ol 'window wnd)
|
||||
(overlay-put ol 'display (concat str old-str))
|
||||
(push ol avy--overlays-lead)))
|
||||
|
||||
(defun avi--overlay-pre (path leaf)
|
||||
"Create an overlay with STR at LEAF.
|
||||
PATH is a list of keys from tree root to LEAF.
|
||||
LEAF is ((BEG . END) . WND)."
|
||||
(avi--overlay
|
||||
(propertize (apply #'string (reverse path))
|
||||
'face 'avi-lead-face)
|
||||
(cond ((numberp leaf)
|
||||
leaf)
|
||||
((consp (car leaf))
|
||||
(caar leaf))
|
||||
(t
|
||||
(car leaf)))
|
||||
(if (consp leaf)
|
||||
(cdr leaf)
|
||||
(selected-window))))
|
||||
|
||||
(defun avi--overlay-at (path leaf)
|
||||
"Create an overlay with STR at LEAF.
|
||||
PATH is a list of keys from tree root to LEAF.
|
||||
LEAF is ((BEG . END) . WND)."
|
||||
(let ((str (propertize
|
||||
(string (car (last path)))
|
||||
'face 'avi-lead-face))
|
||||
(pt (if (consp (car leaf))
|
||||
(caar leaf)
|
||||
(car leaf)))
|
||||
(wnd (cdr leaf)))
|
||||
(let ((ol (make-overlay pt (1+ pt)
|
||||
(window-buffer wnd)))
|
||||
(old-str (with-selected-window wnd
|
||||
(buffer-substring pt (1+ pt)))))
|
||||
(when avi-background
|
||||
(setq old-str (propertize
|
||||
old-str 'face 'avy-background-face)))
|
||||
(overlay-put ol 'window wnd)
|
||||
(overlay-put ol 'display str)
|
||||
(push ol avy--overlays-lead))))
|
||||
|
||||
(defun avi--overlay-post (path leaf)
|
||||
"Create an overlay with STR at LEAF.
|
||||
PATH is a list of keys from tree root to LEAF.
|
||||
LEAF is ((BEG . END) . WND)."
|
||||
(avi--overlay
|
||||
(propertize (apply #'string (reverse path))
|
||||
'face 'avi-lead-face)
|
||||
(cond ((numberp leaf)
|
||||
leaf)
|
||||
((consp (car leaf))
|
||||
(cdar leaf))
|
||||
(t
|
||||
(car leaf)))
|
||||
(if (consp leaf)
|
||||
(cdr leaf)
|
||||
(selected-window))))
|
||||
|
||||
(defun avi--generic-jump (regex flip)
|
||||
"Jump to REGEX.
|
||||
When FLIP is non-nil, flip `avi-all-windows'."
|
||||
(let ((avi-all-windows
|
||||
(if flip
|
||||
(not avi-all-windows)
|
||||
avi-all-windows)))
|
||||
(avi--goto
|
||||
(avi--process
|
||||
(avi--regex-candidates
|
||||
regex)
|
||||
#'avi--overlay-post))))
|
||||
|
||||
;;* Commands
|
||||
;;;###autoload
|
||||
(defun avi-goto-char (&optional arg)
|
||||
"Read one char and jump to it.
|
||||
The window scope is determined by `avi-all-windows'.
|
||||
When ARG is non-nil, flip the window scope."
|
||||
(interactive "P")
|
||||
(avi--generic-jump
|
||||
(string (read-char "char: ")) arg))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-goto-char-2 (&optional arg)
|
||||
"Read two chars and jump to them in current window.
|
||||
When ARG is non-nil, flip the window scope."
|
||||
(interactive "P")
|
||||
(avi--generic-jump
|
||||
(string
|
||||
(read-char "char 1: ")
|
||||
(read-char "char 2: "))
|
||||
arg))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-isearch ()
|
||||
"Jump to one of the current isearch candidates."
|
||||
(interactive)
|
||||
(let* ((candidates
|
||||
(avi--regex-candidates isearch-string))
|
||||
(avi-background nil)
|
||||
(candidate
|
||||
(avi--process candidates #'avi--overlay-post)))
|
||||
(isearch-done)
|
||||
(avi--goto candidate)))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-goto-word-0 (arg)
|
||||
"Jump to a word start."
|
||||
(interactive "P")
|
||||
(let ((avi-keys (number-sequence ?a ?z)))
|
||||
(avi--generic-jump "\\b\\sw" arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-goto-subword-0 (&optional arg)
|
||||
"Jump to a word or subword start."
|
||||
(interactive "P")
|
||||
(let* ((avi-all-windows
|
||||
(if arg
|
||||
(not avi-all-windows)
|
||||
avi-all-windows))
|
||||
(avi-keys (number-sequence ?a ?z))
|
||||
(candidates (avi--regex-candidates
|
||||
"\\(\\b\\sw\\)\\|\\(?:[^A-Z]\\([A-Z]\\)\\)")))
|
||||
(dolist (x candidates)
|
||||
(when (> (- (cdar x) (caar x)) 1)
|
||||
(cl-incf (caar x))))
|
||||
(avi--goto
|
||||
(avi--process candidates #'avi--overlay-pre))))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-goto-word-1 ()
|
||||
"Jump to a word start in current window.
|
||||
Read one char with which the word should start."
|
||||
(interactive)
|
||||
(let* ((str (string (read-char "char: ")))
|
||||
(candidates (avi--regex-candidates
|
||||
(if (and avi-word-punc-regexp
|
||||
(string-match avi-word-punc-regexp str))
|
||||
str
|
||||
(concat
|
||||
"\\b"
|
||||
str)))))
|
||||
(avi--goto
|
||||
(avi--process candidates #'avi--overlay-pre))))
|
||||
|
||||
(defun avi--line (&optional arg)
|
||||
"Select line in current window."
|
||||
(let ((avi-background nil)
|
||||
(avi-all-windows
|
||||
(if arg
|
||||
(not avi-all-windows)
|
||||
avi-all-windows))
|
||||
candidates)
|
||||
(dolist (wnd (if avi-all-windows
|
||||
(window-list)
|
||||
(list (selected-window))))
|
||||
(with-selected-window wnd
|
||||
(let ((ws (window-start)))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region ws (window-end (selected-window) t))
|
||||
(goto-char (point-min))
|
||||
(while (< (point) (point-max))
|
||||
(unless (get-char-property
|
||||
(max (1- (point)) ws) 'invisible)
|
||||
(push (cons (point) (selected-window))
|
||||
candidates))
|
||||
(forward-line 1)))))))
|
||||
(avi--process (nreverse candidates) #'avi--overlay-pre)))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-goto-line (&optional arg)
|
||||
"Jump to a line start in current buffer."
|
||||
(interactive "P")
|
||||
(avi--goto (avi--line arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-copy-line (arg)
|
||||
"Copy a selected line above the current line.
|
||||
ARG lines can be used."
|
||||
(interactive "p")
|
||||
(let ((start (car (avi--line))))
|
||||
(move-beginning-of-line nil)
|
||||
(save-excursion
|
||||
(insert
|
||||
(buffer-substring-no-properties
|
||||
start
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(move-end-of-line arg)
|
||||
(point)))
|
||||
"\n"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-move-line (arg)
|
||||
"Move a selected line above the current line.
|
||||
ARG lines can be used."
|
||||
(interactive "p")
|
||||
(let ((start (car (avi--line))))
|
||||
(move-beginning-of-line nil)
|
||||
(save-excursion
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(move-end-of-line arg)
|
||||
(kill-region start (point)))
|
||||
(insert
|
||||
(current-kill 0)
|
||||
"\n"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun avi-copy-region ()
|
||||
"Select two lines and copy the text between them here."
|
||||
(interactive)
|
||||
(let ((beg (car (avi--line)))
|
||||
(end (car (avi--line)))
|
||||
(pad (if (bolp) "" "\n")))
|
||||
(move-beginning-of-line nil)
|
||||
(save-excursion
|
||||
(insert
|
||||
(buffer-substring-no-properties
|
||||
beg
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(line-end-position)))
|
||||
pad))))
|
||||
|
||||
(provide 'avy-jump)
|
||||
|
||||
;;; avy-jump.el ends here
|
||||
68
avy-test.el
Normal file
68
avy-test.el
Normal file
@ -0,0 +1,68 @@
|
||||
;;; avy-test.el --- Tests for avy
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'avy)
|
||||
|
||||
(ert-deftest avy-subdiv ()
|
||||
(should
|
||||
(equal (avy-subdiv 5 4)
|
||||
'(1 1 1 2)))
|
||||
(should
|
||||
(equal (avy-subdiv 10 4)
|
||||
'(1 1 4 4)))
|
||||
(should
|
||||
(equal (avy-subdiv 16 4)
|
||||
'(4 4 4 4)))
|
||||
(should
|
||||
(equal (avy-subdiv 17 4)
|
||||
'(4 4 4 5)))
|
||||
(should
|
||||
(equal (avy-subdiv 27 4)
|
||||
'(4 4 4 15)))
|
||||
(should
|
||||
(equal (avy-subdiv 50 4)
|
||||
'(4 14 16 16)))
|
||||
(should
|
||||
(equal (avy-subdiv 65 4)
|
||||
'(16 16 16 17))))
|
||||
|
||||
(ert-deftest avy-tree ()
|
||||
(should
|
||||
(equal
|
||||
(avy-tree '(0 1 2 3 4 5 6 7 8 9 10)
|
||||
'(?a ?s ?d ?f ?g ?h ?j ?k ?l))
|
||||
'((97 leaf . 0)
|
||||
(115 leaf . 1)
|
||||
(100 leaf . 2)
|
||||
(102 leaf . 3)
|
||||
(103 leaf . 4)
|
||||
(104 leaf . 5)
|
||||
(106 leaf . 6)
|
||||
(107 leaf . 7)
|
||||
(108 (97 leaf . 8)
|
||||
(115 leaf . 9)
|
||||
(100 leaf . 10))))))
|
||||
118
avy.el
Normal file
118
avy.el
Normal file
@ -0,0 +1,118 @@
|
||||
;;; avy.el --- set-based completion -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; Given a LIST and KEYS, `avy-tree' will build a balanced tree of
|
||||
;; degree B, where B is the length of KEYS.
|
||||
;;
|
||||
;; The corresponding member of KEYS is placed in each internal node of
|
||||
;; the tree. The leafs are the members of LIST. They can be obtained
|
||||
;; in the original order by traversing the tree depth-first.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-macs)
|
||||
|
||||
(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-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."
|
||||
(let ((len (length keys)))
|
||||
(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)))))
|
||||
|
||||
(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 invokations."
|
||||
(catch 'done
|
||||
(while tree
|
||||
(avy-traverse tree display-fn)
|
||||
(let ((char (read-char))
|
||||
branch)
|
||||
(funcall cleanup-fn)
|
||||
(if (setq branch (assoc char tree))
|
||||
(if (eq (car (setq tree (cdr branch))) 'leaf)
|
||||
(throw 'done (cdr tree)))
|
||||
(signal 'user-error (list "No such candidate" char))
|
||||
(throw 'done nil))))))
|
||||
|
||||
(provide 'avy)
|
||||
|
||||
;;; avy.el ends here
|
||||
Loading…
x
Reference in New Issue
Block a user