Skip to content

Commit

Permalink
Allow using 'diacritics as match attribute value (#2470)
Browse files Browse the repository at this point in the history
  • Loading branch information
thierryvolpiatto committed Mar 31, 2022
1 parent 5b17313 commit 53c22dc
Show file tree
Hide file tree
Showing 2 changed files with 33 additions and 14 deletions.
11 changes: 10 additions & 1 deletion helm-multi-match.el
Original file line number Diff line number Diff line change
Expand Up @@ -206,6 +206,11 @@ E.g., ((identity . \"foo\") (not . \"bar\"))."
(cons 'not (substring pat 1))
(cons 'identity pat)))))

(defun helm-mm-regexp-p (string)
(string-match-p "[[]*+^$.?\\]" string))

(defvar helm-mm--match-on-diacritics nil)

(cl-defun helm-mm-3-match (candidate &optional (pattern helm-pattern))
"Check if PATTERN match CANDIDATE.
When PATTERN contains a space, it is splitted and matching is
Expand All @@ -219,12 +224,16 @@ the same cons cell against CANDIDATE.
I.e. (identity (string-match \"foo\" \"foo bar\")) => t."
(let ((pat (helm-mm-3-get-patterns pattern)))
(cl-loop for (predicate . regexp) in pat
for re = (if (and (not (helm-mm-regexp-p regexp))
helm-mm--match-on-diacritics)
(char-fold-to-regexp regexp)
regexp)
always (funcall predicate
(condition-case _err
;; FIXME: Probably do nothing when
;; using fuzzy leaving the job
;; to the fuzzy fn.
(string-match regexp candidate)
(string-match re candidate)
(invalid-regexp nil))))))

(defun helm-mm-3-search-base (pattern searchfn1 searchfn2)
Expand Down
36 changes: 23 additions & 13 deletions helm-source.el
Original file line number Diff line number Diff line change
Expand Up @@ -469,6 +469,9 @@
in the list of results and then results from the other
functions, respectively.
If the special symbol `diacritics' is given as value helm will match
diacritics candidates with `char-fold-to-regexp'.
This attribute has no effect for asynchronous sources (see
attribute `candidates'), and sources using `match-dynamic'
since they perform pattern matching themselves.
Expand Down Expand Up @@ -973,27 +976,34 @@ Arguments ARGS are keyword value pairs as defined in CLASS."
(defvar helm-mm-default-search-functions)
(defvar helm-mm-default-match-functions)

(defun helm-source-default-match-fns (diacritics)
(list 'helm-mm-exact-match (lambda (candidate &optional _pattern)
(let ((helm-mm--match-on-diacritics diacritics))
(helm-mm-match candidate)))))

(defun helm-source-mm-get-search-or-match-fns (source method)
(let ((defmatch (helm-aif (slot-value source 'match)
(helm-mklist it)))
(defmatch-strict (helm-aif (and (eq method 'match)
(slot-value source 'match-strict))
(helm-mklist it)))
(defsearch (helm-aif (and (eq method 'search)
(slot-value source 'search))
(helm-mklist it)))
(defsearch-strict (helm-aif (and (eq method 'search-strict)
(slot-value source 'search-strict))
(helm-mklist it)))
(migemo (slot-value source 'migemo)))
(let* (diacritics
(defmatch (helm-aif (slot-value source 'match)
(unless (setq diacritics (eq it 'diacritics))
(helm-mklist it))))
(defmatch-strict (helm-aif (and (eq method 'match)
(slot-value source 'match-strict))
(helm-mklist it)))
(defsearch (helm-aif (and (eq method 'search)
(slot-value source 'search))
(helm-mklist it)))
(defsearch-strict (helm-aif (and (eq method 'search-strict)
(slot-value source 'search-strict))
(helm-mklist it)))
(migemo (slot-value source 'migemo)))
(cl-case method
(match (cond (defmatch-strict)
(migemo
(append helm-mm-default-match-functions
defmatch '(helm-mm-3-migemo-match)))
(defmatch
(append helm-mm-default-match-functions defmatch))
(t helm-mm-default-match-functions)))
(t (helm-source-default-match-fns diacritics))))
(search (cond (defsearch-strict)
(migemo
(append helm-mm-default-search-functions
Expand Down

0 comments on commit 53c22dc

Please sign in to comment.