+
+If the resulting regexp would be too long for Emacs to handle,
+just return the result of calling `regexp-quote' on STRING.
+
+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))
+ ;; 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
+ ;; these regexp constructs, so we need to use "\\( \\|[ ...]\\)"
+ ;; instead (to manually expose a space). Furthermore, the lax
+ ;; search engine acts on a bunch of spaces, not on individual
+ ;; spaces, so if the string contains sequential spaces like " ", we
+ ;; need to keep them grouped together like this: "\\( \\|[ ...][ ...]\\)".
+ (while (< i end)
+ (pcase (aref string i)
+ (`?\s (setq spaces (1+ spaces)))
+ (c (when (> spaces 0)
+ (push (character-fold--make-space-string spaces) out)
+ (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 50)
+ (aref multi-char-table c))))
+ (push (let ((matched-entries nil)
+ (max-length 0))
+ (dolist (entry alist)
+ (let* ((suffix (car entry))
+ (len-suf (length suffix)))
+ (when (eq (compare-strings suffix 0 nil
+ string (1+ i) (+ i 1 len-suf)
+ nil)
+ t)
+ (push (cons len-suf (cdr entry)) matched-entries)
+ (setq max-length (max max-length len-suf)))))
+ ;; If no suffixes matched, just go on.
+ (if (not matched-entries)
+ regexp
+;;; If N suffixes match, we "branch" out into N+1 executions for the
+;;; length of the longest match. This means "fix" will match "fix" but
+;;; not "fⅸ", but it's necessary to keep the regexp size from scaling
+;;; exponentially. See https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html
+ (let ((subs (substring string (1+ i) (+ i 1 max-length))))
+ ;; `i' is still going to inc by 1 below.
+ (setq i (+ i max-length))
+ (concat
+ "\\(?:"
+ (mapconcat (lambda (entry)
+ (let ((length (car entry))
+ (suffix-regexp (cdr entry)))
+ (concat suffix-regexp
+ (character-fold-to-regexp subs nil length))))
+ `((0 . ,regexp) . ,matched-entries) "\\|")
+ "\\)"))))
+ out))))
+ (setq i (1+ i)))
+ (when (> spaces 0)
+ (push (character-fold--make-space-string spaces) out))
+ (let ((regexp (apply #'concat (nreverse out))))
+ ;; Limited by `MAX_BUF_SIZE' in `regex.c'.
+ (if (> (length regexp) 5000)
+ (regexp-quote string)
+ regexp))))
+
+\f
+;;; Commands provided for completeness.
+(defun character-fold-search-forward (string &optional bound noerror count)
+ "Search forward for a character-folded version of STRING.
+STRING is converted to a regexp with `character-fold-to-regexp',
+which is searched for with `re-search-forward'.
+BOUND NOERROR COUNT are passed to `re-search-forward'."
+ (interactive "sSearch: ")
+ (re-search-forward (character-fold-to-regexp string) bound noerror count))
+
+(defun character-fold-search-backward (string &optional bound noerror count)
+ "Search backward for a character-folded version of STRING.
+STRING is converted to a regexp with `character-fold-to-regexp',
+which is searched for with `re-search-backward'.
+BOUND NOERROR COUNT are passed to `re-search-backward'."
+ (interactive "sSearch: ")
+ (re-search-backward (character-fold-to-regexp string) bound noerror count))
+
+(provide 'character-fold)