* lisp/character-fold.el: Also play nice with case-folding

(character-fold-to-regexp): Take `case-fold-search' into account.

2 files changed, 29 insertions, 10 deletions

diff --git a/lisp/character-fold.el b/lisp/character-fold.el
index 0086345cccb..49d75bd24ee 100644
--- a/lisp/character-fold.el
+++ b/lisp/character-fold.el
@@ -152,11 +152,13 @@ regexp) and other characters are `regexp-quote'd.
 
 FROM is for internal use.  It specifies an index in the STRING
 from which to start."
-  (let ((spaces 0)
-        (multi-char-table (char-table-extra-slot character-fold-table 0))
-        (i (or from 0))
-        (end (length string))
-        (out nil))
+  (let* ((spaces 0)
+         (multi-char-table (char-table-extra-slot character-fold-table 0))
+         (lower-case-table (current-case-table))
+         (upper-case-table (char-table-extra-slot lower-case-table 0))
+         (i (or from 0))
+         (end (length string))
+         (out nil))
     ;; When the user types a space, we want to match the table entry
     ;; for ?\s, which is generally a regexp like "[ ...]".  However,
     ;; the `search-spaces-regexp' variable doesn't "see" spaces inside
@@ -173,9 +175,21 @@ from which to start."
              (setq spaces 0))
            (let ((regexp (or (aref character-fold-table c)
                              (regexp-quote (string c))))
-                 ;; Long string.  The regexp would probably be too long.
-                 (alist (unless (> end 60)
-                          (aref multi-char-table c))))
+                 (alist nil))
+             ;; Long string.  The regexp would probably be too long.
+             (unless (> end 50)
+               (setq alist (aref multi-char-table c))
+               (when case-fold-search
+                 (let ((other-c (aref lower-case-table c)))
+                   (when (or (not other-c)
+                             (eq other-c c))
+                     (setq other-c (aref upper-case-table c)))
+                   (when other-c
+                     (setq alist (append alist (aref multi-char-table other-c)))
+                     (setq regexp (concat "\\(?:" regexp "\\|"
+                                          (or (aref character-fold-table other-c)
+                                              (regexp-quote (string other-c)))
+                                          "\\)"))))))
              (push (let ((alist-out '("\\)")))
                      (pcase-dolist (`(,suffix . ,out-regexp) alist)
                        (let ((len-suf (length suffix)))
diff --git a/test/automated/character-fold-tests.el b/test/automated/character-fold-tests.el
index aa2ee96a7a4..3a288b9071c 100644
--- a/test/automated/character-fold-tests.el
+++ b/test/automated/character-fold-tests.el
@@ -37,7 +37,7 @@
 
 
 (ert-deftest character-fold--test-consistency ()
-  (dotimes (n 100)
+  (dotimes (n 50)
     (let ((w (character-fold--random-word n)))
       ;; A folded string should always match the original string.
       (character-fold--test-search-with-contents w w))))
@@ -57,7 +57,12 @@
 (defun character-fold--test-match-exactly (string &rest strings-to-match)
   (let ((re (concat "\\`" (character-fold-to-regexp string) "\\'")))
     (dolist (it strings-to-match)
-      (should (string-match re it)))))
+      (should (string-match re it)))
+    ;; Case folding
+    (let ((case-fold-search t))
+      (dolist (it strings-to-match)
+        (should (string-match (upcase re) (downcase it)))
+        (should (string-match (downcase re) (upcase it)))))))
 
 (ert-deftest character-fold--test-some-defaults ()
   (dolist (it '(("ffl" . "ffl") ("ffi" . "ffi")