* lisp/char-fold.el: Rename from character-fold.el.
* lisp/replace.el (replace-char-fold): Rename from replace-character-fold. * test/automated/char-fold-tests.el: Rename from character-fold-tests.el. http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00529.html
This commit is contained in:
parent
a35826dbd4
commit
1fe1e0a8e7
7 changed files with 93 additions and 93 deletions
|
@ -1264,13 +1264,13 @@ but match under character folding are known as @dfn{equivalent
|
||||||
character sequences}.
|
character sequences}.
|
||||||
|
|
||||||
@kindex M-s ' @r{(Incremental Search)}
|
@kindex M-s ' @r{(Incremental Search)}
|
||||||
@findex isearch-toggle-character-fold
|
@findex isearch-toggle-char-fold
|
||||||
Generally, search commands in Emacs do not by default perform
|
Generally, search commands in Emacs do not by default perform
|
||||||
character folding in order to match equivalent character sequences.
|
character folding in order to match equivalent character sequences.
|
||||||
You can enable this behavior by customizing the variable
|
You can enable this behavior by customizing the variable
|
||||||
@code{search-default-mode} to @code{character-fold-to-regexp}.
|
@code{search-default-mode} to @code{char-fold-to-regexp}.
|
||||||
@xref{Search Customizations}. Within an incremental search, typing
|
@xref{Search Customizations}. Within an incremental search, typing
|
||||||
@kbd{M-s '} (@code{isearch-toggle-character-fold}) toggles character
|
@kbd{M-s '} (@code{isearch-toggle-char-fold}) toggles character
|
||||||
folding, but only for that search. (Replace commands have a different
|
folding, but only for that search. (Replace commands have a different
|
||||||
default, controlled by a separate option; see @ref{Replacement and Lax
|
default, controlled by a separate option; see @ref{Replacement and Lax
|
||||||
Matches}.)
|
Matches}.)
|
||||||
|
@ -1481,7 +1481,7 @@ replacement is done without case conversion.
|
||||||
(@pxref{Lax Search, character folding}) when looking for the text to
|
(@pxref{Lax Search, character folding}) when looking for the text to
|
||||||
replace. To enable character folding for matching in
|
replace. To enable character folding for matching in
|
||||||
@code{query-replace} and @code{replace-string}, set the variable
|
@code{query-replace} and @code{replace-string}, set the variable
|
||||||
@code{replace-character-fold} to a non-@code{nil} value. (This
|
@code{replace-char-fold} to a non-@code{nil} value. (This
|
||||||
setting does not affect the replacement text, only how Emacs finds the
|
setting does not affect the replacement text, only how Emacs finds the
|
||||||
text to replace. It also doesn't affect @code{replace-regexp}.)
|
text to replace. It also doesn't affect @code{replace-regexp}.)
|
||||||
|
|
||||||
|
|
8
etc/NEWS
8
etc/NEWS
|
@ -633,11 +633,11 @@ as many other symbols like U+249C (PARENTHESIZED LATIN SMALL LETTER
|
||||||
A).
|
A).
|
||||||
|
|
||||||
Character folding is enabled by customizing 'search-default-mode' to
|
Character folding is enabled by customizing 'search-default-mode' to
|
||||||
the value 'character-fold-to-regexp'. You can also toggle character
|
the value 'char-fold-to-regexp'. You can also toggle character
|
||||||
folding in the middle of a search by typing 'M-s ''.
|
folding in the middle of a search by typing 'M-s ''.
|
||||||
|
|
||||||
'query-replace' honors character folding if the new variable
|
'query-replace' honors character folding if the new variable
|
||||||
'replace-character-fold' is customized to a non-nil value.
|
'replace-char-fold' is customized to a non-nil value.
|
||||||
|
|
||||||
+++
|
+++
|
||||||
*** New user option 'search-default-mode'.
|
*** New user option 'search-default-mode'.
|
||||||
|
@ -647,9 +647,9 @@ value, nil specifies that Isearch does literal searches (however,
|
||||||
as in previous Emacs versions).
|
as in previous Emacs versions).
|
||||||
|
|
||||||
+++
|
+++
|
||||||
*** New function 'character-fold-to-regexp' can be used
|
*** New function 'char-fold-to-regexp' can be used
|
||||||
by searching commands to produce a regexp matching anything that
|
by searching commands to produce a regexp matching anything that
|
||||||
character-folds into STRING.
|
char-folds into STRING.
|
||||||
|
|
||||||
+++
|
+++
|
||||||
*** The new 'M-s M-w' key binding uses eww to search the web for the
|
*** The new 'M-s M-w' key binding uses eww to search the web for the
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
;;; character-fold.el --- match unicode to similar ASCII -*- lexical-binding: t; -*-
|
;;; char-fold.el --- match unicode to similar ASCII -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
|
;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
@ -22,12 +22,12 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(eval-and-compile (put 'character-fold-table 'char-table-extra-slots 1))
|
(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1))
|
||||||
|
|
||||||
(defconst character-fold-table
|
(defconst char-fold-table
|
||||||
(eval-when-compile
|
(eval-when-compile
|
||||||
(let ((equiv (make-char-table 'character-fold-table))
|
(let ((equiv (make-char-table 'char-fold-table))
|
||||||
(equiv-multi (make-char-table 'character-fold-table))
|
(equiv-multi (make-char-table 'char-fold-table))
|
||||||
(table (unicode-property-table-internal 'decomposition)))
|
(table (unicode-property-table-internal 'decomposition)))
|
||||||
(set-char-table-extra-slot equiv 0 equiv-multi)
|
(set-char-table-extra-slot equiv 0 equiv-multi)
|
||||||
|
|
||||||
|
@ -115,7 +115,7 @@
|
||||||
equiv)
|
equiv)
|
||||||
equiv))
|
equiv))
|
||||||
"Used for folding characters of the same group during search.
|
"Used for folding characters of the same group during search.
|
||||||
This is a char-table with the `character-fold-table' subtype.
|
This is a char-table with the `char-fold-table' subtype.
|
||||||
|
|
||||||
Let us refer to the character in question by char-x.
|
Let us refer to the character in question by char-x.
|
||||||
Each entry is either nil (meaning char-x only matches literally)
|
Each entry is either nil (meaning char-x only matches literally)
|
||||||
|
@ -136,18 +136,18 @@ For instance, the default alist for ?f includes:
|
||||||
|
|
||||||
Exceptionally for the space character (32), ALIST is ignored.")
|
Exceptionally for the space character (32), ALIST is ignored.")
|
||||||
|
|
||||||
(defun character-fold--make-space-string (n)
|
(defun char-fold--make-space-string (n)
|
||||||
"Return a string that matches N spaces."
|
"Return a string that matches N spaces."
|
||||||
(format "\\(?:%s\\|%s\\)"
|
(format "\\(?:%s\\|%s\\)"
|
||||||
(make-string n ?\s)
|
(make-string n ?\s)
|
||||||
(apply #'concat
|
(apply #'concat
|
||||||
(make-list n (or (aref character-fold-table ?\s) " ")))))
|
(make-list n (or (aref char-fold-table ?\s) " ")))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun character-fold-to-regexp (string &optional _lax from)
|
(defun char-fold-to-regexp (string &optional _lax from)
|
||||||
"Return a regexp matching anything that character-folds into STRING.
|
"Return a regexp matching anything that char-folds into STRING.
|
||||||
Any character in STRING that has an entry in
|
Any character in STRING that has an entry in
|
||||||
`character-fold-table' is replaced with that entry (which is a
|
`char-fold-table' is replaced with that entry (which is a
|
||||||
regexp) and other characters are `regexp-quote'd.
|
regexp) and other characters are `regexp-quote'd.
|
||||||
|
|
||||||
If the resulting regexp would be too long for Emacs to handle,
|
If the resulting regexp would be too long for Emacs to handle,
|
||||||
|
@ -156,7 +156,7 @@ just return the result of calling `regexp-quote' on STRING.
|
||||||
FROM is for internal use. It specifies an index in the STRING
|
FROM is for internal use. It specifies an index in the STRING
|
||||||
from which to start."
|
from which to start."
|
||||||
(let* ((spaces 0)
|
(let* ((spaces 0)
|
||||||
(multi-char-table (char-table-extra-slot character-fold-table 0))
|
(multi-char-table (char-table-extra-slot char-fold-table 0))
|
||||||
(i (or from 0))
|
(i (or from 0))
|
||||||
(end (length string))
|
(end (length string))
|
||||||
(out nil))
|
(out nil))
|
||||||
|
@ -172,9 +172,9 @@ from which to start."
|
||||||
(pcase (aref string i)
|
(pcase (aref string i)
|
||||||
(`?\s (setq spaces (1+ spaces)))
|
(`?\s (setq spaces (1+ spaces)))
|
||||||
(c (when (> spaces 0)
|
(c (when (> spaces 0)
|
||||||
(push (character-fold--make-space-string spaces) out)
|
(push (char-fold--make-space-string spaces) out)
|
||||||
(setq spaces 0))
|
(setq spaces 0))
|
||||||
(let ((regexp (or (aref character-fold-table c)
|
(let ((regexp (or (aref char-fold-table c)
|
||||||
(regexp-quote (string c))))
|
(regexp-quote (string c))))
|
||||||
;; Long string. The regexp would probably be too long.
|
;; Long string. The regexp would probably be too long.
|
||||||
(alist (unless (> end 50)
|
(alist (unless (> end 50)
|
||||||
|
@ -206,13 +206,13 @@ from which to start."
|
||||||
(let ((length (car entry))
|
(let ((length (car entry))
|
||||||
(suffix-regexp (cdr entry)))
|
(suffix-regexp (cdr entry)))
|
||||||
(concat suffix-regexp
|
(concat suffix-regexp
|
||||||
(character-fold-to-regexp subs nil length))))
|
(char-fold-to-regexp subs nil length))))
|
||||||
`((0 . ,regexp) . ,matched-entries) "\\|")
|
`((0 . ,regexp) . ,matched-entries) "\\|")
|
||||||
"\\)"))))
|
"\\)"))))
|
||||||
out))))
|
out))))
|
||||||
(setq i (1+ i)))
|
(setq i (1+ i)))
|
||||||
(when (> spaces 0)
|
(when (> spaces 0)
|
||||||
(push (character-fold--make-space-string spaces) out))
|
(push (char-fold--make-space-string spaces) out))
|
||||||
(let ((regexp (apply #'concat (nreverse out))))
|
(let ((regexp (apply #'concat (nreverse out))))
|
||||||
;; Limited by `MAX_BUF_SIZE' in `regex.c'.
|
;; Limited by `MAX_BUF_SIZE' in `regex.c'.
|
||||||
(if (> (length regexp) 5000)
|
(if (> (length regexp) 5000)
|
||||||
|
@ -221,22 +221,22 @@ from which to start."
|
||||||
|
|
||||||
|
|
||||||
;;; Commands provided for completeness.
|
;;; Commands provided for completeness.
|
||||||
(defun character-fold-search-forward (string &optional bound noerror count)
|
(defun char-fold-search-forward (string &optional bound noerror count)
|
||||||
"Search forward for a character-folded version of STRING.
|
"Search forward for a char-folded version of STRING.
|
||||||
STRING is converted to a regexp with `character-fold-to-regexp',
|
STRING is converted to a regexp with `char-fold-to-regexp',
|
||||||
which is searched for with `re-search-forward'.
|
which is searched for with `re-search-forward'.
|
||||||
BOUND NOERROR COUNT are passed to `re-search-forward'."
|
BOUND NOERROR COUNT are passed to `re-search-forward'."
|
||||||
(interactive "sSearch: ")
|
(interactive "sSearch: ")
|
||||||
(re-search-forward (character-fold-to-regexp string) bound noerror count))
|
(re-search-forward (char-fold-to-regexp string) bound noerror count))
|
||||||
|
|
||||||
(defun character-fold-search-backward (string &optional bound noerror count)
|
(defun char-fold-search-backward (string &optional bound noerror count)
|
||||||
"Search backward for a character-folded version of STRING.
|
"Search backward for a char-folded version of STRING.
|
||||||
STRING is converted to a regexp with `character-fold-to-regexp',
|
STRING is converted to a regexp with `char-fold-to-regexp',
|
||||||
which is searched for with `re-search-backward'.
|
which is searched for with `re-search-backward'.
|
||||||
BOUND NOERROR COUNT are passed to `re-search-backward'."
|
BOUND NOERROR COUNT are passed to `re-search-backward'."
|
||||||
(interactive "sSearch: ")
|
(interactive "sSearch: ")
|
||||||
(re-search-backward (character-fold-to-regexp string) bound noerror count))
|
(re-search-backward (char-fold-to-regexp string) bound noerror count))
|
||||||
|
|
||||||
(provide 'character-fold)
|
(provide 'char-fold)
|
||||||
|
|
||||||
;;; character-fold.el ends here
|
;;; char-fold.el ends here
|
|
@ -222,7 +222,7 @@ It is nil if none yet.")
|
||||||
Default value, nil, means edit the string instead."
|
Default value, nil, means edit the string instead."
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
(autoload 'character-fold-to-regexp "character-fold")
|
(autoload 'char-fold-to-regexp "char-fold")
|
||||||
|
|
||||||
(defcustom search-default-mode nil
|
(defcustom search-default-mode nil
|
||||||
"Default mode to use when starting isearch.
|
"Default mode to use when starting isearch.
|
||||||
|
@ -236,7 +236,7 @@ isearch).
|
||||||
If a function, use that function as an `isearch-regexp-function'.
|
If a function, use that function as an `isearch-regexp-function'.
|
||||||
Example functions (and the keys to toggle them during isearch)
|
Example functions (and the keys to toggle them during isearch)
|
||||||
are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp'
|
are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp'
|
||||||
\(`\\[isearch-toggle-symbol]'), and `character-fold-to-regexp' \(`\\[isearch-toggle-character-fold]')."
|
\(`\\[isearch-toggle-symbol]'), and `char-fold-to-regexp' \(`\\[isearch-toggle-char-fold]')."
|
||||||
;; :type is set below by `isearch-define-mode-toggle'.
|
;; :type is set below by `isearch-define-mode-toggle'.
|
||||||
:type '(choice (const :tag "Literal search" nil)
|
:type '(choice (const :tag "Literal search" nil)
|
||||||
(const :tag "Regexp search" t)
|
(const :tag "Regexp search" t)
|
||||||
|
@ -718,7 +718,7 @@ Type \\[isearch-toggle-invisible] to toggle search in invisible text.
|
||||||
Type \\[isearch-toggle-regexp] to toggle regular-expression mode.
|
Type \\[isearch-toggle-regexp] to toggle regular-expression mode.
|
||||||
Type \\[isearch-toggle-word] to toggle word mode.
|
Type \\[isearch-toggle-word] to toggle word mode.
|
||||||
Type \\[isearch-toggle-symbol] to toggle symbol mode.
|
Type \\[isearch-toggle-symbol] to toggle symbol mode.
|
||||||
Type \\[isearch-toggle-character-fold] to toggle character folding.
|
Type \\[isearch-toggle-char-fold] to toggle character folding.
|
||||||
|
|
||||||
Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching.
|
Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching.
|
||||||
In incremental searches, a space or spaces normally matches any whitespace
|
In incremental searches, a space or spaces normally matches any whitespace
|
||||||
|
@ -1546,9 +1546,9 @@ The command then executes BODY and updates the isearch prompt."
|
||||||
Turning on word search turns off regexp mode.")
|
Turning on word search turns off regexp mode.")
|
||||||
(isearch-define-mode-toggle symbol "_" isearch-symbol-regexp "\
|
(isearch-define-mode-toggle symbol "_" isearch-symbol-regexp "\
|
||||||
Turning on symbol search turns off regexp mode.")
|
Turning on symbol search turns off regexp mode.")
|
||||||
(isearch-define-mode-toggle character-fold "'" character-fold-to-regexp "\
|
(isearch-define-mode-toggle char-fold "'" char-fold-to-regexp "\
|
||||||
Turning on character-folding turns off regexp mode.")
|
Turning on character-folding turns off regexp mode.")
|
||||||
(put 'character-fold-to-regexp 'isearch-message-prefix "char-fold ")
|
(put 'char-fold-to-regexp 'isearch-message-prefix "char-fold ")
|
||||||
|
|
||||||
(isearch-define-mode-toggle regexp "r" nil nil
|
(isearch-define-mode-toggle regexp "r" nil nil
|
||||||
(setq isearch-regexp (not isearch-regexp))
|
(setq isearch-regexp (not isearch-regexp))
|
||||||
|
|
|
@ -1257,7 +1257,7 @@ mail status in mode line"))
|
||||||
(defvar menu-bar-search-options-menu
|
(defvar menu-bar-search-options-menu
|
||||||
(let ((menu (make-sparse-keymap "Search Options")))
|
(let ((menu (make-sparse-keymap "Search Options")))
|
||||||
|
|
||||||
(dolist (x '((character-fold-to-regexp "Fold Characters" "Character folding")
|
(dolist (x '((char-fold-to-regexp "Fold Characters" "Character folding")
|
||||||
(isearch-symbol-regexp "Whole Symbols" "Whole symbol")
|
(isearch-symbol-regexp "Whole Symbols" "Whole symbol")
|
||||||
(word-search-regexp "Whole Words" "Whole word")))
|
(word-search-regexp "Whole Words" "Whole word")))
|
||||||
(bindings--define-key menu (vector (nth 0 x))
|
(bindings--define-key menu (vector (nth 0 x))
|
||||||
|
|
|
@ -33,7 +33,7 @@
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'matching)
|
:group 'matching)
|
||||||
|
|
||||||
(defcustom replace-character-fold nil
|
(defcustom replace-char-fold nil
|
||||||
"Non-nil means replacement commands should do character folding in matches.
|
"Non-nil means replacement commands should do character folding in matches.
|
||||||
This means, for instance, that \\=' will match a large variety of
|
This means, for instance, that \\=' will match a large variety of
|
||||||
unicode quotes.
|
unicode quotes.
|
||||||
|
@ -324,7 +324,7 @@ If `replace-lax-whitespace' is non-nil, a space or spaces in the string
|
||||||
to be replaced will match a sequence of whitespace chars defined by the
|
to be replaced will match a sequence of whitespace chars defined by the
|
||||||
regexp in `search-whitespace-regexp'.
|
regexp in `search-whitespace-regexp'.
|
||||||
|
|
||||||
If `replace-character-fold' is non-nil, matching uses character folding,
|
If `replace-char-fold' is non-nil, matching uses character folding,
|
||||||
i.e. it ignores diacritics and other differences between equivalent
|
i.e. it ignores diacritics and other differences between equivalent
|
||||||
character strings.
|
character strings.
|
||||||
|
|
||||||
|
@ -383,7 +383,7 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
|
||||||
to be replaced will match a sequence of whitespace chars defined by the
|
to be replaced will match a sequence of whitespace chars defined by the
|
||||||
regexp in `search-whitespace-regexp'.
|
regexp in `search-whitespace-regexp'.
|
||||||
|
|
||||||
This function is not affected by `replace-character-fold'.
|
This function is not affected by `replace-char-fold'.
|
||||||
|
|
||||||
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
|
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
|
||||||
only matches surrounded by word boundaries. A negative prefix arg means
|
only matches surrounded by word boundaries. A negative prefix arg means
|
||||||
|
@ -474,7 +474,7 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
|
||||||
to be replaced will match a sequence of whitespace chars defined by the
|
to be replaced will match a sequence of whitespace chars defined by the
|
||||||
regexp in `search-whitespace-regexp'.
|
regexp in `search-whitespace-regexp'.
|
||||||
|
|
||||||
This function is not affected by `replace-character-fold'.
|
This function is not affected by `replace-char-fold'.
|
||||||
|
|
||||||
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
|
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
|
||||||
only matches that are surrounded by word boundaries.
|
only matches that are surrounded by word boundaries.
|
||||||
|
@ -568,7 +568,7 @@ If `replace-lax-whitespace' is non-nil, a space or spaces in the string
|
||||||
to be replaced will match a sequence of whitespace chars defined by the
|
to be replaced will match a sequence of whitespace chars defined by the
|
||||||
regexp in `search-whitespace-regexp'.
|
regexp in `search-whitespace-regexp'.
|
||||||
|
|
||||||
If `replace-character-fold' is non-nil, matching uses character folding,
|
If `replace-char-fold' is non-nil, matching uses character folding,
|
||||||
i.e. it ignores diacritics and other differences between equivalent
|
i.e. it ignores diacritics and other differences between equivalent
|
||||||
character strings.
|
character strings.
|
||||||
|
|
||||||
|
@ -623,7 +623,7 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
|
||||||
to be replaced will match a sequence of whitespace chars defined by the
|
to be replaced will match a sequence of whitespace chars defined by the
|
||||||
regexp in `search-whitespace-regexp'.
|
regexp in `search-whitespace-regexp'.
|
||||||
|
|
||||||
This function is not affected by `replace-character-fold'
|
This function is not affected by `replace-char-fold'
|
||||||
|
|
||||||
In Transient Mark mode, if the mark is active, operate on the contents
|
In Transient Mark mode, if the mark is active, operate on the contents
|
||||||
of the region. Otherwise, operate from point to the end of the buffer's
|
of the region. Otherwise, operate from point to the end of the buffer's
|
||||||
|
@ -2051,9 +2051,9 @@ It is called with three arguments, as if it were
|
||||||
;; used after `recursive-edit' might override them.
|
;; used after `recursive-edit' might override them.
|
||||||
(let* ((isearch-regexp regexp-flag)
|
(let* ((isearch-regexp regexp-flag)
|
||||||
(isearch-regexp-function (or delimited-flag
|
(isearch-regexp-function (or delimited-flag
|
||||||
(and replace-character-fold
|
(and replace-char-fold
|
||||||
(not regexp-flag)
|
(not regexp-flag)
|
||||||
#'character-fold-to-regexp)))
|
#'char-fold-to-regexp)))
|
||||||
(isearch-lax-whitespace
|
(isearch-lax-whitespace
|
||||||
replace-lax-whitespace)
|
replace-lax-whitespace)
|
||||||
(isearch-regexp-lax-whitespace
|
(isearch-regexp-lax-whitespace
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
;;; character-fold-tests.el --- Tests for character-fold.el -*- lexical-binding: t; -*-
|
;;; char-fold-tests.el --- Tests for char-fold.el -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
|
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
@ -20,42 +20,42 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'ert)
|
(require 'ert)
|
||||||
(require 'character-fold)
|
(require 'char-fold)
|
||||||
|
|
||||||
(defun character-fold--random-word (n)
|
(defun char-fold--random-word (n)
|
||||||
(mapconcat (lambda (_) (string (+ 9 (random 117))))
|
(mapconcat (lambda (_) (string (+ 9 (random 117))))
|
||||||
(make-list n nil) ""))
|
(make-list n nil) ""))
|
||||||
|
|
||||||
(defun character-fold--test-search-with-contents (contents string)
|
(defun char-fold--test-search-with-contents (contents string)
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(insert contents)
|
(insert contents)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(should (search-forward-regexp (character-fold-to-regexp string) nil 'noerror))
|
(should (search-forward-regexp (char-fold-to-regexp string) nil 'noerror))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(should (character-fold-search-forward string nil 'noerror))
|
(should (char-fold-search-forward string nil 'noerror))
|
||||||
(should (character-fold-search-backward string nil 'noerror))))
|
(should (char-fold-search-backward string nil 'noerror))))
|
||||||
|
|
||||||
|
|
||||||
(ert-deftest character-fold--test-consistency ()
|
(ert-deftest char-fold--test-consistency ()
|
||||||
(dotimes (n 30)
|
(dotimes (n 30)
|
||||||
(let ((w (character-fold--random-word n)))
|
(let ((w (char-fold--random-word n)))
|
||||||
;; A folded string should always match the original string.
|
;; A folded string should always match the original string.
|
||||||
(character-fold--test-search-with-contents w w))))
|
(char-fold--test-search-with-contents w w))))
|
||||||
|
|
||||||
(ert-deftest character-fold--test-lax-whitespace ()
|
(ert-deftest char-fold--test-lax-whitespace ()
|
||||||
(dotimes (n 40)
|
(dotimes (n 40)
|
||||||
(let ((w1 (character-fold--random-word n))
|
(let ((w1 (char-fold--random-word n))
|
||||||
(w2 (character-fold--random-word n))
|
(w2 (char-fold--random-word n))
|
||||||
(search-spaces-regexp "\\s-+"))
|
(search-spaces-regexp "\\s-+"))
|
||||||
(character-fold--test-search-with-contents
|
(char-fold--test-search-with-contents
|
||||||
(concat w1 "\s\n\s\t\f\t\n\r\t" w2)
|
(concat w1 "\s\n\s\t\f\t\n\r\t" w2)
|
||||||
(concat w1 " " w2))
|
(concat w1 " " w2))
|
||||||
(character-fold--test-search-with-contents
|
(char-fold--test-search-with-contents
|
||||||
(concat w1 "\s\n\s\t\f\t\n\r\t" w2)
|
(concat w1 "\s\n\s\t\f\t\n\r\t" w2)
|
||||||
(concat w1 (make-string 10 ?\s) w2)))))
|
(concat w1 (make-string 10 ?\s) w2)))))
|
||||||
|
|
||||||
(defun character-fold--test-match-exactly (string &rest strings-to-match)
|
(defun char-fold--test-match-exactly (string &rest strings-to-match)
|
||||||
(let ((re (concat "\\`" (character-fold-to-regexp string) "\\'")))
|
(let ((re (concat "\\`" (char-fold-to-regexp string) "\\'")))
|
||||||
(dolist (it strings-to-match)
|
(dolist (it strings-to-match)
|
||||||
(should (string-match re it)))
|
(should (string-match re it)))
|
||||||
;; Case folding
|
;; Case folding
|
||||||
|
@ -64,49 +64,49 @@
|
||||||
(should (string-match (upcase re) (downcase it)))
|
(should (string-match (upcase re) (downcase it)))
|
||||||
(should (string-match (downcase re) (upcase it)))))))
|
(should (string-match (downcase re) (upcase it)))))))
|
||||||
|
|
||||||
(ert-deftest character-fold--test-some-defaults ()
|
(ert-deftest char-fold--test-some-defaults ()
|
||||||
(dolist (it '(("ffl" . "ffl") ("ffi" . "ffi")
|
(dolist (it '(("ffl" . "ffl") ("ffi" . "ffi")
|
||||||
("fi" . "fi") ("ff" . "ff")
|
("fi" . "fi") ("ff" . "ff")
|
||||||
("ä" . "ä")))
|
("ä" . "ä")))
|
||||||
(character-fold--test-search-with-contents (cdr it) (car it))
|
(char-fold--test-search-with-contents (cdr it) (car it))
|
||||||
(let ((multi (char-table-extra-slot character-fold-table 0))
|
(let ((multi (char-table-extra-slot char-fold-table 0))
|
||||||
(character-fold-table (make-char-table 'character-fold-table)))
|
(char-fold-table (make-char-table 'char-fold-table)))
|
||||||
(set-char-table-extra-slot character-fold-table 0 multi)
|
(set-char-table-extra-slot char-fold-table 0 multi)
|
||||||
(character-fold--test-match-exactly (car it) (cdr it)))))
|
(char-fold--test-match-exactly (car it) (cdr it)))))
|
||||||
|
|
||||||
(ert-deftest character-fold--test-fold-to-regexp ()
|
(ert-deftest char-fold--test-fold-to-regexp ()
|
||||||
(let ((character-fold-table (make-char-table 'character-fold-table))
|
(let ((char-fold-table (make-char-table 'char-fold-table))
|
||||||
(multi (make-char-table 'character-fold-table)))
|
(multi (make-char-table 'char-fold-table)))
|
||||||
(set-char-table-extra-slot character-fold-table 0 multi)
|
(set-char-table-extra-slot char-fold-table 0 multi)
|
||||||
(aset character-fold-table ?a "xx")
|
(aset char-fold-table ?a "xx")
|
||||||
(aset character-fold-table ?1 "44")
|
(aset char-fold-table ?1 "44")
|
||||||
(aset character-fold-table ?\s "-!-")
|
(aset char-fold-table ?\s "-!-")
|
||||||
(character-fold--test-match-exactly "a1a1" "xx44xx44")
|
(char-fold--test-match-exactly "a1a1" "xx44xx44")
|
||||||
(character-fold--test-match-exactly "a1 a 1" "xx44-!--!-xx-!-44")
|
(char-fold--test-match-exactly "a1 a 1" "xx44-!--!-xx-!-44")
|
||||||
(aset multi ?a '(("1" . "99")
|
(aset multi ?a '(("1" . "99")
|
||||||
("2" . "88")
|
("2" . "88")
|
||||||
("12" . "77")))
|
("12" . "77")))
|
||||||
(character-fold--test-match-exactly "a" "xx")
|
(char-fold--test-match-exactly "a" "xx")
|
||||||
(character-fold--test-match-exactly "a1" "xx44" "99")
|
(char-fold--test-match-exactly "a1" "xx44" "99")
|
||||||
(character-fold--test-match-exactly "a12" "77" "xx442" "992")
|
(char-fold--test-match-exactly "a12" "77" "xx442" "992")
|
||||||
(character-fold--test-match-exactly "a2" "88")
|
(char-fold--test-match-exactly "a2" "88")
|
||||||
(aset multi ?1 '(("2" . "yy")))
|
(aset multi ?1 '(("2" . "yy")))
|
||||||
(character-fold--test-match-exactly "a1" "xx44" "99")
|
(char-fold--test-match-exactly "a1" "xx44" "99")
|
||||||
(character-fold--test-match-exactly "a12" "77" "xx442" "992")
|
(char-fold--test-match-exactly "a12" "77" "xx442" "992")
|
||||||
;; Support for this case is disabled. See function definition or:
|
;; Support for this case is disabled. See function definition or:
|
||||||
;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html
|
;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html
|
||||||
;; (character-fold--test-match-exactly "a12" "xxyy")
|
;; (char-fold--test-match-exactly "a12" "xxyy")
|
||||||
))
|
))
|
||||||
|
|
||||||
(ert-deftest character-fold--speed-test ()
|
(ert-deftest char-fold--speed-test ()
|
||||||
(dolist (string (append '("tty-set-up-initial-frame-face"
|
(dolist (string (append '("tty-set-up-initial-frame-face"
|
||||||
"tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face")
|
"tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face")
|
||||||
(mapcar #'character-fold--random-word '(10 50 100
|
(mapcar #'char-fold--random-word '(10 50 100
|
||||||
50 100))))
|
50 100))))
|
||||||
(message "Testing %s" string)
|
(message "Testing %s" string)
|
||||||
;; Make sure we didn't just fallback on the trivial search.
|
;; Make sure we didn't just fallback on the trivial search.
|
||||||
(should-not (string= (regexp-quote string)
|
(should-not (string= (regexp-quote string)
|
||||||
(character-fold-to-regexp string)))
|
(char-fold-to-regexp string)))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(save-excursion (insert string))
|
(save-excursion (insert string))
|
||||||
(let ((time (time-to-seconds (current-time))))
|
(let ((time (time-to-seconds (current-time))))
|
||||||
|
@ -114,11 +114,11 @@
|
||||||
;; created a lot of redundant paths in the regexp. Because of
|
;; created a lot of redundant paths in the regexp. Because of
|
||||||
;; that, if a really long string "almost" matches, the regexp
|
;; that, if a really long string "almost" matches, the regexp
|
||||||
;; engine took a long time to realize that it doesn't match.
|
;; engine took a long time to realize that it doesn't match.
|
||||||
(should-not (character-fold-search-forward (concat string "c") nil 'noerror))
|
(should-not (char-fold-search-forward (concat string "c") nil 'noerror))
|
||||||
;; Ensure it took less than a second.
|
;; Ensure it took less than a second.
|
||||||
(should (< (- (time-to-seconds (current-time))
|
(should (< (- (time-to-seconds (current-time))
|
||||||
time)
|
time)
|
||||||
1))))))
|
1))))))
|
||||||
|
|
||||||
(provide 'character-fold-tests)
|
(provide 'char-fold-tests)
|
||||||
;;; character-fold-tests.el ends here
|
;;; char-fold-tests.el ends here
|
Loading…
Add table
Add a link
Reference in a new issue