procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Limit casemapping to appropriate ranges in ERC

Browse source 
* 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.)
This commit is contained in:
F. Jason Park 2022-12-11 19:41:43 -08:00
parent 44b04c0ac1
commit 09c0c6b2ba
3 changed files with 28 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
lisp/erc/erc-common.el
View 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."

28
lisp/erc/erc.el
View 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.

3
test/lisp/erc/erc-tests.el
View file

@ -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/" )))))