1 ;;; avy.el --- set-based completion -*- lexical-binding: t -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
8 ;; This file is part of GNU Emacs.
10 ;; This file is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; For a full copy of the GNU General Public License
21 ;; see <http://www.gnu.org/licenses/>.
25 ;; This package provides a generic completion method based on building
26 ;; a balanced decision tree with each candidate being a leaf. To
27 ;; traverse the tree from the root to a desired leaf, typically a
28 ;; sequence of `read-char' can be used.
30 ;; In order for `read-char' to make sense, the tree needs to be
31 ;; visualized appropriately, with a character at each branch node. So
32 ;; this completion method works only for things that you can see on
33 ;; your screen, all at once:
35 ;; * character positions
36 ;; * word or subword start positions
37 ;; * line beginning positions
41 ;; If you're familiar with the popular `ace-jump-mode' package, this
42 ;; package does all that and more, without the implementation
48 (defmacro avy-multipop (lst n)
49 "Remove LST's first N elements and return them."
50 `(if (<= (length ,lst) ,n)
55 (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
58 (defun avy-tree (lst keys)
59 "Coerce LST into a balanced tree.
60 The degree of the tree is the length of KEYS.
61 KEYS are placed appropriately on internal nodes."
62 (let ((len (length keys)))
65 (let ((ln (length ls)))
68 (mapcar (lambda (x) (cons 'leaf x)) ls))
69 (let ((ks (copy-sequence keys))
71 (dolist (s (avy-subdiv ln len))
75 (rd (avy-multipop ls s))))
80 (defun avy-subdiv (n b)
81 "Distribute N in B terms in a balanced way."
82 (let* ((p (1- (floor (+ (log n b) 1e-6))))
86 (n2 (/ delta (- x2 x1)))
91 (- n (* n1 x1) (* n2 x2)))
94 (defun avy-traverse (tree walker &optional recur-key)
95 "Traverse TREE generated by `avy-tree'.
96 WALKER is a function that takes KEYS and LEAF.
98 RECUR-KEY is used in recursion.
100 LEAF is a member of LST argument of `avy-tree'.
102 KEYS is the path from the root of `avy-tree' to LEAF."
104 (let ((key (cons (car br) recur-key)))
105 (if (eq (cadr br) 'leaf)
106 (funcall walker key (cddr br))
107 (avy-traverse (cdr br) walker key)))))
109 (defun avy-read (tree display-fn cleanup-fn)
110 "Select a leaf from TREE using consecutive `read-char'.
112 DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
113 associated with CHAR will be selected if CHAR is pressed. This is
114 commonly done by adding a CHAR overlay at LEAF position.
116 CLEANUP-FN should take no arguments and remove the effects of
117 multiple DISPLAY-FN invokations."
120 (avy-traverse tree display-fn)
121 (let ((char (read-char))
124 (if (setq branch (assoc char tree))
125 (if (eq (car (setq tree (cdr branch))) 'leaf)
126 (throw 'done (cdr tree)))
127 (signal 'user-error (list "No such candidate" char))
128 (throw 'done nil))))))