[nongnu] elpa/helm 16ab10d4b8 2/2: Fix highlighting with diacritics (#2470)

[ELPA Syncer]

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

    Fix highlighting with diacritics (#2470)
---
 helm-core.el        | 25 ++++++++++++++++---------
 helm-multi-match.el |  5 +++++
 helm-source.el      |  9 +++------
 3 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/helm-core.el b/helm-core.el
index 1f98c1feaa..b9ed138fda 100644
--- a/helm-core.el
+++ b/helm-core.el
@@ -4465,12 +4465,14 @@ useful when the order of the candidates is meaningful, 
e.g. with
 `recentf-list'."
   (helm-fuzzy-matching-default-sort-fn-1 candidates nil nil t))
 
-(defun helm--maybe-get-migemo-pattern (pattern)
+(defun helm--maybe-get-migemo-pattern (pattern &optional diacritics)
   (or (and helm-migemo-mode
            (assoc-default pattern helm-mm--previous-migemo-info))
-      pattern))
+      (if diacritics
+          (char-fold-to-regexp pattern)
+        pattern)))
 
-(defun helm-fuzzy-default-highlight-match (candidate)
+(defun helm-fuzzy-default-highlight-match (candidate &optional diacritics)
   "The default function to highlight matches in fuzzy matching.
 Highlight elements in CANDIDATE matching `helm-pattern' according
 to the matching method in use."
@@ -4481,7 +4483,7 @@ to the matching method in use."
     (let* ((pair    (and (consp candidate) candidate))
            (display (helm-stringify (if pair (car pair) candidate)))
            (real    (cdr pair))
-           (regex   (helm--maybe-get-migemo-pattern helm-pattern))
+           (regex   (helm--maybe-get-migemo-pattern helm-pattern diacritics))
            (mp      (pcase (get-text-property 0 'match-part display)
                       ((pred (string= display)) nil)
                       (str str)))
@@ -4510,8 +4512,11 @@ to the matching method in use."
               (when (zerop count)
                 (cl-loop with multi-match = (string-match-p " " helm-pattern)
                          with patterns = (if multi-match
-                                             (mapcar 
#'helm--maybe-get-migemo-pattern
-                                                     (helm-mm-split-pattern 
helm-pattern))
+                                             (cl-loop for pat in 
(helm-mm-split-pattern
+                                                                  helm-pattern)
+                                                      collect
+                                                      
(helm--maybe-get-migemo-pattern
+                                                       pat diacritics))
                                            (split-string helm-pattern "" t))
                          for p in patterns
                          ;; Multi matches (regexps patterns).
@@ -4534,12 +4539,14 @@ to the matching method in use."
         (setq display (if mp (concat beg-str (buffer-string) end-str) 
(buffer-string))))
       (if real (cons display real) display))))
 
-(defun helm-fuzzy-highlight-matches (candidates _source)
+(defun helm-fuzzy-highlight-matches (candidates source)
   "The filtered-candidate-transformer function to highlight fuzzy matches.
 See `helm-fuzzy-default-highlight-match'."
   (cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument 
functionp: nil")
-  (cl-loop for c in candidates
-           collect (funcall helm-fuzzy-matching-highlight-fn c)))
+  (cl-loop with diac = (memq 'helm-mm-3-match-on-diacritics
+                             (helm-mklist (helm-get-attr 'match source)))
+           for c in candidates
+           collect (funcall helm-fuzzy-matching-highlight-fn c diac)))
 
 
 ;;; helm-flex style
diff --git a/helm-multi-match.el b/helm-multi-match.el
index 512adda64a..b848c09cce 100644
--- a/helm-multi-match.el
+++ b/helm-multi-match.el
@@ -360,6 +360,11 @@ E.g. \"bar foo baz\" will match \"barfoobaz\" or 
\"barbazfoo\" but not
                (multi3p #'helm-mm-3p-match))))
     (funcall fun candidate pattern)))
 
+(cl-defun helm-mm-3-match-on-diacritics (candidate &optional (pattern 
helm-pattern))
+  "Same as `helm-mm-3-match' but match on diacritics if possible."
+  (let ((helm-mm--match-on-diacritics t))
+    (helm-mm-match candidate pattern)))
+
 (defun helm-mm-search (pattern &rest _ignore)
   "Search for PATTERN with `helm-mm-matching-method' function."
   (let ((fun (cl-ecase helm-mm-matching-method
diff --git a/helm-source.el b/helm-source.el
index 429c3e994a..d916f256e8 100644
--- a/helm-source.el
+++ b/helm-source.el
@@ -976,11 +976,6 @@ 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* (diacritics
          (defmatch         (helm-aif (slot-value source 'match)
@@ -1003,7 +998,9 @@ 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-source-default-match-fns diacritics))))
+                   (t (if diacritics
+                          (list 'helm-mm-exact-match 
'helm-mm-3-match-on-diacritics)
+                        helm-mm-default-match-functions))))
       (search (cond (defsearch-strict)
                     (migemo
                      (append helm-mm-default-search-functions