You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
215 lines
7.2 KiB
215 lines
7.2 KiB
;;; flx-ido.el --- flx integration for ido
|
|
|
|
;; Copyright © 2013 Le Wang
|
|
|
|
;; Author: Le Wang
|
|
;; Maintainer: Le Wang
|
|
;; Description: flx integration for ido
|
|
;; Created: Sun Apr 21 20:38:36 2013 (+0800)
|
|
;; Version: 0.2
|
|
;; URL: https://github.com/lewang/flx
|
|
;; Package-Requires: ((flx "0.1"))
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;;; License
|
|
|
|
;; 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, 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; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package provides a more powerful alternative to `ido-mode''s
|
|
;; built-in flex matching.
|
|
|
|
;;; Acknowledgments
|
|
|
|
;; Scott Frazer's blog entry http://scottfrazersblog.blogspot.com.au/2009/12/emacs-better-ido-flex-matching.html
|
|
;; provided a lot of inspiration.
|
|
;;
|
|
;; ido-hacks was helpful for ido optimization and fontification ideas
|
|
|
|
;;; Installation:
|
|
|
|
;; Add the following code to your init file:
|
|
;;
|
|
;; (require 'flx-ido)
|
|
;; (ido-mode 1)
|
|
;; (ido-everywhere 1)
|
|
;; (flx-ido-mode 1)
|
|
;; ;; disable ido faces to see flx highlights.
|
|
;; (setq ido-use-faces nil)
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'cl))
|
|
(require 'ido)
|
|
(require 'flx)
|
|
|
|
(defcustom flx-ido-threshhold 6000
|
|
"flx will not kick in until collection is filtered below this size with \"flex\"."
|
|
:group 'ido)
|
|
|
|
|
|
(defcustom flx-ido-use-faces t
|
|
"Use `flx-highlight-face' to indicate characters contributing to best score."
|
|
:group 'ido)
|
|
|
|
(unless (fboundp 'ido-delete-runs)
|
|
(defun ido-delete-runs (list)
|
|
"Delete consecutive runs of same item in list.
|
|
Comparison done with `equal'. Runs may loop back on to the first
|
|
item, in which case, the ending items are deleted."
|
|
(let ((tail list)
|
|
before-last-run)
|
|
(while tail
|
|
(if (consp (cdr tail))
|
|
(if (equal (car tail) (cadr tail))
|
|
(setcdr tail (cddr tail))
|
|
(setq before-last-run tail)
|
|
(setq tail (cdr tail)))
|
|
(setq tail (cdr tail))))
|
|
(when (and before-last-run
|
|
(equal (car list) (cadr before-last-run)))
|
|
(setcdr before-last-run nil)))
|
|
list))
|
|
|
|
(defvar flx-ido-narrowed-matches-hash (make-hash-table :test 'equal))
|
|
|
|
(defun flx-ido-narrowed (query items)
|
|
"Get the value from `flx-ido-narrowed-matches-hash' with the
|
|
longest prefix match."
|
|
(if (zerop (length query))
|
|
(list t (nreverse items))
|
|
(let ((query-key (flx-ido-key-for-query query))
|
|
best-match
|
|
exact
|
|
res)
|
|
(loop for key being the hash-key of flx-ido-narrowed-matches-hash
|
|
do (when (and (>= (length query-key) (length key))
|
|
(eq t
|
|
(compare-strings query-key 0 (min (length query-key)
|
|
(length key))
|
|
key 0 nil))
|
|
(or (null best-match)
|
|
(> (length key) (length best-match))))
|
|
(setq best-match key)
|
|
(when (= (length key)
|
|
(length query-key))
|
|
(setq exact t)
|
|
(return))))
|
|
(setq res (cond (exact
|
|
(gethash best-match flx-ido-narrowed-matches-hash))
|
|
(best-match
|
|
(flx-ido-undecorate (gethash best-match flx-ido-narrowed-matches-hash)))
|
|
(t
|
|
(flx-ido-undecorate items))))
|
|
(list exact res))))
|
|
|
|
(defun flx-ido-undecorate (strings)
|
|
(flx-ido-decorate strings t))
|
|
|
|
|
|
(defun flx-ido-decorate (things &optional clear)
|
|
(if flx-ido-use-faces
|
|
(let ((decorate-count (min ido-max-prospects
|
|
(length things))))
|
|
(nconc
|
|
(loop for thing in things
|
|
for i from 0 below decorate-count
|
|
collect (if clear
|
|
(flx-propertize thing nil)
|
|
(flx-propertize (car thing) (cdr thing))))
|
|
(if clear
|
|
(nthcdr decorate-count things)
|
|
(mapcar 'car (nthcdr decorate-count things)))))
|
|
(if clear
|
|
things
|
|
(mapcar 'car things))))
|
|
|
|
(defun flx-ido-match-internal (query items)
|
|
(if (< (length items) flx-ido-threshhold)
|
|
(let* ((matches (loop for item in items
|
|
for string = (if (consp item) (car item) item)
|
|
for score = (flx-score string query flx-file-cache)
|
|
if score
|
|
collect (cons item score)
|
|
into matches
|
|
finally return matches)))
|
|
(flx-ido-decorate (ido-delete-runs
|
|
(sort matches
|
|
(lambda (x y) (> (cadr x) (cadr y)))))))
|
|
(let ((regexp (mapconcat 'identity (split-string query "" t) ".*")))
|
|
(loop for item in items
|
|
if (string-match regexp (if (consp item) (car item) item))
|
|
collect item
|
|
into matches
|
|
finally return matches))))
|
|
|
|
(defun flx-ido-key-for-query (query)
|
|
(concat ido-current-directory query))
|
|
|
|
(defun flx-ido-cache (query items)
|
|
(if (memq ido-cur-item '(file dir))
|
|
items
|
|
(puthash (flx-ido-key-for-query query) items flx-ido-narrowed-matches-hash)))
|
|
|
|
(defun flx-ido-match (query items)
|
|
"Better sorting for flx ido matching."
|
|
(destructuring-bind (exact res-items)
|
|
(flx-ido-narrowed query items)
|
|
(flx-ido-cache query (if exact
|
|
res-items
|
|
(flx-ido-match-internal query res-items)))))
|
|
|
|
(defadvice ido-exit-minibuffer (around flx-ido-undecorate activate)
|
|
"Remove flx properties after."
|
|
(let* ((obj (car ido-matches))
|
|
(str (if (consp obj)
|
|
(car obj)
|
|
obj)))
|
|
(when (and flx-ido-mode str)
|
|
(remove-text-properties 0 (length str)
|
|
'(face flx-highlight-face) str)))
|
|
|
|
ad-do-it)
|
|
|
|
(defadvice ido-read-internal (before flx-ido-reset-hash activate)
|
|
"Clear flx narrowed hash beforehand."
|
|
(when flx-ido-mode
|
|
(clrhash flx-ido-narrowed-matches-hash)))
|
|
|
|
(defadvice ido-restrict-to-matches (before flx-ido-reset-hash activate)
|
|
"Clear flx narrowed hash."
|
|
(when flx-ido-mode
|
|
(clrhash flx-ido-narrowed-matches-hash)))
|
|
|
|
(defadvice ido-set-matches-1 (around flx-ido-set-matches-1 activate)
|
|
"Choose between the regular ido-set-matches-1 and my-ido-fuzzy-match"
|
|
(if flx-ido-mode
|
|
(setq ad-return-value (flx-ido-match ido-text (ad-get-arg 0)))
|
|
ad-do-it))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode flx-ido-mode
|
|
"Toggle flx ido mode"
|
|
:init-value nil
|
|
:lighter ""
|
|
:group 'ido
|
|
:global t)
|
|
|
|
(provide 'flx-ido)
|
|
|
|
;;; flx-ido.el ends here
|