]> git.eshelyaron.com Git - emacs.git/commitdiff
Limit casemapping to appropriate ranges in ERC
authorF. Jason Park <jp@neverwas.me>
Mon, 12 Dec 2022 03:41:43 +0000 (19:41 -0800)
committerF. Jason Park <jp@neverwas.me>
Wed, 14 Dec 2022 14:40:55 +0000 (06:40 -0800)
* 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
lisp/erc/erc.el
test/lisp/erc/erc-tests.el

index a4046ba9b393c42b5e46806b014b332da4f63585..e662c06daa483ad223f8e2863df38224da6153c3 100644 (file)
@@ -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."
index 9d811617d2e53ede8a20650389d74febefa7665e..5e78096da5672ae9bb9a713648c33ccf9e68aa4b 100644 (file)
@@ -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.
index 4d0d69cd7b61042406838c52885ccb4c364c0b91..51c562f5255cbde02274ab583a347345c991dddd 100644 (file)
 
     (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/" )))))