400 lines
16 KiB
EmacsLisp
400 lines
16 KiB
EmacsLisp
|
;;; grizzl.el --- Fast fuzzy search index for Emacs. -*- lexical-binding: t -*-
|
||
|
|
|
||
|
|
;; Copyright © 2013-2014 Chris Corbyn
|
||
|
|
;; Copyright © 2015 Bozhidar Batsov
|
||
|
|
;;
|
||
|
|
;; Author: Chris Corbyn <chris@w3style.co.uk>
|
||
|
|
;; Maintainer: Bozhidar Batsov <bozhidar@batsov.com>
|
||
|
|
;; URL: https://github.com/grizzl/grizzl
|
||
|
|
;; Package-Version: 20160130.2351
|
||
|
|
;; Version: 0.1.2
|
||
|
|
;; Keywords: convenience, usability
|
||
|
|
;; Package-Requires: ((cl-lib "0.5") (emacs "24.3"))
|
||
|
|
|
||
|
|
;; This program 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.
|
||
|
|
|
||
|
|
;; 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.
|
||
|
|
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;; This file is not part of GNU Emacs.
|
||
|
|
|
||
|
|
;;; Commentary:
|
||
|
|
|
||
|
|
;; Grizzl provides a fuzzy completion framework for general purpose
|
||
|
|
;; use in Emacs Lisp projects.
|
||
|
|
;;
|
||
|
|
;; grizzl provides the underlying data structures and sesrch
|
||
|
|
;; algorithm without any UI attachment. At the core, a fuzzy search
|
||
|
|
;; index is created from a list of strings, using `grizzl-make-index'.
|
||
|
|
;; A fuzzy search term is then used to get a result from this index
|
||
|
|
;; with `grizzl-search'. Because grizzl considers the usage of a
|
||
|
|
;; fuzzy search index to operate in real-time as a user enters a
|
||
|
|
;; search term in the minibuffer, the framework optimizes for this use
|
||
|
|
;; case. Any result can be passed back into `grizzl-search' as a hint
|
||
|
|
;; to continue searching. The search algorithm is able to understand
|
||
|
|
;; insertions and deletions and therefore minimizes the work it needs
|
||
|
|
;; to do in this case. The intended use here is to collect a result
|
||
|
|
;; on each key press and feed that result into the search for the next
|
||
|
|
;; key press. Once a search is complete, the matched strings are then
|
||
|
|
;; read, using `grizzl-result-strings'. The results are ordered on the
|
||
|
|
;; a combination of the Levenshtein Distance and a character-proximity
|
||
|
|
;; scoring calculation. This means shorter strings are favoured, but
|
||
|
|
;; adjacent letters are more heavily favoured.
|
||
|
|
;;
|
||
|
|
;; It is assumed that the index will be re-used across multiple
|
||
|
|
;; searches on larger sets of data.
|
||
|
|
;;
|
||
|
|
;; Call `grizzl-completing-read' with an index returned by
|
||
|
|
;; `grizzl-make-index':
|
||
|
|
;;
|
||
|
|
;; (defvar *index* (grizzl-make-index '("one" "two" "three")))
|
||
|
|
;; (grizzl-completing-read "Number: " *index*)
|
||
|
|
;;
|
||
|
|
;; When the user hits ENTER, either one of the strings is returned on
|
||
|
|
;; success, or nil of nothing matched.
|
||
|
|
;;
|
||
|
|
;; The arrow keys can be used to navigate within the results.
|
||
|
|
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(eval-when-compile
|
||
|
|
(require 'cl-lib))
|
||
|
|
|
||
|
|
;;; --- Public Functions
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-make-index (strings &rest options)
|
||
|
|
"Makes an index from the list STRINGS for use with `grizzl-search'.
|
||
|
|
|
||
|
|
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
|
||
|
|
with integers N and TOTAL.
|
||
|
|
|
||
|
|
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
|
||
|
|
will be created case-sensitive, otherwise it will be case-insensitive."
|
||
|
|
(let ((lookup-table (make-hash-table))
|
||
|
|
(total-strs (length strings))
|
||
|
|
(case-sensitive (plist-get options :case-sensitive))
|
||
|
|
(progress-fn (plist-get options :progress-fn))
|
||
|
|
(string-data (vconcat (mapcar (lambda (s)
|
||
|
|
(cons s (length s)))
|
||
|
|
strings))))
|
||
|
|
(cl-reduce (lambda (list-offset str)
|
||
|
|
(grizzl-index-insert str list-offset lookup-table
|
||
|
|
:case-sensitive case-sensitive)
|
||
|
|
(when progress-fn
|
||
|
|
(funcall progress-fn (1+ list-offset) total-strs))
|
||
|
|
(1+ list-offset))
|
||
|
|
strings
|
||
|
|
:initial-value 0)
|
||
|
|
(maphash (lambda (_char str-map)
|
||
|
|
(maphash (lambda (list-offset locations)
|
||
|
|
(puthash list-offset (reverse locations) str-map))
|
||
|
|
str-map)) lookup-table)
|
||
|
|
`((case-sensitive . ,case-sensitive)
|
||
|
|
(lookup-table . ,lookup-table)
|
||
|
|
(string-data . ,string-data))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-search (term index &optional old-result)
|
||
|
|
"Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
|
||
|
|
|
||
|
|
OLD-RESULT may be specified as an existing search result to increment from.
|
||
|
|
The result can be read with `grizzl-result-strings'."
|
||
|
|
(let* ((cased-term (if (grizzl-index-case-sensitive-p index)
|
||
|
|
term
|
||
|
|
(downcase term)))
|
||
|
|
(result (grizzl-rewind-result cased-term index old-result))
|
||
|
|
(matches (copy-hash-table (grizzl-result-matches result)))
|
||
|
|
(from-pos (length (grizzl-result-term result)))
|
||
|
|
(remainder (substring cased-term from-pos))
|
||
|
|
(lookup-table (grizzl-lookup-table index)))
|
||
|
|
(cl-reduce (lambda (acc-res ch)
|
||
|
|
(let ((sub-table (gethash ch lookup-table)))
|
||
|
|
(if (not sub-table)
|
||
|
|
(clrhash matches)
|
||
|
|
(grizzl-search-increment sub-table matches))
|
||
|
|
(grizzl-cons-result cased-term matches acc-res)))
|
||
|
|
remainder
|
||
|
|
:initial-value result)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-result-count (result)
|
||
|
|
"Returns the number of matches present in RESULT."
|
||
|
|
(hash-table-count (grizzl-result-matches result)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-result-strings (result index &rest options)
|
||
|
|
"Returns the ordered list of matched strings in RESULT, using INDEX.
|
||
|
|
|
||
|
|
If the :START option is specified, results are read from the given offset.
|
||
|
|
If the :END option is specified, up to :END results are returned."
|
||
|
|
(let* ((matches (grizzl-result-matches result))
|
||
|
|
(strings (grizzl-index-strings index))
|
||
|
|
(loaded '()))
|
||
|
|
(maphash (lambda (string-offset _char-offset)
|
||
|
|
(push string-offset loaded))
|
||
|
|
matches)
|
||
|
|
(let* ((ordered (sort loaded
|
||
|
|
(lambda (a b)
|
||
|
|
(< (cadr (gethash a matches))
|
||
|
|
(cadr (gethash b matches))))))
|
||
|
|
(start (or (plist-get options :start) 0))
|
||
|
|
(end (min (plist-get options :end) (length ordered)))
|
||
|
|
(best (if (or start end)
|
||
|
|
(cl-delete-if-not 'identity
|
||
|
|
(cl-subseq ordered start end))
|
||
|
|
ordered)))
|
||
|
|
(mapcar (lambda (n)
|
||
|
|
(car (elt strings n)))
|
||
|
|
best))))
|
||
|
|
|
||
|
|
;;; --- Private Functions
|
||
|
|
|
||
|
|
(defun grizzl-cons-result (term matches results)
|
||
|
|
"Build a new result for TERM and hash-table MATCHES consed with RESULTS."
|
||
|
|
(cons (cons term matches) results))
|
||
|
|
|
||
|
|
(defun grizzl-rewind-result (term index result)
|
||
|
|
"Adjusts RESULT according to TERM, ready for a new search."
|
||
|
|
(if result
|
||
|
|
(let* ((old-term (grizzl-result-term result))
|
||
|
|
(new-len (length term))
|
||
|
|
(old-len (length old-term)))
|
||
|
|
(if (and (>= new-len old-len)
|
||
|
|
(string-equal old-term (substring term 0 old-len)))
|
||
|
|
result
|
||
|
|
(grizzl-rewind-result term index (cdr result))))
|
||
|
|
(grizzl-cons-result "" (grizzl-base-matches index) nil)))
|
||
|
|
|
||
|
|
(defun grizzl-base-matches (index)
|
||
|
|
"Returns the full set of matches in INDEX, with an out-of-bound offset."
|
||
|
|
(let ((matches (make-hash-table)))
|
||
|
|
(cl-reduce (lambda (n s-len)
|
||
|
|
(puthash n (list -1 0 (cdr s-len)) matches)
|
||
|
|
(1+ n))
|
||
|
|
(grizzl-index-strings index)
|
||
|
|
:initial-value 0)
|
||
|
|
matches))
|
||
|
|
|
||
|
|
(defun grizzl-result-term (result)
|
||
|
|
"Returns the search term used to find the matches in RESULT."
|
||
|
|
(car (car result)))
|
||
|
|
|
||
|
|
(defun grizzl-result-matches (result)
|
||
|
|
"Returns the internal hash used to track the matches in RESULT."
|
||
|
|
(cdar result))
|
||
|
|
|
||
|
|
(defun grizzl-index-insert (string list-offset index &rest options)
|
||
|
|
"Inserts STRING at LIST-OFFSET into INDEX."
|
||
|
|
(let ((case-sensitive (plist-get options :case-sensitive)))
|
||
|
|
(cl-reduce (lambda (char-offset cs-char)
|
||
|
|
(let* ((char (if case-sensitive
|
||
|
|
cs-char
|
||
|
|
(downcase cs-char)))
|
||
|
|
(str-map (or (gethash char index)
|
||
|
|
(puthash char (make-hash-table) index)))
|
||
|
|
(offsets (gethash list-offset str-map)))
|
||
|
|
(puthash list-offset
|
||
|
|
(cons char-offset offsets)
|
||
|
|
str-map)
|
||
|
|
(1+ char-offset)))
|
||
|
|
string
|
||
|
|
:initial-value 0)))
|
||
|
|
|
||
|
|
(defun grizzl-lookup-table (index)
|
||
|
|
"Returns the lookup table portion of INDEX."
|
||
|
|
(cdr (assoc 'lookup-table index)))
|
||
|
|
|
||
|
|
(defun grizzl-index-strings (index)
|
||
|
|
"Returns the vector of strings stored in INDEX."
|
||
|
|
(cdr (assoc 'string-data index)))
|
||
|
|
|
||
|
|
(defun grizzl-index-case-sensitive-p (index)
|
||
|
|
"Predicate to test of INDEX is case-sensitive."
|
||
|
|
(cdr (assoc 'case-sensitive index)))
|
||
|
|
|
||
|
|
(defun grizzl-search-increment (sub-table result)
|
||
|
|
"Use the search lookup table to filter already-accumulated results."
|
||
|
|
(cl-flet ((next-offset (key current sub-table)
|
||
|
|
(cl-find-if (lambda (v)
|
||
|
|
(> v current))
|
||
|
|
(gethash key sub-table))))
|
||
|
|
(maphash (lambda (k v)
|
||
|
|
(let* ((oldpos (car v))
|
||
|
|
(oldrank (cadr v))
|
||
|
|
(len (cl-caddr v))
|
||
|
|
(newpos (next-offset k oldpos sub-table)))
|
||
|
|
(if newpos
|
||
|
|
(puthash k (list newpos
|
||
|
|
(grizzl-inc-rank oldrank oldpos newpos len)
|
||
|
|
len)
|
||
|
|
result)
|
||
|
|
(remhash k result))))
|
||
|
|
result)))
|
||
|
|
|
||
|
|
(defun grizzl-inc-rank (oldrank oldpos newpos len)
|
||
|
|
"Increment the current match distance as a new char is matched."
|
||
|
|
(let ((distance (if (< oldpos 0) 1 (- newpos oldpos))))
|
||
|
|
(+ oldrank (* len (* distance distance)))))
|
||
|
|
|
||
|
|
;;; --- Configuration Variables
|
||
|
|
|
||
|
|
(defvar *grizzl-read-max-results* 10
|
||
|
|
"The maximum number of results to show in `grizzl-completing-read'.")
|
||
|
|
|
||
|
|
;;; --- Runtime Processing Variables
|
||
|
|
|
||
|
|
(defvar *grizzl-current-result* nil
|
||
|
|
"The search result in `grizzl-completing-read'.")
|
||
|
|
|
||
|
|
(defvar *grizzl-current-selection* 0
|
||
|
|
"The selected offset in `grizzl-completing-read'.")
|
||
|
|
|
||
|
|
(defface grizzl-selection-face
|
||
|
|
`((((class color) (background light))
|
||
|
|
(:foreground "red"))
|
||
|
|
(((class color) (background dark))
|
||
|
|
(:foreground "red"))
|
||
|
|
(t (:foreground "red")))
|
||
|
|
"Face for selected result."
|
||
|
|
:group 'grizzl-mode)
|
||
|
|
|
||
|
|
|
||
|
|
;;; --- Minor Mode Definition
|
||
|
|
|
||
|
|
(defvar *grizzl-keymap* (make-sparse-keymap)
|
||
|
|
"Internal keymap used by the minor-mode in `grizzl-completing-read'.")
|
||
|
|
|
||
|
|
(define-key *grizzl-keymap* (kbd "<up>") 'grizzl-set-selection+1)
|
||
|
|
(define-key *grizzl-keymap* (kbd "C-p") 'grizzl-set-selection+1)
|
||
|
|
(define-key *grizzl-keymap* (kbd "<down>") 'grizzl-set-selection-1)
|
||
|
|
(define-key *grizzl-keymap* (kbd "C-n") 'grizzl-set-selection-1)
|
||
|
|
|
||
|
|
(define-minor-mode grizzl-mode
|
||
|
|
"Toggle the internal mode used by `grizzl-completing-read'."
|
||
|
|
nil
|
||
|
|
" Grizzl"
|
||
|
|
*grizzl-keymap*)
|
||
|
|
|
||
|
|
;;; --- Public Functions
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-completing-read (prompt index)
|
||
|
|
"Performs a completing-read in the minibuffer using INDEX to fuzzy search.
|
||
|
|
Each key pressed in the minibuffer filters down the list of matches."
|
||
|
|
(minibuffer-with-setup-hook
|
||
|
|
(lambda ()
|
||
|
|
(setq *grizzl-current-result* nil)
|
||
|
|
(setq *grizzl-current-selection* 0)
|
||
|
|
(grizzl-mode 1)
|
||
|
|
(let* ((hookfun (lambda ()
|
||
|
|
(setq *grizzl-current-result*
|
||
|
|
(grizzl-search (minibuffer-contents)
|
||
|
|
index
|
||
|
|
*grizzl-current-result*))
|
||
|
|
(grizzl-display-result index prompt)))
|
||
|
|
(exitfun (lambda ()
|
||
|
|
(grizzl-mode -1)
|
||
|
|
(remove-hook 'post-command-hook hookfun t))))
|
||
|
|
(add-hook 'minibuffer-exit-hook exitfun nil t)
|
||
|
|
(add-hook 'post-command-hook hookfun nil t)))
|
||
|
|
(let ((read-value (read-from-minibuffer ">>> ")))
|
||
|
|
(or (grizzl-selected-result index) read-value))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-selected-result (index)
|
||
|
|
"Get the selected string from INDEX in a `grizzl-completing-read'."
|
||
|
|
(elt (grizzl-result-strings *grizzl-current-result* index
|
||
|
|
:start 0
|
||
|
|
:end *grizzl-read-max-results*)
|
||
|
|
(grizzl-current-selection)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-set-selection+1 ()
|
||
|
|
"Move the selection up one row in `grizzl-completing-read'."
|
||
|
|
(interactive)
|
||
|
|
(grizzl-move-selection 1))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun grizzl-set-selection-1 ()
|
||
|
|
"Move the selection down one row in `grizzl-completing-read'."
|
||
|
|
(interactive)
|
||
|
|
(grizzl-move-selection -1))
|
||
|
|
|
||
|
|
;;; --- Private Functions
|
||
|
|
|
||
|
|
(defun grizzl-move-selection (delta)
|
||
|
|
"Move the selection by DELTA rows in `grizzl-completing-read'."
|
||
|
|
(setq *grizzl-current-selection* (+ (grizzl-current-selection) delta))
|
||
|
|
(when (not (= (grizzl-current-selection) *grizzl-current-selection*))
|
||
|
|
(beep)))
|
||
|
|
|
||
|
|
(defun grizzl-display-result (index prompt)
|
||
|
|
"Renders a series of overlays to list the matches in the result."
|
||
|
|
(let* ((matches (grizzl-result-strings *grizzl-current-result* index
|
||
|
|
:start 0
|
||
|
|
:end *grizzl-read-max-results*)))
|
||
|
|
(delete-all-overlays)
|
||
|
|
(overlay-put (make-overlay (point-min) (point-min))
|
||
|
|
'before-string
|
||
|
|
(format "%s\n%s\n"
|
||
|
|
(mapconcat 'identity
|
||
|
|
(grizzl-map-format-matches matches)
|
||
|
|
"\n")
|
||
|
|
(grizzl-format-prompt-line prompt)))
|
||
|
|
(set-window-text-height nil (max 3 (+ 2 (length matches))))))
|
||
|
|
|
||
|
|
(defun grizzl-map-format-matches (matches)
|
||
|
|
"Convert the set of string MATCHES into propertized text objects."
|
||
|
|
(if (= 0 (length matches))
|
||
|
|
(list (propertize "-- NO MATCH --" 'face 'outline-3))
|
||
|
|
(cdr (cl-reduce (lambda (acc str)
|
||
|
|
(let* ((idx (car acc))
|
||
|
|
(lst (cdr acc))
|
||
|
|
(sel (= idx (grizzl-current-selection))))
|
||
|
|
(cons (1+ idx)
|
||
|
|
(cons (grizzl-format-match str sel) lst))))
|
||
|
|
matches
|
||
|
|
:initial-value '(0)))))
|
||
|
|
|
||
|
|
(defun grizzl-format-match (match-str selected)
|
||
|
|
"Default match string formatter in `grizzl-completing-read'.
|
||
|
|
|
||
|
|
MATCH-STR is the string in the selection list and SELECTED is non-nil
|
||
|
|
if this is the current selection."
|
||
|
|
(let ((margin (if selected "> " " "))
|
||
|
|
(face (if selected 'grizzl-selection-face 'default)))
|
||
|
|
(propertize (format "%s%s" margin match-str) 'face face)))
|
||
|
|
|
||
|
|
(defun grizzl-format-prompt-line (prompt)
|
||
|
|
"Returns a string to render a full-width prompt in `grizzl-completing-read'."
|
||
|
|
(let* ((count (grizzl-result-count *grizzl-current-result*))
|
||
|
|
(match-info (format " (%d candidate%s) ---- *-"
|
||
|
|
count (if (= count 1) "" "s"))))
|
||
|
|
(concat (propertize (format "-*%s *-" prompt) 'face 'modeline-inactive)
|
||
|
|
(propertize " "
|
||
|
|
'face 'modeline-inactive
|
||
|
|
'display `(space :align-to (- right
|
||
|
|
,(1+ (length match-info)))))
|
||
|
|
(propertize match-info 'face 'modeline-inactive))))
|
||
|
|
|
||
|
|
(defun grizzl-current-selection ()
|
||
|
|
"Get the currently selected index in `grizzl-completing-read'."
|
||
|
|
(let ((max-selection
|
||
|
|
(min (1- *grizzl-read-max-results*)
|
||
|
|
(1- (grizzl-result-count *grizzl-current-result*)))))
|
||
|
|
(max 0 (min max-selection *grizzl-current-selection*))))
|
||
|
|
|
||
|
|
(provide 'grizzl)
|
||
|
|
|
||
|
|
;;; grizzl.el ends here
|