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

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

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

>  > I've approached this question only from a user point of
>  > view (it is useful to be able to do it).
> 
> Well, since I'm not going to do it any time soon, and you
> haven't even considered doing it yet, this thread is moot.

AFAICT, this (or similar) is the only code needed.  It fixes
the char-table entries for the equivalent chars, so each points
to the equivalence class and not just to itself.  (Currently,
only the "base" char points to the equivalence class.)

;; 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)))))))

This code fragment is included in the attached code that updates
`character-fold-table'.  Evaluate the attached code, to try the
behavior proposed in this thread.

The attached code provides:

* A Boolean option, `char-fold-symmetric', so you can choose which
  behavior you want.  (Let users decide, instead of "flipping a
  coin" at design time.)

  If you use Customize (or the equivalent) to change the option
  value then `character-fold-table' is automatically updated to
  reflect the new option value.

* A function that updates `character-fold-table' to reflect the
  option value.  It evaluates the above code conditionally.

Just as now, you can use M-s ' to toggle char folding.  With the
option value non-nil you get the behavior proposed in this thread.
With the option value nil you get the current, more limited behavior.

[I'm no expert on char tables.  Perhaps the code could be improved.
But this seems to work OK.  I think it exhibits the proposed behavior.]

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

;; Load this file, to evaluate these two definitions in order.
;;
;; The second is an option that lets you choose the proposed behavior
;; or the current Emacs behavior, for character folding.  The first is
;; a function that redefines the char-table used for character folding
;; (`character-fold-table'), so that it reflects the option value.
;;
;; When the option is non-nil, `character-fold-table' includes
;; equivalence entries for each member of a char-folding class (an
;; equivalence class wrt search).  When the option is nil,
;; `character-fold-table' includes equivalence entries only for the
;; "base" character of each class.
;;
;; Use M-' to toggle char folding, as usual.

(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)