From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 5 Oct 2021 19:03:56 -0700
Subject: [PATCH 05/28] Recognize ascii and strict CASEMAPPINGs in ERC

* lisp/erc/erc.el (erc-downcase, erc--casemapping-rfc1459-strict,
erc--casemapping-rfc1459): Add new translation tables for these two
mappings and use them.

* test/lisp/erc/erc-tests.el: Add test for `erc-downcase'.
---
 lisp/erc/erc.el            | 36 +++++++++++++++++++++++++-----------
 test/lisp/erc/erc-tests.el | 22 ++++++++++++++++++++++
 2 files changed, 47 insertions(+), 11 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index c4392211c5..475f7ba633 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -352,18 +352,32 @@ erc-server-users
   "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")))
+
 (defun erc-downcase (string)
-  "Convert STRING to IRC standard conforming downcase."
-  (let ((s (downcase string))
-        (c '((?\[ . ?\{)
-             (?\] . ?\})
-             (?\\ . ?\|)
-             (?~  . ?^))))
-    (save-match-data
-      (while (string-match "[]\\[~]" s)
-        (aset s (match-beginning 0)
-              (cdr (assq (aref s (match-beginning 0)) c)))))
-    s))
+  "Return a downcased copy of STRING with properties.
+Use the CASEMAPPING ISUPPORT parameter to determine the style."
+  (let* ((params (or erc-isupport-parameters
+                     (erc-with-server-buffer erc-isupport-parameters)))
+         (mapping (cadr (assq 'CASEMAPPING params)))
+         (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)))))
 
 (defmacro erc-with-server-buffer (&rest body)
   "Execute BODY in the current ERC server buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4173e6df20..160688c1cf 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -195,6 +195,28 @@ erc-server-005
         (should (= hooked 2)))))
   (should-not (cadr erc-server-005-functions)))
 
+(ert-deftest erc-downcase ()
+  (let ((erc-isupport-parameters '((PREFIX "(ov)@+") (BOT "B"))))
+
+    (ert-info ("ascii")
+      (setf (alist-get 'CASEMAPPING erc-isupport-parameters) '("ascii"))
+      (should (equal (erc-downcase "Bob[m]`") "bob[m]`"))
+      (should (equal (erc-downcase "Tilde~") "tilde~" ))
+      (should (equal (erc-downcase "\\O/") "\\o/" )))
+
+    (ert-info ("rfc1459")
+      (setf (car (alist-get 'CASEMAPPING erc-isupport-parameters)) "rfc1459")
+      (should (equal (erc-downcase "Bob[m]`") "bob{m}`" ))
+      (should (equal (erc-downcase "Tilde~") "tilde^" ))
+      (should (equal (erc-downcase "\\O/") "|o/" )))
+
+    (ert-info ("rfc1459-strict")
+      (setf (car (alist-get 'CASEMAPPING erc-isupport-parameters))
+            "rfc1459-strict")
+      (should (equal (erc-downcase "Bob[m]`") "bob{m}`"))
+      (should (equal (erc-downcase "Tilde~") "tilde~" ))
+      (should (equal (erc-downcase "\\O/") "|o/" )))))
+
 (ert-deftest erc-ring-previous-command-base-case ()
   (ert-info ("Create ring when nonexistent and do nothing")
     (let (erc-input-ring
-- 
2.31.1