procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
(character-fold-to-regexp): Take `case-fold-search' into account.
This commit is contained in:
Artur Malabarba 2015-11-28 15:31:43 +00:00
parent 5c5997002b
commit 19141a9be6
2 changed files with 29 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lisp/character-fold.el
View 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)))

9
test/automated/character-fold-tests.el
View file

@ -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")