mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f
commit | author | age
5cb5f7 1 ;;; helm-multi-match.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*-
C 2
3 ;; Original Author: rubikitch
4
5 ;; Copyright (C) 2008 ~ 2011 rubikitch
6 ;; Copyright (C) 2011 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com>
7
8 ;; Author: Thierry Volpiatto <thierry.volpiatto@gmail.com>
9 ;; URL: http://github.com/emacs-helm/helm
10
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Code:
25
26 (require 'cl-lib)
27 (require 'helm-lib)
28
29
30 (defgroup helm-multi-match nil
31   "Helm multi match."
32   :group 'helm)
33
34 (defcustom helm-mm-matching-method 'multi3
35   "Matching method for helm match plugin.
36 You can set here different methods to match candidates in helm.
37 Here are the possible value of this symbol and their meaning:
38 - multi1: Respect order, prefix of pattern must match.
39 - multi2: Same but with partial match.
40 - multi3: The best, multiple regexp match, allow negation.
41 - multi3p: Same but prefix must match.
42
43 Default is multi3, you should keep this for a better experience.
44
45 Note that multi1 and multi3p are incompatible with fuzzy matching
46 in file completion and by the way fuzzy matching will be disabled there
47 when these options are used."
48   :type  '(radio :tag "Matching methods for helm"
49            (const :tag "Multiple regexp 1 ordered with prefix match"         multi1)
50            (const :tag "Multiple regexp 2 ordered with partial match"        multi2)
51            (const :tag "Multiple regexp 3 matching no order, partial, best." multi3)
52            (const :tag "Multiple regexp 3p matching with prefix match"       multi3p))
53   :group 'helm-multi-match)
54
55
56 ;; Internal
57 (defvar helm-mm-default-match-functions
58   '(helm-mm-exact-match helm-mm-match))
59 (defvar helm-mm-default-search-functions
60   '(helm-mm-exact-search helm-mm-search))
61
62
63 ;;; Build regexps
64 ;;
65 ;;
66 (defconst helm-mm-space-regexp "\\s\\\\s-"
67   "Regexp to represent space itself in multiple regexp match.")
68
69 (defun helm-mm-split-pattern (pattern &optional grep-space)
70   "Split PATTERN if it contain spaces and return resulting list.
71 If spaces in PATTERN are escaped, don't split at this place.
72 i.e \"foo bar baz\"=> (\"foo\" \"bar\" \"baz\")
73 but \"foo\\ bar baz\"=> (\"foo\\s-bar\" \"baz\").
74 If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"."
75   (split-string
76    ;; Match spaces litteraly because candidate buffer syntax-table
77    ;; doesn't understand "\s-" properly.
78    (replace-regexp-in-string
79     helm-mm-space-regexp
80     (if grep-space "\\s" "\\s-") pattern nil t)))
81
82 (defun helm-mm-1-make-regexp (pattern)
83   "Replace spaces in PATTERN with \"\.*\"."
84   (mapconcat 'identity (helm-mm-split-pattern pattern) ".*"))
85
86
87 ;;; Exact match.
88 ;;
89 ;;
90 ;; Internal.
91 (defvar helm-mm-exact-pattern-str nil)
92 (defvar helm-mm-exact-pattern-real nil)
93
94 (defun helm-mm-exact-get-pattern (pattern)
95   (unless (equal pattern helm-mm-exact-pattern-str)
96     (setq helm-mm-exact-pattern-str pattern
97           helm-mm-exact-pattern-real (concat "\n" pattern "\n")))
98   helm-mm-exact-pattern-real)
99
100
101 (cl-defun helm-mm-exact-match (str &optional (pattern helm-pattern))
102   (if case-fold-search
103       (progn
104         (setq str (downcase str)
105               pattern (downcase pattern))
106         (string= str pattern))
107       (string= str pattern)))
108
109 (defun helm-mm-exact-search (pattern &rest _ignore)
110   (and (search-forward (helm-mm-exact-get-pattern pattern) nil t)
111        (forward-line -1)))
112
113
114 ;;; Prefix match
115 ;;
116 ;;
117 ;; Internal
118 (defvar helm-mm-prefix-pattern-str nil)
119 (defvar helm-mm-prefix-pattern-real nil)
120
121 (defun helm-mm-prefix-get-pattern (pattern)
122   (unless (equal pattern helm-mm-prefix-pattern-str)
123     (setq helm-mm-prefix-pattern-str pattern
124           helm-mm-prefix-pattern-real (concat "\n" pattern)))
125   helm-mm-prefix-pattern-real)
126
127 (defun helm-mm-prefix-match (str &optional pattern)
128   ;; In filename completion basename and basedir may be
129   ;; quoted, unquote them for string comparison (Issue #1283).
130   (setq pattern (replace-regexp-in-string
131                  "\\\\" "" (or pattern helm-pattern)))
132   (let ((len (length pattern)))
133     (and (<= len (length str))
134          (string= (substring str 0 len) pattern ))))
135
136 (defun helm-mm-prefix-search (pattern &rest _ignore)
137   (search-forward (helm-mm-prefix-get-pattern pattern) nil t))
138
139
140 ;;; Multiple regexp patterns 1 (order is preserved / prefix).
141 ;;
142 ;;
143 ;; Internal
144 (defvar helm-mm-1-pattern-str nil)
145 (defvar helm-mm-1-pattern-real nil)
146
147 (defun helm-mm-1-get-pattern (pattern)
148   (unless (equal pattern helm-mm-1-pattern-str)
149     (setq helm-mm-1-pattern-str pattern
150           helm-mm-1-pattern-real
151           (concat "^" (helm-mm-1-make-regexp pattern))))
152   helm-mm-1-pattern-real)
153
154 (cl-defun helm-mm-1-match (str &optional (pattern helm-pattern))
155   (string-match (helm-mm-1-get-pattern pattern) str))
156
157 (defun helm-mm-1-search (pattern &rest _ignore)
158   (re-search-forward (helm-mm-1-get-pattern pattern) nil t))
159
160
161 ;;; Multiple regexp patterns 2 (order is preserved / partial).
162 ;;
163 ;;
164 ;; Internal
165 (defvar helm-mm-2-pattern-str nil)
166 (defvar helm-mm-2-pattern-real nil)
167
168 (defun helm-mm-2-get-pattern (pattern)
169   (unless (equal pattern helm-mm-2-pattern-str)
170     (setq helm-mm-2-pattern-str pattern
171           helm-mm-2-pattern-real
172           (concat "^.*" (helm-mm-1-make-regexp pattern))))
173   helm-mm-2-pattern-real)
174
175 (cl-defun helm-mm-2-match (str &optional (pattern helm-pattern))
176   (string-match (helm-mm-2-get-pattern pattern) str))
177
178 (defun helm-mm-2-search (pattern &rest _ignore)
179   (re-search-forward (helm-mm-2-get-pattern pattern) nil t))
180
181
182 ;;; Multiple regexp patterns 3 (permutation).
183 ;;
184 ;;
185 ;; Internal
186 (defvar helm-mm-3-pattern-str nil)
187 (defvar helm-mm-3-pattern-list nil)
188
189 (defun helm-mm-3-get-patterns (pattern)
190   "Return `helm-mm-3-pattern-list', a list of predicate/regexp cons cells.
191 e.g ((identity . \"foo\") (identity . \"bar\")).
192 This is done only if `helm-mm-3-pattern-str' is same as PATTERN."
193   (unless (equal pattern helm-mm-3-pattern-str)
194     (setq helm-mm-3-pattern-str pattern
195           helm-mm-3-pattern-list
196           (helm-mm-3-get-patterns-internal pattern)))
197   helm-mm-3-pattern-list)
198
199 (defun helm-mm-3-get-patterns-internal (pattern)
200   "Return a list of predicate/regexp cons cells.
201 e.g ((identity . \"foo\") (identity . \"bar\"))."
202   (unless (string= pattern "")
203     (cl-loop for pat in (helm-mm-split-pattern pattern)
204           collect (if (string= "!" (substring pat 0 1))
205                       (cons 'not (substring pat 1))
206                     (cons 'identity pat)))))
207
208 (cl-defun helm-mm-3-match (str &optional (pattern helm-pattern))
209   "Check if PATTERN match STR.
210 When PATTERN contain a space, it is splitted and matching is done
211 with the several resulting regexps against STR.
212 e.g \"bar foo\" will match \"foobar\" and \"barfoo\".
213 Argument PATTERN, a string, is transformed in a list of
214 cons cell with `helm-mm-3-get-patterns' if it contain a space.
215 e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")).
216 Then each predicate of cons cell(s) is called with regexp of same
217 cons cell against STR (a candidate).
218 i.e (identity (string-match \"foo\" \"foo bar\")) => t."
219   (let ((pat (helm-mm-3-get-patterns pattern)))
220     (cl-loop for (predicate . regexp) in pat
221              always (funcall predicate
222                              (condition-case _err
223                                  ;; FIXME: Probably do nothing when
224                                  ;; using fuzzy leaving the job
225                                  ;; to the fuzzy fn.
226                                  (string-match regexp str)
227                                (invalid-regexp nil))))))
228
229 (defun helm-mm-3-search-base (pattern searchfn1 searchfn2)
230   "Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2.
231 This is the search function for `candidates-in-buffer' enabled sources.
232 Use the same method as `helm-mm-3-match' except it search in buffer
233 instead of matching on a string.
234 i.e (identity (re-search-forward \"foo\" (point-at-eol) t)) => t."
235   (cl-loop with pat = (if (stringp pattern)
236                           (helm-mm-3-get-patterns pattern)
237                           pattern)
238            when (eq (caar pat) 'not) return
239            ;; Pass the job to `helm-search-match-part'.
240            (prog1 (list (point-at-bol) (point-at-eol))
241              (forward-line 1))
242            while (condition-case _err
243                      (funcall searchfn1 (or (cdar pat) "") nil t)
244                    (invalid-regexp nil))
245            for bol = (point-at-bol)
246            for eol = (point-at-eol)
247            if (cl-loop for (pred . str) in (cdr pat) always
248                        (progn (goto-char bol)
249                               (funcall pred (condition-case _err
250                                                 (funcall searchfn2 str eol t)
251                                               (invalid-regexp nil)))))
252            do (goto-char eol) and return t
253            else do (goto-char eol)
254            finally return nil))
255
256 (defun helm-mm-3-search (pattern &rest _ignore)
257   (when (stringp pattern)
258     (setq pattern (helm-mm-3-get-patterns pattern)))
259   (helm-mm-3-search-base
260    pattern 're-search-forward 're-search-forward))
261
262 ;;; mp-3 with migemo
263 ;;
264 ;;
265 (defvar helm-mm--previous-migemo-info nil
266   "[Internal] Cache previous migemo query.")
267 (make-local-variable 'helm-mm--previous-migemo-info)
268
269 (declare-function migemo-get-pattern "ext:migemo.el")
270 (declare-function migemo-search-pattern-get "ext:migemo.el")
271
272 (define-minor-mode helm-migemo-mode
273     "Enable migemo in helm.
274 It will be available in the sources handling it,
275 i.e the sources which have the slot :migemo with non--nil value."
276   :lighter " Hmio"
277   :group 'helm
278   :global t
279   (cl-assert (featurep 'migemo)
280              nil "No feature called migemo found, install migemo.el."))
281
282 (defun helm-mm-migemo-get-pattern (pattern)
283   (let ((regex (migemo-get-pattern pattern)))
284     (if (ignore-errors (string-match regex "") t)
285         (concat regex "\\|" pattern) pattern)))
286
287 (defun helm-mm-migemo-search-pattern-get (pattern)
288   (let ((regex (migemo-search-pattern-get pattern)))
289     (if (ignore-errors (string-match regex "") t)
290         (concat regex "\\|" pattern) pattern)))
291
292 (defun helm-mm-migemo-string-match (pattern str)
293   "Migemo version of `string-match'."
294   (unless (assoc pattern helm-mm--previous-migemo-info)
295     (with-helm-buffer
296       (setq helm-mm--previous-migemo-info
297             (push (cons pattern (helm-mm-migemo-get-pattern pattern))
298                   helm-mm--previous-migemo-info))))
299   (string-match (assoc-default pattern helm-mm--previous-migemo-info) str))
300
301 (cl-defun helm-mm-3-migemo-match (str &optional (pattern helm-pattern))
302   (and helm-migemo-mode
303        (cl-loop for (pred . re) in (helm-mm-3-get-patterns pattern)
304                 always (funcall pred (helm-mm-migemo-string-match re str)))))
305
306 (defun helm-mm-migemo-forward (word &optional bound noerror count)
307   (with-helm-buffer
308     (unless (assoc word helm-mm--previous-migemo-info)
309       (setq helm-mm--previous-migemo-info
310             (push (cons word (if (delq 'ascii (find-charset-string word))
311                                  word
312                                (helm-mm-migemo-search-pattern-get word)))
313                   helm-mm--previous-migemo-info))))
314   (re-search-forward
315    (assoc-default word helm-mm--previous-migemo-info) bound noerror count))
316
317 (defun helm-mm-3-migemo-search (pattern &rest _ignore)
318   (and helm-migemo-mode
319        (helm-mm-3-search-base
320         pattern 'helm-mm-migemo-forward 'helm-mm-migemo-forward)))
321
322
323 ;;; mp-3p- (multiple regexp pattern 3 with prefix search)
324 ;;
325 ;;
326 (defun helm-mm-3p-match (str &optional pattern)
327   "Check if PATTERN match STR.
328 Same as `helm-mm-3-match' but more strict, matching against prefix also.
329 e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to
330 `helm-mm-3-match'."
331   (let* ((pat (helm-mm-3-get-patterns (or pattern helm-pattern)))
332          (first (car pat)))
333     (and (funcall (car first) (helm-mm-prefix-match str (cdr first)))
334          (cl-loop for (predicate . regexp) in (cdr pat)
335                always (funcall predicate (string-match regexp str))))))
336
337 (defun helm-mm-3p-search (pattern &rest _ignore)
338   (when (stringp pattern)
339     (setq pattern (helm-mm-3-get-patterns pattern)))
340   (helm-mm-3-search-base
341    pattern 'helm-mm-prefix-search 're-search-forward))
342
343
344 ;;; Generic multi-match/search functions
345 ;;
346 ;;
347 (cl-defun helm-mm-match (str &optional (pattern helm-pattern))
348   (let ((fun (cl-ecase helm-mm-matching-method
349                (multi1 #'helm-mm-1-match)
350                (multi2 #'helm-mm-2-match)
351                (multi3 #'helm-mm-3-match)
352                (multi3p #'helm-mm-3p-match))))
353     (funcall fun str pattern)))
354
355 (defun helm-mm-search (pattern &rest _ignore)
356   (let ((fun (cl-ecase helm-mm-matching-method
357                (multi1 #'helm-mm-1-search)
358                (multi2 #'helm-mm-2-search)
359                (multi3 #'helm-mm-3-search)
360                (multi3p #'helm-mm-3p-search))))
361     (funcall fun pattern)))
362
363
364 (provide 'helm-multi-match)
365
366
367 ;; Local Variables:
368 ;; byte-compile-warnings: (not obsolete)
369 ;; coding: utf-8
370 ;; indent-tabs-mode: nil
371 ;; End:
372
373 ;;; helm-multi-match.el ends here