branch: elpa/flx
commit e80bc0dea4dfa954feb5a314aeb6db7b71c811bf
Author: Le Wang <le.w...@agworld.com.au>
Commit: Le Wang <le.w...@agworld.com.au>
more ido optimizations, refactor out flx-propertize
---
flx-ido.el | 192 ++++++++++++++++++++++++++++++++--------------------
flx-scratch-helm.el | 16 +----
flx.el | 35 +++++++---
ido-demo.el | 20 ++++++
4 files changed, 165 insertions(+), 98 deletions(-)
diff --git a/flx-ido.el b/flx-ido.el
index 9217da773c..29cef169f8 100644
--- a/flx-ido.el
+++ b/flx-ido.el
@@ -1,56 +1,132 @@
+;;; flx-ido.el --- flx integration for ido
+
+;; this file is not part of Emacs
+
+;; Copyright (C) 2013 Le Wang
+;; Author: Le Wang
+;; Maintainer: Le Wang
+;; Description: flx integration for ido
+;; Author: Le Wang
+;; Maintainer: Le Wang
+
+;; Created: Sun Apr 21 20:38:36 2013 (+0800)
+;; Version: 0.1
+;; Last-Updated:
+;; By:
+;; Update #: 1
+;; URL:
+;; Keywords:
+;; Compatibility:
+
+;;; Installation:
+
+;;
+;;
+;;
+
+;;; Commentary:
+
+;;
+;;
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
;;;
;;; credit to Scott Frazer's blog entry
here:http://scottfrazersblog.blogspot.com.au/2009/12/emacs-better-ido-flex-matching.html
;;;
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
(require 'ido)
(require 'flx)
-;;; dynamically bound by ido
-(defvar hist)
-
(defvar flx-ido-narrowed-matches-hash (make-hash-table :test 'equal))
-(defun flx-ido-narrowed (query)
+(defun flx-ido-narrowed (query items)
"Get the value from `flx-ido-narrowed-matches-hash' with the
longest prefix match."
- (let (best-match)
- (loop for key being the hash-key of flx-ido-narrowed-matches-hash
- do (when (and (>= (length query) (length key))
- (eq t
- (compare-strings query 0 nil
- key 0 nil))
- (> (length key) (length best-match)))
- (setq best-match key)
- (when (= (length key)
- (length query))
- (return))))
- (and best-match
- (gethash best-match flx-ido-narrowed-matches-hash))))
+ (if (zerop (length query))
+ (list t (flx-ido-undecorate items))
+ (let (best-match
+ exact
+ res)
+ (loop for key being the hash-key of flx-ido-narrowed-matches-hash
+ do (when (and (>= (length query) (length key))
+ (eq t
+ (compare-strings query 0 (min (length query)
+ (length key))
+ key 0 nil))
+ (> (length key) (length best-match)))
+ (setq best-match key)
+ (when (= (length key)
+ (length query))
+ (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)
+ (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
+ (substring-no-properties thing)
+ ;; copy the string in case it's "pure"
+ (flx-propertize (copy-sequence (car thing)) (cdr thing))))
+ (if clear
+ (nthcdr decorate-count things)
+ (mapcar 'car (nthcdr decorate-count things))))))
(defun flx-ido-match (query items)
"Better sorting for flx ido matching."
- (if (zerop (length query))
- items
- (let ((existing (gethash query flx-ido-narrowed-matches-hash)))
- (or existing
- (let* ((narrowed-items (or (flx-ido-narrowed query)
- items))
- (matches (loop for item in narrowed-items
- for score = (flx-score item query
flx-file-cache)
- if score
- collect (cons item (car score)) into matches
- finally return matches))
- res)
- (setq res (mapcar
- 'car
- (if ido-rotate
- matches
- (sort matches
- (lambda (x y) (> (cdr x) (cdr y)))))))
- (puthash query res flx-ido-narrowed-matches-hash))))))
+ (destructuring-bind (exact items)
+ (flx-ido-narrowed query items)
+ (if exact ; `ido-rotate' case is covered by exact
match
+ items
+ (let* ((matches (loop for item in items
+ for score = (flx-score item query flx-file-cache)
+ if score
+ collect (cons item score)
+ into matches
+ finally return matches))
+ res)
+ (setq res (flx-ido-decorate (sort matches
+ (lambda (x y) (> (cadr x) (cadr
y))))))
+ (puthash query res flx-ido-narrowed-matches-hash)))))
(defvar flx-ido-use t
- "*Use flx matching for ido.")
+ "Use flx matching for ido.")
(defadvice ido-read-internal (before flx-ido-reset-hash activate)
"clear our narrowed hash."
@@ -58,47 +134,15 @@
(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-use
+ (if (and flx-ido-use
+ ido-enable-flex-matching)
(setq ad-return-value (flx-ido-match ido-text (ad-get-arg 0)))
ad-do-it))
+(provide 'flx-ido)
-(setq ido-enable-flex-matching t)
-
-(defun ido-demo ()
- (interactive)
- (require 'flx-test-list)
- (ido-completing-read ": " foo-list))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;; testing
-
-;; (defvar ido-enable-replace-completing-read t
-;; "If t, use ido-completing-read instead of completing-read if possible.
-
-;; Set it to nil using let in around-advice for functions where the
-;; original completing-read is required. For example, if a function
-;; foo absolutely must use the original completing-read, define some
-;; advice like this:
-
-;; (defadvice foo (around original-completing-read-only activate)
-;; (let (ido-enable-replace-completing-read) ad-do-it))")
-;; ;; Replace completing-read wherever possible, unless directed otherwise
-;; (defadvice completing-read
-;; (around use-ido-when-possible activate)
-;; (if (or (not ido-enable-replace-completing-read) ; Manual override
disable ido
-;; (and (boundp 'ido-cur-list)
-;; ido-cur-list)) ; Avoid infinite loop from ido calling this
-;; ad-do-it
-;; (let ((allcomp (all-completions "" collection predicate)))
-;; (if allcomp
-;; (setq ad-return-value
-;; (ido-completing-read prompt
-;; allcomp
-;; nil require-match initial-input hist
def))
-;; ad-do-it))))
-;; (ido-everywhere t)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flx-ido.el ends here
-(provide 'flx-ido)
diff --git a/flx-scratch-helm.el b/flx-scratch-helm.el
index 61b9a8b569..34fb4d17fe 100644
--- a/flx-scratch-helm.el
+++ b/flx-scratch-helm.el
@@ -1,20 +1,6 @@
(require 'flx)
(require 'flx-test-list)
-(defun helm-mp-flx-propertize (str score)
- "Return propertized string according to score."
- (let ((block-started (cadr score))
- (last-char nil))
- (loop for char in (cdr score)
- do (progn
- (when (and last-char
- (not (= (1+ last-char) char)))
- (put-text-property block-started (1+ last-char) 'face
'helm-match str)
- (setq block-started char))
- (setq last-char char)))
- (put-text-property block-started (1+ last-char) 'face 'helm-match str)
- (format "%s [%s]" str (car score))))
-
(defun flx-helm-candidate-transformer (candidates)
"We score candidate and add the score info for later use.
@@ -48,7 +34,7 @@ The score info we add here is later removed with another
filter."
do (progn
;; highlight first 20 matches
(when (and (< index 20) (> (car score) 0))
- (setcar item (helm-mp-flx-propertize (car item) score)))
+ (setcar item (flx-propertize (car item) score 'add-score)))
(setcdr item (cadr item))))
res)))
diff --git a/flx.el b/flx.el
index 10a2ddc599..350adf8fb5 100644
--- a/flx.el
+++ b/flx.el
@@ -1,6 +1,3 @@
-
-
-
;;; flx.el --- fuzzy matching with good sorting
;; this file is not part of Emacs
@@ -16,7 +13,7 @@
;; Version: 0.1
;; Last-Updated:
;; By:
-;; Update #: 1
+;; Update #: 3
;; URL:
;; Keywords:
;; Compatibility:
@@ -54,14 +51,10 @@
;;; Code:
-(eval-when-compile (require 'cl))
-;;; credit note: Daniel Skarda ido-speed-hack for bitmap idea
-;;; not necessary as we aren't using bitmap caching
-;;;
-;;;
;;; credit to scott frazer's blog entry
here:http://scottfrazersblog.blogspot.com.au/2009/12/emacs-better-ido-flex-matching.html
+;;; credit to ido-hacks for ido optimization
;;; Use defsubst instead of defun
@@ -74,6 +67,12 @@
;;; of an optimization.
;;;
+(eval-when-compile (require 'cl))
+
+(defface flx-highlight-face '((t (:inherit font-lock-variable-name-face :bold
t :underline t)))
+ "Face used by flx for highlighting flx match characters."
+ :group 'flx)
+
(defun flx-get-hash-for-string (str heatmap-func)
"Return hash-table for string where keys are characters value
@@ -307,6 +306,24 @@ e.g. (\"aab\" \"ab\") returns
best-score)))
+(defun flx-propertize (str score &optional add-score)
+ "Return propertized string according to score."
+ (let ((block-started (cadr score))
+ (last-char nil))
+ (loop for char in (cdr score)
+ do (progn
+ (when (and last-char
+ (not (= (1+ last-char) char)))
+ (put-text-property block-started (1+ last-char) 'face
'flx-highlight-face str)
+ (setq block-started char))
+ (setq last-char char)))
+ (put-text-property block-started (1+ last-char) 'face 'flx-highlight-face
str)
+ (when add-score
+ (setq str (format "%s [%s]" str (car score))))
+ str))
+
+
+
(defvar flx-file-cache (flx-make-filename-cache)
"Cached heatmap info about strings.")
diff --git a/ido-demo.el b/ido-demo.el
new file mode 100644
index 0000000000..9321772f8b
--- /dev/null
+++ b/ido-demo.el
@@ -0,0 +1,20 @@
+(require 'flx-ido)
+(require 'flx-test-list)
+
+(defun ido-demo ()
+ (interactive)
+ (require 'flx-test-list)
+ (ido-completing-read ": " foo-list))
+
+(defun ido-big-demo (max)
+ (interactive "P")
+ (setq max (or max
+ most-positive-fixnum))
+ (let* ((names (loop for i in (ucs-names)
+ for stop below max
+ collect (car i)))
+ (names-length (length names)))
+ (ido-completing-read (format "ucs (%s total): " names-length)
+ names)))
+
+(provide 'flx-ido-demo)
\ No newline at end of file
