[nongnu] elpa/helm 53c22dce50 1/2: Allow using 'diacritics as match attribute value (#2470)

[ELPA Syncer]

branch: elpa/helm
commit 53c22dce50de03b21c5cf20a6710d0a663c89a66
Author: Thierry Volpiatto <thievol@posteo.net>
Commit: Thierry Volpiatto <thievol@posteo.net>

    Allow using 'diacritics as match attribute value (#2470)
---
 helm-multi-match.el | 11 ++++++++++-
 helm-source.el      | 36 +++++++++++++++++++++++-------------
 2 files changed, 33 insertions(+), 14 deletions(-)

diff --git a/helm-multi-match.el b/helm-multi-match.el
index eda59f63df..512adda64a 100644
--- a/helm-multi-match.el
+++ b/helm-multi-match.el
@@ -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
@@ -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)
diff --git a/helm-source.el b/helm-source.el
index f96c2d6ce4..429c3e994a 100644
--- a/helm-source.el
+++ b/helm-source.el
@@ -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.
@@ -973,19 +976,26 @@ 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
@@ -993,7 +1003,7 @@ Arguments ARGS are keyword value pairs as defined in 
CLASS."
                             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