From: Oleh Krehel Date: Fri, 8 May 2015 13:34:46 +0000 (+0200) Subject: Add 'packages/avy/' from commit '32003515c8efa2cf38b62c45499dae30bc7cacb8' X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/876d210333969ec8c6723216917150c7b532082e?hp=74b34f2bbb929a1caf5cf753e59c54c3ccb74f50 Add 'packages/avy/' from commit '32003515c8efa2cf38b62c45499dae30bc7cacb8' git-subtree-dir: packages/avy git-subtree-mainline: 74b34f2bbb929a1caf5cf753e59c54c3ccb74f50 git-subtree-split: 32003515c8efa2cf38b62c45499dae30bc7cacb8 --- diff --git a/packages/avy/Makefile b/packages/avy/Makefile new file mode 100644 index 000000000..e1551794f --- /dev/null +++ b/packages/avy/Makefile @@ -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 diff --git a/packages/avy/README.md b/packages/avy/README.md new file mode 100644 index 000000000..01bf587de --- /dev/null +++ b/packages/avy/README.md @@ -0,0 +1,88 @@ +## Introduction + +`avy-jump` is a GNU Emacs package for jumping to visible text using a char-based decision tree. See also [ace-jump-mode](https://github.com/winterTTr/ace-jump-mode) and [vim-easymotion](https://github.com/Lokaltog/vim-easymotion) - `avy-jump` uses the same idea. + +![logo](https://raw.githubusercontent.com/wiki/abo-abo/avy-jump/images/avy-avatar-1.png) + +## Command overview + +You can bind some of these useful commands in your config. + +### `avy-goto-char` + +> Input one char, jump to it with a tree. + +```elisp +(global-set-key (kbd "π") 'avy-goto-char) +``` + +After πb: + +![avy-goto-char](http://oremacs.com/download/avi-goto-char.png) + +### `avy-goto-char-2` + +> Input two consecutive chars, jump to the first one with a tree. + +The advantage over the previous one is less candidates for the tree search. And it's not too inconvenient to enter two consecutive chars instead of one. + +```elisp +(global-set-key (kbd "C-'") 'avy-goto-char-2) +``` + +After C-' bu: + +![avy-goto-char-2](http://oremacs.com/download/avi-goto-char-2.png) + +### `avy-goto-line` + +> Input zero chars, jump to a line start with a tree. + +```elisp +(global-set-key (kbd "M-g f") 'avy-goto-line) +``` + +After M-g f: + +![avy-goto-line](http://oremacs.com/download/avi-goto-line.png) + +### `avy-goto-word-1` + +> Input one char at word start, jump to a word start with a tree. + +```elisp +(global-set-key (kbd "M-g w") 'avy-goto-word-1) +``` + +After M-g wb: + +![avy-goto-word-1](http://oremacs.com/download/avi-goto-word-1.png) + +### `avy-goto-word-0` + +> Input zero chars, jump to a word start with a tree. + +Compared to `avy-goto-word-1`, there are a lot more candidates. But at a least there's not need to input the initial char. + +```elisp +(global-set-key (kbd "M-g e") 'avy-goto-word-0) +``` + +After M-g e: + +![avy-goto-word-0](http://oremacs.com/download/avi-goto-word-0.png) + + +### Other commands + +There are some more commands which you can explore yourself by looking at the code. + +### Bindings + +You add this to your config to bind some stuff: + +```elisp +(avy-setup-default) +``` + +It will bind, for example, `avy-isearch` to C-' in `isearch-mode-map`, so that you can select one of the currently visible `isearch` candidates using `avy`. diff --git a/packages/avy/avy-init.el b/packages/avy/avy-init.el new file mode 100644 index 000000000..37cf18e86 --- /dev/null +++ b/packages/avy/avy-init.el @@ -0,0 +1,26 @@ +;;; 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 . + +(add-to-list 'load-path default-directory) +(mapc #'byte-compile-file '("avy.el" "avy-jump.el")) +(require 'avy-jump) +(global-set-key (kbd "C-c j") 'avy-goto-char) +(global-set-key (kbd "C-'") 'avy-goto-char-2) diff --git a/packages/avy/avy-jump.el b/packages/avy/avy-jump.el new file mode 100644 index 000000000..d6bb52e79 --- /dev/null +++ b/packages/avy/avy-jump.el @@ -0,0 +1,470 @@ +;;; avy-jump.el --- jump to things tree-style. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; URL: https://github.com/abo-abo/avy-jump +;; Version: 0.1.0 +;; 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 . + +;;; 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 "avy-") + +(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) + "Keys for jumping.") + +(defcustom avy-background nil + "When non-nil, a gray background will be added during the selection." + :type 'boolean) + +(defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]" + "Regexp of punctuation characters that should be matched when calling +`avy-goto-word-1' command. When nil, punctuation chars will not be matched. + +\"[!-/:-@[-`{-~]\" will match all printable punctuation 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.") + +;;* Internals +(defcustom avy-all-windows t + "When non-nil, loop though all windows for candidates." + :type 'boolean) + +(defmacro avy-dowindows (flip &rest body) + "Depending on FLIP and `avy-all-windows' run BODY in each or selected window." + (declare (indent 1)) + `(let ((avy-all-windows (if ,flip + (not avy-all-windows) + avy-all-windows))) + (dolist (wnd (if avy-all-windows + (window-list) + (list (selected-window)))) + (with-selected-window wnd + (unless (memq major-mode '(image-mode doc-view-mode)) + ,@body))))) + +(defun avy--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 avy--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 avy-keys) + overlay-fn + #'avy--remove-leading-chars))) + (avy--done))) + +(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) + 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--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) + (avy-dowindows nil + (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 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--overlay (str pt wnd) + "Create an overlay with STR at PT in WND." + (when (<= (1+ pt) (with-selected-window wnd (point-max))) + (let* ((pt (+ pt avy--overlay-offset)) + (ol (make-overlay pt (1+ pt) (window-buffer wnd))) + (old-str (with-selected-window wnd + (buffer-substring pt (1+ pt))))) + (when avy-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 avy--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)." + (avy--overlay + (propertize (apply #'string (reverse path)) + 'face 'avy-lead-face) + (cond ((numberp leaf) + leaf) + ((consp (car leaf)) + (caar leaf)) + (t + (car leaf))) + (if (consp leaf) + (cdr leaf) + (selected-window)))) + +(defun avy--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 'avy-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 avy-background + (setq old-str (propertize + old-str 'face 'avy-background-face))) + (overlay-put ol 'window wnd) + (overlay-put ol 'display (if (string= old-str "\n") + (concat str "\n") + str)) + (push ol avy--overlays-lead)))) + +(defun avy--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)." + (avy--overlay + (propertize (apply #'string (reverse path)) + 'face 'avy-lead-face) + (cond ((numberp leaf) + leaf) + ((consp (car leaf)) + (cdar leaf)) + (t + (car leaf))) + (if (consp leaf) + (cdr leaf) + (selected-window)))) + +(defun avy--style-fn (style) + "Transform STYLE symbol to a style function." + (cl-case style + (pre #'avy--overlay-pre) + (at #'avy--overlay-at) + (post #'avy--overlay-post) + (t (error "Unexpected style %S" style)))) + +(defun avy--generic-jump (regex window-flip style) + "Jump to REGEX. +When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'. +STYLE determines the leading char overlay style." + (let ((avy-all-windows + (if window-flip + (not avy-all-windows) + avy-all-windows))) + (avy--goto + (avy--process + (avy--regex-candidates + regex) + (avy--style-fn style))))) + +(defcustom avy-goto-char-style 'pre + "Method of displaying the overlays for `avy-goto-char' and `avy-goto-char-2'." + :type '(choice + (const :tag "Pre" pre) + (const :tag "At" at) + (const :tag "Post" post))) + +(defcustom avy-goto-word-style 'pre + "Method of displaying the overlays for `avy-goto-word-0' and `avy-goto-word-0'." + :type '(choice + (const :tag "Pre" pre) + (const :tag "At" at) + (const :tag "Post" post))) + +;;* Commands +;;;###autoload +(defun avy-goto-char (&optional arg) + "Read one char and jump to it. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive "P") + (avy--generic-jump + (let ((c (read-char "char: "))) + (if (= 13 c) + "\n" + (regexp-quote (string c)))) + arg + avy-goto-char-style)) + +;;;###autoload +(defun avy-goto-char-2 (&optional arg) + "Read two consecutive chars and jump to the first one. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive "P") + (avy--generic-jump + (regexp-quote (string + (read-char "char 1: ") + (read-char "char 2: "))) + arg + avy-goto-char-style)) + +;;;###autoload +(defun avy-isearch () + "Jump to one of the current isearch candidates." + (interactive) + (let* ((candidates + (avy--regex-candidates isearch-string)) + (avy-background nil) + (candidate + (avy--process candidates #'avy--overlay-post))) + (isearch-done) + (avy--goto candidate))) + +;;;###autoload +(defun avy-goto-word-0 (arg) + "Jump to a word start. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive "P") + (let ((avy-keys (number-sequence ?a ?z))) + (avy--generic-jump "\\b\\sw" arg avy-goto-word-style))) + +;;;###autoload +(defun avy-goto-word-1 (&optional arg) + "Read one char at word start and jump there. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive "P") + (let* ((str (string (read-char "char: "))) + (regex (cond ((string= str ".") + "\\.") + ((and avy-word-punc-regexp + (string-match avy-word-punc-regexp str)) + str) + (t + (concat + "\\b" + str))))) + (avy--generic-jump regex arg avy-goto-word-style))) + +(declare-function subword-backward "subword") + +;;;###autoload +(defun avy-goto-subword-0 (&optional arg predicate) + "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." + (interactive "P") + (require 'subword) + (let ((avy-keys (number-sequence ?a ?z)) + (case-fold-search nil) + candidates) + (avy-dowindows arg + (let ((ws (window-start))) + (save-excursion + (goto-char (window-end (selected-window) t)) + (subword-backward) + (while (> (point) ws) + (when (or (null predicate) + (and predicate (funcall predicate))) + (push (cons (point) (selected-window)) candidates)) + (subword-backward))))) + (avy--goto + (avy--process candidates (avy--style-fn avy-goto-word-style))))) + +;;;###autoload +(defun avy-goto-subword-1 (&optional arg) + "Prompt for a subword start char and jump there. +The window scope is determined by `avy-all-windows' (ARG negates it). +The case is ignored." + (interactive "P") + (let ((char (downcase (read-char "char: ")))) + (avy-goto-subword-0 + arg (lambda () (eq (downcase (char-after)) char))))) + +(defun avy--line (&optional arg) + "Select line in current window." + (let ((avy-background nil) + candidates) + (avy-dowindows arg + (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)))))) + (avy--process (nreverse candidates) #'avy--overlay-pre))) + +;;;###autoload +(defun avy-goto-line (&optional arg) + "Jump to a line start in current buffer." + (interactive "P") + (avy--goto (avy--line arg))) + +;;;###autoload +(defun avy-copy-line (arg) + "Copy a selected line above the current line. +ARG lines can be used." + (interactive "p") + (let ((start (car (avy--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 avy-move-line (arg) + "Move a selected line above the current line. +ARG lines can be used." + (interactive "p") + (let ((start (car (avy--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 avy-copy-region () + "Select two lines and copy the text between them here." + (interactive) + (let ((beg (car (avy--line))) + (end (car (avy--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)))) + +;;;###autoload +(defun avy-setup-default () + "Setup the default shortcuts." + (eval-after-load 'isearch + '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch))) + +(define-obsolete-variable-alias 'avi-keys 'avy-keys "0.1.0") +(define-obsolete-variable-alias 'avi-background 'avy-background "0.1.0") +(define-obsolete-variable-alias 'avi-word-punc-regexp 'avy-word-punc-regexp "0.1.0") +(define-obsolete-face-alias 'avi-lead-face 'avy-lead-face "0.1.0") +(define-obsolete-function-alias 'avi--goto 'avy--goto "0.1.0") +(define-obsolete-function-alias 'avi--process 'avy--process "0.1.0") +(define-obsolete-variable-alias 'avi-all-windows 'avy-all-windows "0.1.0") +(define-obsolete-function-alias 'avi--overlay-pre 'avy--overlay-pre "0.1.0") +(define-obsolete-function-alias 'avi--overlay-at 'avy--overlay-at "0.1.0") +(define-obsolete-function-alias 'avi--overlay-post 'avy--overlay-post "0.1.0") +(define-obsolete-function-alias 'avi-goto-char 'avy-goto-char "0.1.0") +(define-obsolete-function-alias 'avi-goto-char-2 'avy-goto-char-2 "0.1.0") +(define-obsolete-function-alias 'avi-isearch 'avy-isearch "0.1.0") +(define-obsolete-function-alias 'avi-goto-word-0 'avy-goto-word-0 "0.1.0") +(define-obsolete-function-alias 'avi-goto-subword-0 'avy-goto-subword-0 "0.1.0") +(define-obsolete-function-alias 'avi-goto-word-1 'avy-goto-word-1 "0.1.0") +(define-obsolete-function-alias 'avi-goto-line 'avy-goto-line "0.1.0") +(define-obsolete-function-alias 'avi-copy-line 'avy-copy-line "0.1.0") +(define-obsolete-function-alias 'avi-move-line 'avy-move-line "0.1.0") +(define-obsolete-function-alias 'avi-copy-region 'avy-copy-region "0.1.0") +(define-obsolete-function-alias 'avi--regex-candidates 'avy--regex-candidates "0.1.0") + +(provide 'avy-jump) + +;;; avy-jump.el ends here diff --git a/packages/avy/avy-test.el b/packages/avy/avy-test.el new file mode 100644 index 000000000..339d8a06d --- /dev/null +++ b/packages/avy/avy-test.el @@ -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 . + +;;; 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)))))) diff --git a/packages/avy/avy.el b/packages/avy/avy.el new file mode 100644 index 000000000..6a0dea762 --- /dev/null +++ b/packages/avy/avy.el @@ -0,0 +1,131 @@ +;;; 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 . + +;;; Commentary: +;; +;; This package provides a generic completion method based on building +;; a balanced decision tree with each candidate being a leaf. To +;; traverse the tree from the root to a desired leaf, typically a +;; sequence of `read-char' can be used. +;; +;; In order for `read-char' to make sense, the tree needs to be +;; visualized appropriately, with a character at each branch node. So +;; this completion method works only for things that you can see on +;; your screen, all at once: +;; +;; * 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-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