RE: char equivalence classes in search - why not symmetric?

[Drew Adams <drew.adams@oracle.com>]

[-- Attachment #1: Type: text/plain, Size: 1324 bytes --]

> AFAICT, this (or similar) is the only code needed.

Sorry, I spoke too soon.

1. The following two lines are needed, before evaluating the code
I sent earlier.  (I've attached an update that includes them, so
you can just load/evaluate it.)

 (setq character-fold-search t)
 (load-library "character-fold")

This is due to the way the vanilla code is at the moment.  This also
means that for this testing char folding will be on, to start with.

2. The code I have is not sufficient for everything.  You can
use it to see what the behavior is for single-char entries in the
char table, which includes accented chars (chars with diacritics).
But it does not also handle multiple-char entries in the table.

For instance, you can search for "é" and get char folding, but you
cannot search for "é" and get char folding.  The first of these is
just the char named LATIN SMALL LETTER E WITH ACUTE.  The second is
plain "e" composed with "́" (the char named COMBINING ACUTE ACCENT).

Some more work would be needed to make such combinations work too.
As I said, I'm no expert on char tables.  But the attached code
should give you a good idea of what is involved.

At the end of the file I included some commented-out e chars to
search for.  (Use `C-u C-x =' on a char to see what it really is.)

[-- Attachment #2: symmetric-char-fold.el --]
[-- Type: application/octet-stream, Size: 5807 bytes --]

(setq character-fold-search t)
(load-library "character-fold")

(defun update-char-fold-table ()
  "Update the value of variable `character-fold-table'.
The new value reflects the current value of `char-fold-symmetric'."
  (setq character-fold-table
        (let* ((equiv (make-char-table 'character-fold-table))
               (table (unicode-property-table-internal 'decomposition))
               (func (char-table-extra-slot table 1)))
          ;; Ensure the table is populated.
          (map-char-table
           (lambda (i v) (when (consp i) (funcall func (car i) v table)))
           table)
          ;; Compile a list of all complex chars that each simple char should match.
          (map-char-table
           (lambda (i dec)
             (when (consp dec)
               ;; Discard a possible formatting tag.
               (when (symbolp (car dec))
                 (setq dec (cdr dec)))
               ;; Skip trivial cases like ?a decomposing to (?a).
               (unless (or (and (eq i (car dec))  (not  (cdr dec))))
                 (let ((d dec)
                       (fold-decomp t)
                       k found)
                   (while (and d (not found))
                     (setq k (pop d))
                     ;; Is k a number or letter, per unicode standard?
                     (setq found (memq (get-char-code-property k 'general-category)
                                       '(Lu Ll Lt Lm Lo Nd Nl No))))
                   (if found
                       ;; Check if the decomposition has more than one letter,
                       ;; because then we don't want the first letter to match
                       ;; the decomposition.
                       (dolist (k d)
                         (when (and fold-decomp
                                    (memq (get-char-code-property k 'general-category)
                                          '(Lu Ll Lt Lm Lo Nd Nl No)))
                           (setq fold-decomp nil)))
                     ;; If there's no number or letter on the
                     ;; decomposition, take the first character in it.
                     (setq found (car-safe dec)))
                   ;; Finally, we only fold multi-char decomposition if at
                   ;; least one of the chars is non-spacing (combining).
                   (when fold-decomp
                     (setq fold-decomp nil)
                     (dolist (k dec)
                       (when (and (not fold-decomp)
                                  (> (get-char-code-property k 'canonical-combining-class) 0))
                         (setq fold-decomp t))))
                   ;; Add i to the list of characters that k can
                   ;; represent. Also possibly add its decomposition, so we can
                   ;; match multi-char representations like (format "a%c" 769)
                   (when (and found (not (eq i k)))
                     (let ((chars (cons (char-to-string i) (aref equiv k))))
                       (aset equiv k (if fold-decomp
                                         (cons (apply #'string dec) chars)
                                       chars))))))))
           table)
          ;; Add some manual entries.
          (dolist (it '((?\" "＂" "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝"
                         "❠" "“" "„" "〝" "〟" "🙷" "🙶" "🙸" "«" "»")
                        (?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "󠀢" "❮" "❯" "‹" "›")
                        (?` "❛" "‘" "‛" "󠀢" "❮" "‹")))
            (let ((idx (car it))
                  (chars (cdr it)))
              (aset equiv idx (append chars (aref equiv idx)))))

          ;; --------8<------the only addition----------------
          (when char-fold-symmetric
            ;; Add an entry for each equivalent char.
            (let ((others  ()))
              (map-char-table
               (lambda (base v)
                 (let ((chrs  (aref equiv base)))
                   (when (consp chrs)
                     (dolist (chr  (cdr chrs))
                       (push (cons (string-to-char chr) (remove chr chrs)) others)))))
               equiv)
              (dolist (it  others)
                (let ((base   (car it))
                      (chars  (cdr it)))
                  (aset equiv base (append chars (aref equiv base)))))))
          ;; --------8<---------------------------------------

          ;; Convert the lists of characters we compiled into regexps.
          (map-char-table
           (lambda (i v) (let ((re (regexp-opt (cons (char-to-string i) v))))
                      (if (consp i)
                          (set-char-table-range equiv i re)
                        (aset equiv i re))))
           equiv)
          equiv)))

(defcustom char-fold-symmetric t
  "Non-nil means char-fold searching treats equivalent chars the same.
That is, use of any of a set of char-fold equivalent chars in a search
string finds any of them in the text being searched.

If nil then only the \"base\" or \"canonical\" char of the set matches
any of them.  The others match only themselves, even when char-folding
is turned on."
  :set (lambda (sym defs)
         (custom-set-default sym defs)
         (update-char-fold-table))
  :type 'boolean :group 'isearch)

;; ("𝚎" "𝙚" "𝘦" "𝗲" "𝖾" "𝖊" "𝕖" "𝔢" "𝓮" "𝒆" "𝑒" "𝐞" "ｅ" "㋎" "㋍" "ⓔ" "⒠"
;;  "ⅇ" "ℯ" "ₑ" "ẽ" "ẽ" "ẻ" "ẻ" "ẹ" "ẹ" "ḛ" "ḛ" "ḙ" "ḙ" "ᵉ" "ȩ" "ȩ" "ȇ" "ȇ"
;; "ȅ" "ȅ" "ě" "ě" "ę" "ę" "ė" "ė" "ĕ" "ĕ" "ē" "ē" "ë" "ë" "ê" "ê" "é" "é" "è" "è")

;; No good yet: "𝚎" "ẽ" "ẻ" "ẹ" "ḛ" "ḙ" "ȩ" "ȇ" "ȅ"
;;              "ě" "ę" "ė" "ĕ" "ē" "ë" "ê" "é" "è"