[nongnu] elpa/helm 4f0066ac3b 2/6: Implement diacritics for in buffer sources

[ELPA Syncer]

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

    Implement diacritics for in buffer sources
    
    Diacritics was only implemented on sync source via the :match slot, as
    it is problematic to implement it through this slot in in buffer
    sources, we use a specific :diacritics slot in helm-source-in-buffer.
    
    1) Implement matching on match-part with diacritics (helm-core).
    2) Make helm-mm-3-search-base aware of diacritics and create a
    specific fn for this.
    3) Add diacritics slot in helm-source-in-buffer and prepare search
    function when the feature is enabled though this slot.
    4) Enable it on helm-occur for testing (will make it configurable and
    nil by default later).
    5) Fix order of match functions when diacritics is enabled.
---
 helm-core.el        | 12 +++++++-----
 helm-multi-match.el | 24 +++++++++++++++++++++---
 helm-occur.el       |  1 +
 helm-source.el      | 37 +++++++++++++++++++++++++++++--------
 4 files changed, 58 insertions(+), 16 deletions(-)

diff --git a/helm-core.el b/helm-core.el
index ec635732d2..acd4b56738 100644
--- a/helm-core.el
+++ b/helm-core.el
@@ -6443,7 +6443,8 @@ To customize `helm-candidates-in-buffer' behaviour, use 
`search',
 
 (defun helm-search-from-candidate-buffer (pattern get-line-fn search-fns
                                                   limit start-point 
match-part-fn source)
-  (let ((inhibit-read-only t))
+  (let ((inhibit-read-only t)
+        (diacritics (assoc-default 'diacritics source)))
     (helm--search-from-candidate-buffer-1
      (lambda ()
        (cl-loop with hash = (make-hash-table :test 'equal)
@@ -6498,14 +6499,14 @@ To customize `helm-candidates-in-buffer' behaviour, use 
`search',
                                     ;; returns a cons cell, collect PATTERN 
only if it
                                     ;; match the part of CAND specified by
                                     ;; the match-part func.
-                                    (helm-search-match-part cand pattern)))
+                                    (helm-search-match-part cand pattern 
diacritics)))
                          do (progn
                               (puthash cand iter hash)
                               (helm--maybe-process-filter-one-by-one-candidate 
cand source)
                               (cl-incf count))
                          and collect cand))))))
 
-(defun helm-search-match-part (candidate pattern)
+(defun helm-search-match-part (candidate pattern diacritics)
   "Match PATTERN only on match-part property value of CANDIDATE.
 
 Because `helm-search-match-part' may be called even if
@@ -6515,8 +6516,9 @@ computed by match-part-fn and stored in the match-part 
property."
   (let ((part (or (get-text-property 0 'match-part candidate)
                   candidate))
         (fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))
-        (matchfn (if helm-migemo-mode
-                     'helm-mm-migemo-string-match 'string-match)))
+        (matchfn (cond (helm-migemo-mode 'helm-mm-migemo-string-match)
+                       (diacritics 'helm-mm-diacritics-string-match)
+                       (t 'string-match))))
     (if (string-match " " pattern)
         (cl-loop for i in (helm-mm-split-pattern pattern) always
                  (if (string-match "\\`!" i)
diff --git a/helm-multi-match.el b/helm-multi-match.el
index b848c09cce..559c3feb9c 100644
--- a/helm-multi-match.el
+++ b/helm-multi-match.el
@@ -245,19 +245,30 @@ i.e (identity (re-search-forward \"foo\" (point-at-eol) 
t)) => t."
   (cl-loop with pat = (if (stringp pattern)
                           (helm-mm-3-get-patterns pattern)
                           pattern)
+           with regex = (cdar pat)
+           with regex1 = (if (and regex
+                                  (not (helm-mm-regexp-p regex))
+                                  helm-mm--match-on-diacritics)
+                             (char-fold-to-regexp regex)
+                           regex)
            when (eq (caar pat) 'not) return
            ;; Pass the job to `helm-search-match-part'.
            (prog1 (list (point-at-bol) (point-at-eol))
              (forward-line 1))
            while (condition-case _err
-                     (funcall searchfn1 (or (cdar pat) "") nil t)
+                     (funcall searchfn1 (or regex1 "") nil t)
                    (invalid-regexp nil))
            for bol = (point-at-bol)
            for eol = (point-at-eol)
-           if (cl-loop for (pred . str) in (cdr pat) always
+           if (cl-loop for (pred . str) in (cdr pat)
+                       for regexp = (if (and (not (helm-mm-regexp-p str))
+                                             helm-mm--match-on-diacritics)
+                                        (char-fold-to-regexp str)
+                                      str)
+                       always
                        (progn (goto-char bol)
                               (funcall pred (condition-case _err
-                                                (funcall searchfn2 str eol t)
+                                                (funcall searchfn2 regexp eol 
t)
                                               (invalid-regexp nil)))))
            do (goto-char eol) and return t
            else do (goto-char eol)
@@ -266,6 +277,10 @@ i.e (identity (re-search-forward \"foo\" (point-at-eol) 
t)) => t."
 (defun helm-mm-3-search (pattern &rest _ignore)
   (helm-mm-3-search-base
    pattern 're-search-forward 're-search-forward))
+
+(defun helm-mm-3-search-on-diacritics (pattern &rest _ignore)
+  (let ((helm-mm--match-on-diacritics t))
+    (helm-mm-3-search pattern)))
 
 ;;; mp-3 with migemo
 ;;  Needs https://github.com/emacs-jp/migemo
@@ -306,6 +321,9 @@ i.e. the sources which have the slot :migemo with non--nil 
value."
                   helm-mm--previous-migemo-info))))
   (string-match (assoc-default pattern helm-mm--previous-migemo-info) str))
 
+(defun helm-mm-diacritics-string-match (pattern str)
+  (string-match (char-fold-to-regexp pattern) str))
+
 (cl-defun helm-mm-3-migemo-match (candidate &optional (pattern helm-pattern))
   (and helm-migemo-mode
        (cl-loop for (pred . re) in (helm-mm-3-get-patterns pattern)
diff --git a/helm-occur.el b/helm-occur.el
index 7880df5e7f..bf60561dfd 100644
--- a/helm-occur.el
+++ b/helm-occur.el
@@ -290,6 +290,7 @@ engine beeing completely different and also much faster."
                (when (string-match helm-occur--search-buffer-regexp
                                    candidate)
                  (match-string 2 candidate)))
+             :diacritics t
              :search (lambda (pattern)
                        (when (string-match "\\`\\^\\([^ ]*\\)" pattern)
                          (setq pattern (concat "^[0-9]* \\{1\\}" (match-string 
1 pattern))))
diff --git a/helm-source.el b/helm-source.el
index 0325598c99..2f5bf9ace8 100644
--- a/helm-source.el
+++ b/helm-source.el
@@ -823,6 +823,13 @@ inherit from `helm-source'.")
    (match
     :initform '(identity))
 
+   (diacritics
+    :initarg :diacritics
+    :initform nil
+    :custom boolean
+    :documentation
+    "  Ignore diacritics when searching.")
+
    (get-line
     :initarg :get-line
     :initform 'buffer-substring-no-properties
@@ -978,10 +985,11 @@ Arguments ARGS are keyword value pairs as defined in 
CLASS."
 (defvar helm-mm-default-match-functions)
 
 (defun helm-source-mm-get-search-or-match-fns (source method)
-  (let* (diacritics
+  (let* ((diacritics (cl-case method
+                       (match  (eq (slot-value source 'match) 'diacritics))
+                       (search (slot-value source 'diacritics))))
          (defmatch         (helm-aif (slot-value source 'match)
-                               (unless (setq diacritics (eq it 'diacritics))
-                                 (helm-mklist it))))
+                               (unless diacritics (helm-mklist it))))
          (defmatch-strict  (helm-aif (and (eq method 'match)
                                           (slot-value source 'match-strict))
                                (helm-mklist it)))
@@ -994,20 +1002,33 @@ Arguments ARGS are keyword value pairs as defined in 
CLASS."
          (migemo           (slot-value source 'migemo)))
     (cl-case method
       (match (cond (defmatch-strict)
+                   ((and migemo diacritics)
+                    (append (list 'helm-mm-exact-match
+                                  'helm-mm-3-match-on-diacritics)
+                            defmatch '(helm-mm-3-migemo-match)))
                    (migemo
                     (append helm-mm-default-match-functions
                             defmatch '(helm-mm-3-migemo-match)))
-                   (defmatch
+                   ((and defmatch (not diacritics))
                     (append helm-mm-default-match-functions defmatch))
-                   (t (if diacritics
-                          (list 'helm-mm-exact-match 
'helm-mm-3-match-on-diacritics)
-                        helm-mm-default-match-functions))))
+                   (diacritics
+                    (append (list 'helm-mm-exact-match
+                                  'helm-mm-3-match-on-diacritics)))
+                   (t helm-mm-default-match-functions)))
       (search (cond (defsearch-strict)
+                    ((and migemo diacritics)
+                     (append '(helm-mm-exact-search)
+                             defsearch
+                             '(helm-mm-3-migemo-search
+                               helm-mm-3-search-on-diacritics)))
                     (migemo
                      (append helm-mm-default-search-functions
                              defsearch '(helm-mm-3-migemo-search)))
-                    (defsearch
+                    ((and defsearch (not diacritics))
                      (append helm-mm-default-search-functions defsearch))
+                    (diacritics
+                     `(helm-mm-exact-search
+                       ,@defsearch helm-mm-3-search-on-diacritics))
                     (t helm-mm-default-search-functions))))))