[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
emacs-29 09c0c6b2ba 5/7: Limit casemapping to appropriate ranges in ERC
From: |
F. Jason Park |
Subject: |
emacs-29 09c0c6b2ba 5/7: Limit casemapping to appropriate ranges in ERC |
Date: |
Wed, 14 Dec 2022 09:44:40 -0500 (EST) |
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/" )))))
- emacs-29 updated (2d96a18cd0 -> 102a3e3b44), F. Jason Park, 2022/12/14
- emacs-29 f0c9088878 6/7: Set erc-network to a "given" ID instead of failing, F. Jason Park, 2022/12/14
- emacs-29 0155fc67be 2/7: Respect a nil erc-session-password when reconnecting, F. Jason Park, 2022/12/14
- emacs-29 9ac80e8a6e 1/7: Add dedicated auth-source section in ERC manual, F. Jason Park, 2022/12/14
- emacs-29 44b04c0ac1 4/7: Actually accept non-symbols as IDs in erc-open, F. Jason Park, 2022/12/14
- emacs-29 75f26646d4 3/7: ; Be nicer when updating browse-url var in erc-compat, F. Jason Park, 2022/12/14
- emacs-29 102a3e3b44 7/7: Don't send erc-sasl-user as USER command argument, F. Jason Park, 2022/12/14
- emacs-29 09c0c6b2ba 5/7: Limit casemapping to appropriate ranges in ERC,
F. Jason Park <=