Subject: bug#22147: Obsolete search-forward-lax-whitespace

From: Juri Linkov <[email-masked]>
Date: Wed, 18 May 2016 22:34:05 +0300

> I'm of the opinion that we should avoid over thinking this feature for the
> first release. And I'm also of the opinion that complicated custom-vars
> (like alists of alists) are less helpful than simple custom vars. So I'd
> strongly prefer if we don't turn this variable into something more
> complicated.

I agree that we are better off starting with simpler customization,
and then gradually adding more layers later when needed.

I wonder why you removed defvar mappings from your initial patches
with ‘isearch-groups-alist’ and ‘isearch--character-fold-extras’
(a similar variable is also presented in Drew's ‘char-fold-ad-hoc’).

Now I tried to reintroduce these lists with different names:
‘char-fold-include-alist’ with a list to add to default mappings and
‘char-fold-exclude-alist’ with a list to remove from default mappings
taking into account all opinions expressed on emacs-devel for the
default values:

diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 68bea29..68d1eb0 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -22,10 +22,68 @@
 
 ;;; Code:
 
-(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1))
+(put 'char-fold-table 'char-table-extra-slots 1)
 
-(defconst char-fold-table
-  (eval-when-compile
+(defcustom char-fold-include-alist
+  (append
+   '((?\" "＂" "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“" "„" "〝" "〟" "🙷" "🙶" "🙸" "«" "»")
+     (?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "󠀢" "❮" "❯" "‹" "›")
+     (?` "❛" "‘" "‛" "󠀢" "❮" "‹")
+     (?→ "->") (?⇒ "=>")
+     (?1 "⒈") (?2 "⒉") (?3 "⒊") (?4 "⒋") (?5 "⒌") (?6 "⒍") (?7 "⒎") (?8 "⒏") (?9 "⒐") (?0 "🄀")
+     )
+   (unless (string-match-p "^\\(?:da\\|n[obn]\\)" (getenv "LANG"))
+     '((?o "ø")
+       (?O "Ø")))
+   (unless (string-match-p "^pl" (getenv "LANG"))
+     '((?l "ł")
+       (?L "Ł")))
+   (unless (string-match-p "^de" (getenv "LANG"))
+     '((?ß "ss")))
+   )
+  "Ad hoc character foldings.
+Each entry is a list of a character and the strings that fold into it."
+  :set (lambda (symbol value)
+         (custom-set-default symbol value)
+         (with-no-warnings
+           (setq char-fold-table (make-char-fold-table))))
+  :initialize 'custom-initialize-default
+  :type '(repeat (cons
+                  (character :tag "Fold to character")
+                  (repeat (string :tag "Fold from string"))))
+  :version "25.1"
+  :group 'isearch)
+
+(defcustom char-fold-exclude-alist
+  (append
+   (when (string-match-p "^es" (getenv "LANG"))
+     '((?n "ñ")
+       (?N "Ñ")))
+   (when (string-match-p "^\\(?:sv\\|fi\\|et\\)" (getenv "LANG"))
+     '((?a "ä")
+       (?A "Ä")
+       (?o "ö")
+       (?O "Ö")))
+   (when (string-match-p "^\\(?:sv\\|da\\|n[obn]\\)" (getenv "LANG"))
+     '((?a "å")
+       (?A "Å")))
+   (when (string-match-p "^ru" (getenv "LANG"))
+     '((?и "й")
+       (?И "Й"))))
+  "Character foldings to remove from default mappings.
+Each entry is a list of a character and the strings that unfold from it."
+  :set (lambda (symbol value)
+         (custom-set-default symbol value)
+         (with-no-warnings
+           (setq char-fold-table (make-char-fold-table))))
+  :initialize 'custom-initialize-default
+  :type '(repeat (cons
+                  (character :tag "Unfold to character")
+                  (repeat (string :tag "Unfold from string"))))
+  :version "25.1"
+  :group 'isearch)
+
+(defun make-char-fold-table ()
     (let ((equiv (make-char-table 'char-fold-table))
           (equiv-multi (make-char-table 'char-fold-table))
           (table (unicode-property-table-internal 'decomposition)))
@@ -58,9 +116,11 @@ char-fold-table
                ;; If there's no formatting tag, ensure that char matches
                ;; its decomp exactly.  This is because we want 'ä' to
                ;; match 'ä', but we don't want '¹' to match '1'.
+             (unless (and (assq char char-fold-exclude-alist)
+                          (member (apply #'string decomp) (assq char char-fold-exclude-alist)))
                (aset equiv char
                      (cons (apply #'string decomp)
-                           (aref equiv char))))
+                           (aref equiv char)))))
 
              ;; Allow the entire decomp to match char.  If decomp has
              ;; multiple characters, this is done by adding an entry
@@ -74,9 +134,11 @@ char-fold-table
                                 (cons (cons (apply #'string (cdr decomp))
                                             (regexp-quote (string char)))
                                       (aref equiv-multi (car decomp))))
+                      (unless (and (assq (car decomp) char-fold-exclude-alist)
+                                   (member (char-to-string char) (assq (car decomp) char-fold-exclude-alist)))
                         (aset equiv (car decomp)
                               (cons (char-to-string char)
-                                    (aref equiv (car decomp))))))))
+                                    (aref equiv (car decomp)))))))))
                (funcall make-decomp-match-char decomp char)
                ;; Do it again, without the non-spacing characters.
                ;; This allows 'a' to match 'ä'.
@@ -98,9 +160,7 @@ char-fold-table
        table)
 
       ;; Add some manual entries.
-      (dolist (it '((?\" "＂" "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“" "„" "〝" "〟" "🙷" "🙶" "🙸" "«" "»")
-                    (?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "󠀢" "❮" "❯" "‹" "›")
-                    (?` "❛" "‘" "‛" "󠀢" "❮" "‹")))
+    (dolist (it char-fold-include-alist)
         (let ((idx (car it))
               (chars (cdr it)))
           (aset equiv idx (append chars (aref equiv idx)))))
@@ -114,6 +174,9 @@ char-fold-table
              (aset equiv char re))))
        equiv)
       equiv))
+
+(defvar char-fold-table
+  (make-char-fold-table)
   "Used for folding characters of the same group during search.
 This is a char-table with the `char-fold-table' subtype.