summaryrefslogtreecommitdiffstats
path: root/.emacs.d/fuzzy.el
diff options
context:
space:
mode:
Diffstat (limited to '.emacs.d/fuzzy.el')
-rw-r--r--.emacs.d/fuzzy.el255
1 files changed, 255 insertions, 0 deletions
diff --git a/.emacs.d/fuzzy.el b/.emacs.d/fuzzy.el
new file mode 100644
index 0000000..c69150a
--- /dev/null
+++ b/.emacs.d/fuzzy.el
@@ -0,0 +1,255 @@
+;;; fuzzy.el --- Fuzzy matching utilities
+
+;; Copyright (C) 2010 Tomohiro Matsuyama
+
+;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com>
+;; Keywords: convenience
+
+;; 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/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'regexp-opt)
+
+(defgroup fuzzy nil
+ "Fuzzy matching utilities."
+ :group 'convenience
+ :prefix "fuzzy-")
+
+(defcustom fuzzy-accept-error-rate 0.10
+ "Error threshold."
+ :group 'fuzzy)
+
+(defvar fuzzy-accept-length-difference 2)
+
+(defvar fuzzy-regexp-some-char (format "\\w\\{0,%s\\}" fuzzy-accept-length-difference))
+
+
+
+;;; Functions
+
+(defun fuzzy-reverse-string (string)
+ (apply 'string (nreverse (append string nil))))
+
+(defun fuzzy-regexp-compile (string)
+ (labels ((oddp (n) (eq (logand n 1) 1))
+ (evenp (n) (eq (logand n 1) 0))
+ (opt (n) (regexp-opt-charset (append (substring string
+ (max 0 (- n 1))
+ (min (length string) (+ n 2))) nil))))
+ (concat
+ "\\("
+ (loop for i below (length string)
+ for c = (if (evenp i) (opt i) fuzzy-regexp-some-char)
+ concat c)
+ "\\|"
+ (loop for i below (length string)
+ for c = (if (oddp i) (opt i) fuzzy-regexp-some-char)
+ concat c)
+ "\\)")))
+
+(defalias 'fuzzy-edit-distance 'fuzzy-jaro-winkler-distance)
+
+(defun fuzzy-jaro-winkler-distance (s1 s2)
+ "http://en.wikipedia.org/wiki/Jaro-Winkler_distance"
+ (let* ((l1 (length s1))
+ (l2 (length s2))
+ (r (max 1 (1- (/ (max l1 l2) 2))))
+ (m 0)
+ (tr 0)
+ (p 0)
+ cs1 cs2)
+ (loop with seen = (make-vector l2 nil)
+ for i below l1
+ for c1 = (aref s1 i) do
+ (loop for j from (max 0 (- i r)) below (min l2 (+ i r))
+ for c2 = (aref s2 j)
+ if (and (char-equal c1 c2)
+ (null (aref seen j))) do
+ (push c1 cs1)
+ (aset seen j c2)
+ (incf m)
+ and return nil)
+ finally
+ (setq cs1 (nreverse cs1)
+ cs2 (loop for i below l2
+ for c = (aref seen i)
+ if c collect c)))
+ (loop for c1 in cs1
+ for c2 in cs2
+ if (not (char-equal c1 c2)) do
+ (incf tr))
+ (loop for i below (min m 5)
+ for c1 across s1
+ for c2 across s2
+ while (char-equal c1 c2) do
+ (incf p))
+ (if (eq m 0)
+ 0.0
+ (setq m (float m))
+ (let* ((dj (/ (+ (/ m l1) (/ m l2) (/ (- m (/ tr 2)) m)) 3))
+ (dw (+ dj (* p 0.1 (- 1 dj)))))
+ dw))))
+
+;; this function should be compiled
+(byte-compile 'fuzzy-jaro-winkler-distance)
+
+(defun fuzzy-match (s1 s2 &optional function)
+ (or function (setq function 'fuzzy-edit-distance))
+ (and (<= (abs (- (length s1) (length s2)))
+ fuzzy-accept-length-difference)
+ (>= (funcall function s1 s2)
+ (- 1 fuzzy-accept-error-rate))))
+
+(defun fuzzy-all-completions (string collection)
+ "all-completions family with fuzzy matching."
+ (loop with length = (length string)
+ for str in collection
+ for s = (substring str 0 (min (length str)
+ (+ length fuzzy-accept-length-difference)))
+ if (fuzzy-match string s)
+ collect str))
+
+
+
+;;; Search and Incremental Search
+
+(defvar fuzzy-search-cache nil)
+(defvar fuzzy-search-cache-string nil)
+
+(defun fuzzy-search-cache-activate ()
+ (setq fuzzy-search-cache (make-hash-table))
+ (setq fuzzy-search-cache-string nil))
+
+(defun fuzzy-search-cache-deactive ()
+ (setq fuzzy-search-cache nil)
+ (setq fuzzy-search-cache-string nil))
+
+(defun fuzzy-search-edit-distance (s1 s2)
+ (or (and fuzzy-search-cache
+ (cond
+ ((null fuzzy-search-cache-string)
+ (setq fuzzy-search-cache-string s1)
+ nil)
+ ((not (equal fuzzy-search-cache-string s1))
+ (setq fuzzy-search-cache-string s1)
+ (clrhash fuzzy-search-cache)
+ nil)
+ (t))
+ (gethash s2 fuzzy-search-cache))
+ (let ((d (fuzzy-edit-distance s1 s2)))
+ (if fuzzy-search-cache
+ (puthash s2 d fuzzy-search-cache))
+ d)))
+
+(defun fuzzy-search-match (s1 s2)
+ (fuzzy-match s1 s2 'fuzzy-search-edit-distance))
+
+(defun fuzzy-search-forward (string &optional bound noerror count)
+ (let* ((regexp (fuzzy-regexp-compile string))
+ match-data)
+ (save-excursion
+ (while (and (null match-data)
+ (re-search-forward regexp bound t))
+ (if (fuzzy-search-match string (match-string 1))
+ (setq match-data (match-data))
+ (goto-char (1+ (match-beginning 1))))))
+ (when match-data
+ (store-match-data match-data)
+ (goto-char (match-end 1)))))
+
+(defun fuzzy-search-backward (string &optional bound noerror count)
+ (let* ((regexp (fuzzy-regexp-compile string))
+ match-data begin end)
+ (save-excursion
+ (while (and (null match-data)
+ (re-search-backward regexp bound t))
+ (setq begin (match-beginning 1)
+ end (match-end 1))
+ (store-match-data nil)
+ (goto-char (max (point-min) (- begin (* (length string) 2))))
+ (while (re-search-forward regexp end t)
+ (if (fuzzy-search-match string (match-string 1))
+ (setq match-data (match-data))
+ (goto-char (1+ (match-beginning 1)))))
+ (unless match-data
+ (goto-char begin)))
+ (if match-data
+ (progn
+ (store-match-data match-data)
+ (goto-char (match-beginning 1)))
+ (store-match-data nil)))))
+
+(defvar fuzzy-isearch nil)
+(defvar fuzzy-isearch-failed-count 0)
+(defvar fuzzy-isearch-enabled 'on-failed)
+(defvar fuzzy-isearch-original-search-fun nil)
+(defvar fuzzy-isearch-prefix "[FUZZY] ")
+
+(defun fuzzy-isearch-activate ()
+ (setq fuzzy-isearch t)
+ (setq fuzzy-isearch-failed-count 0)
+ (fuzzy-search-cache-activate))
+
+(defun fuzzy-isearch-deactivate ()
+ (setq fuzzy-isearch nil)
+ (setq fuzzy-isearch-failed-count 0)
+ (fuzzy-search-cache-deactive))
+
+(defun fuzzy-isearch ()
+ (cond (isearch-word
+ (if isearch-forward 'word-search-forward 'word-search-backward))
+ (isearch-regexp
+ (if isearch-forward 're-search-forward 're-search-backward))
+ ((or fuzzy-isearch
+ (eq fuzzy-isearch-enabled 'always)
+ (and (eq fuzzy-isearch-enabled 'on-failed)
+ (null isearch-success)
+ isearch-wrapped
+ (> (setq fuzzy-isearch-failed-count (1+ fuzzy-isearch-failed-count))
+ 1)))
+ (unless fuzzy-isearch
+ ;(goto-char isearch-opoint)
+ (fuzzy-isearch-activate))
+ (if isearch-forward 'fuzzy-search-forward 'fuzzy-search-backward))
+ (t
+ (if isearch-forward 'search-forward 'search-backward))))
+
+(defun fuzzy-isearch-end-hook ()
+ (fuzzy-isearch-deactivate))
+
+(defun turn-on-fuzzy-isearch ()
+ (interactive)
+ (setq fuzzy-isearch-original-search-fun isearch-search-fun-function)
+ (setq isearch-search-fun-function 'fuzzy-isearch)
+ (add-hook 'isearch-mode-end-hook 'fuzzy-isearch-end-hook))
+
+(defun turn-off-fuzzy-isearch ()
+ (interactive)
+ (setq isearch-search-fun-function fuzzy-isearch-original-search-fun)
+ (remove-hook 'isearch-mode-end-hook 'fuzzy-isearch-end-hook))
+
+(defadvice isearch-message-prefix (after fuzzy-isearch-message-prefix activate)
+ (if fuzzy-isearch
+ (setq ad-return-value (concat fuzzy-isearch-prefix ad-return-value))
+ ad-return-value))
+
+(provide 'fuzzy)
+;;; fuzzy.el ends here
generated by cgit v1.2.3-54-g00ecf (git 2.39.0) at 2024-06-29 10:21:16 +0000