]> git.eshelyaron.com Git - emacs.git/commitdiff
* lisp/character-fold.el: Also play nice with case-folding
authorArtur Malabarba <bruce.connor.am@gmail.com>
Sat, 28 Nov 2015 15:31:43 +0000 (15:31 +0000)
committerArtur Malabarba <bruce.connor.am@gmail.com>
Sat, 28 Nov 2015 16:21:54 +0000 (16:21 +0000)
(character-fold-to-regexp): Take `case-fold-search' into account.

lisp/character-fold.el
test/automated/character-fold-tests.el

index 0086345cccb7280c3e4717e74ecf34121103ced7..49d75bd24eef387c626d127b672fc06ef819c1fa 100644 (file)
@@ -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)))
index aa2ee96a7a47ac7b682437d0868533230b404e67..3a288b9071cd7c713899a80bfefee07165efbb13 100644 (file)
@@ -37,7 +37,7 @@
 
 \f
 (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))))
 (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")