emacs-29 09c0c6b2ba 5/7: Limit casemapping to appropriate ranges in ERC

[F. Jason Park]

branch: emacs-29
commit 09c0c6b2ba36c6b87e8e495710a580e909bbaf26
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Limit casemapping to appropriate ranges in ERC
    
    * lisp/erc/erc-common.el (erc-downcase): Use case table for
    `erc-downcase' so that case conversions are limited to the ASCII
    interval.
    * lisp/erc/erc.el (erc-casemapping--rfc1459-strict,
    erc--casemapping-rfc1459): Make these case tables instead of
    translation tables.  The functions in case-table.el modify the
    standard syntax table, but that doesn't seem to make sense here,
    right?
    * test/lisp/erc/erc-tests.el (erc-downcase): Add cases showing
    mappings outside of the ASCII range.  (Bug#59976.)
---
 lisp/erc/erc-common.el     | 16 +++++-----------
 lisp/erc/erc.el            | 28 ++++++++++++++++++++--------
 test/lisp/erc/erc-tests.el |  3 +++
 3 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index a4046ba9b3..e662c06daa 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -301,17 +301,11 @@ nil."
 (defun erc-downcase (string)
   "Return a downcased copy of STRING with properties.
 Use the CASEMAPPING ISUPPORT parameter to determine the style."
-  (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single))
-         (inhibit-read-only t))
-    (if (equal mapping "ascii")
-        (downcase string)
-      (with-temp-buffer
-        (insert string)
-        (translate-region (point-min) (point-max)
-                          (if (equal mapping "rfc1459-strict")
-                              erc--casemapping-rfc1459-strict
-                            erc--casemapping-rfc1459))
-        (buffer-string)))))
+  (with-case-table (pcase (erc--get-isupport-entry 'CASEMAPPING 'single)
+                     ("ascii" ascii-case-table)
+                     ("rfc1459-strict" erc--casemapping-rfc1459-strict)
+                     (_ erc--casemapping-rfc1459))
+    (downcase string)))
 
 (define-inline erc-get-channel-user (nick)
   "Find NICK in the current buffer's `erc-channel-users' hash table."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 9d811617d2..5e78096da5 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -407,15 +407,27 @@ erc-channel-user struct.")
   "Hash table of users on the current server.
 It associates nicknames with `erc-server-user' struct instances.")
 
-(defconst erc--casemapping-rfc1459
-  (make-translation-table
-   '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|) (?~  . ?^))
-   (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
-
 (defconst erc--casemapping-rfc1459-strict
-  (make-translation-table
-   '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|))
-   (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
+  (let ((tbl (copy-sequence ascii-case-table))
+        (cup (copy-sequence (char-table-extra-slot ascii-case-table 0))))
+    (set-char-table-extra-slot tbl 0 cup)
+    (set-char-table-extra-slot tbl 1 nil)
+    (set-char-table-extra-slot tbl 2 nil)
+    (pcase-dolist (`(,uc . ,lc) '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|)))
+      (aset tbl uc lc)
+      (aset tbl lc lc)
+      (aset cup uc uc))
+    tbl))
+
+(defconst erc--casemapping-rfc1459
+  (let ((tbl (copy-sequence erc--casemapping-rfc1459-strict))
+        (cup (copy-sequence (char-table-extra-slot
+                             erc--casemapping-rfc1459-strict 0))))
+    (set-char-table-extra-slot tbl 0 cup)
+    (aset tbl ?~ ?^)
+    (aset tbl ?^ ?^)
+    (aset cup ?~ ?~)
+    tbl))
 
 (defun erc-add-server-user (nick user)
   "This function is for internal use only.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4d0d69cd7b..51c562f525 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -428,18 +428,21 @@
 
     (ert-info ("ascii")
       (puthash 'CASEMAPPING  '("ascii") erc--isupport-params)
+      (should (equal (erc-downcase "ABC 123 ΔΞΩΣ") "abc 123 ΔΞΩΣ"))
       (should (equal (erc-downcase "Bob[m]`") "bob[m]`"))
       (should (equal (erc-downcase "Tilde~") "tilde~" ))
       (should (equal (erc-downcase "\\O/") "\\o/" )))
 
     (ert-info ("rfc1459")
       (puthash 'CASEMAPPING  '("rfc1459") erc--isupport-params)
+      (should (equal (erc-downcase "ABC 123 ΔΞΩΣ") "abc 123 ΔΞΩΣ"))
       (should (equal (erc-downcase "Bob[m]`") "bob{m}`" ))
       (should (equal (erc-downcase "Tilde~") "tilde^" ))
       (should (equal (erc-downcase "\\O/") "|o/" )))
 
     (ert-info ("rfc1459-strict")
       (puthash 'CASEMAPPING  '("rfc1459-strict") erc--isupport-params)
+      (should (equal (erc-downcase "ABC 123 ΔΞΩΣ") "abc 123 ΔΞΩΣ"))
       (should (equal (erc-downcase "Bob[m]`") "bob{m}`"))
       (should (equal (erc-downcase "Tilde~") "tilde~" ))
       (should (equal (erc-downcase "\\O/") "|o/" )))))