| 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 | |
