code.delx.au - gnu-emacs-elpa/blob - packages/avy/avy.el

   1 ;;; avy.el --- set-based completion -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
   6 ;; URL: https://github.com/abo-abo/avy
   7 ;; Version: 0.2.0
   8 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
   9 ;; Keywords: point, location
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; For a full copy of the GNU General Public License
  24 ;; see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; This package provides a generic completion method based on building
  29 ;; a balanced decision tree with each candidate being a leaf. To
  30 ;; traverse the tree from the root to a desired leaf, typically a
  31 ;; sequence of `read-char' can be used.
  32 ;;
  33 ;; In order for `read-char' to make sense, the tree needs to be
  34 ;; visualized appropriately, with a character at each branch node. So
  35 ;; this completion method works only for things that you can see on
  36 ;; your screen, all at once:
  37 ;;
  38 ;; * character positions
  39 ;; * word or subword start positions
  40 ;; * line beginning positions
  41 ;; * link positions
  42 ;; * window positions
  43 ;;
  44 ;; If you're familiar with the popular `ace-jump-mode' package, this
  45 ;; package does all that and more, without the implementation
  46 ;; headache.
  47
  48 ;;; Code:
  49 (require 'cl-lib)
  50
  51 (defmacro avy-multipop (lst n)
  52   "Remove LST's first N elements and return them."
  53   `(if (<= (length ,lst) ,n)
  54        (prog1 ,lst
  55          (setq ,lst nil))
  56      (prog1 ,lst
  57        (setcdr
  58         (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
  59         nil))))
  60
  61 (defun avy-tree (lst keys)
  62   "Coerce LST into a balanced tree.
  63 The degree of the tree is the length of KEYS.
  64 KEYS are placed appropriately on internal nodes."
  65   (let ((len (length keys)))
  66     (cl-labels
  67         ((rd (ls)
  68            (let ((ln (length ls)))
  69              (if (< ln len)
  70                  (cl-pairlis keys
  71                              (mapcar (lambda (x) (cons 'leaf x)) ls))
  72                (let ((ks (copy-sequence keys))
  73                      res)
  74                  (dolist (s (avy-subdiv ln len))
  75                    (push (cons (pop ks)
  76                                (if (eq s 1)
  77                                    (cons 'leaf (pop ls))
  78                                  (rd (avy-multipop ls s))))
  79                          res))
  80                  (nreverse res))))))
  81       (rd lst))))
  82
  83 (defun avy-subdiv (n b)
  84   "Distribute N in B terms in a balanced way."
  85   (let* ((p (1- (floor (+ (log n b) 1e-6))))
  86          (x1 (expt b p))
  87          (x2 (* b x1))
  88          (delta (- n x2))
  89          (n2 (/ delta (- x2 x1)))
  90          (n1 (- b n2 1)))
  91     (append
  92      (make-list n1 x1)
  93      (list
  94       (- n (* n1 x1) (* n2 x2)))
  95      (make-list n2 x2))))
  96
  97 (defun avy-traverse (tree walker &optional recur-key)
  98   "Traverse TREE generated by `avy-tree'.
  99 WALKER is a function that takes KEYS and LEAF.
 100
 101 RECUR-KEY is used in recursion.
 102
 103 LEAF is a member of LST argument of `avy-tree'.
 104
 105 KEYS is the path from the root of `avy-tree' to LEAF."
 106   (dolist (br tree)
 107     (let ((key (cons (car br) recur-key)))
 108       (if (eq (cadr br) 'leaf)
 109           (funcall walker key (cddr br))
 110         (avy-traverse (cdr br) walker key)))))
 111
 112 (defun avy-read (tree display-fn cleanup-fn)
 113   "Select a leaf from TREE using consecutive `read-char'.
 114
 115 DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
 116 associated with CHAR will be selected if CHAR is pressed.  This is
 117 commonly done by adding a CHAR overlay at LEAF position.
 118
 119 CLEANUP-FN should take no arguments and remove the effects of
 120 multiple DISPLAY-FN invokations."
 121   (catch 'done
 122     (while tree
 123       (avy-traverse tree display-fn)
 124       (let ((char (read-char))
 125             branch)
 126         (funcall cleanup-fn)
 127         (if (setq branch (assoc char tree))
 128             (if (eq (car (setq tree (cdr branch))) 'leaf)
 129                 (throw 'done (cdr tree)))
 130           (signal 'user-error (list "No such candidate" char))
 131           (throw 'done nil))))))
 132
 133 (provide 'avy)
 134
 135 ;;; avy.el ends here