mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2026-09-10 07:46:51 -04:00
Favor ISUPPORT params for MODE processing in ERC
* etc/ERC-NEWS: Mention shift toward CHANMODES ISUPPORT parameter for dictating MODE parsing behavior. * lisp/erc/erc-backend.el (erc--init-channel-modes, erc--update-modes, erc-set-modes, erc-update-modes): Forward declarations, the last two being removals. (erc-server-MODE, erc-server-221): Use `erc--update-modes' instead of `erc-update-modes'. (erc-server-324): Use `erc--init-channel-modes' instead of `erc-set-modes'. * lisp/erc/erc-common.el (erc--channel-mode-types): New struct for stashing processed \"CHANMODES\" data for the current server. * lisp/erc/erc.el (erc-channel-modes): Fix doc string. (erc-set-initial-user-mode): Display a local notice when requesting redundant user MODE operations. (erc-set-modes, erc-parse-modes, erc-update-modes): Deprecate for reasons explained in associated ERC-NEWS entry. (erc--update-membership-prefix): New function, a helper for specifying arguments to the rather unruly `erc-update-current-channel-member'. (erc--channel-modes): New variable to record channel-mode state in a hash table. (erc--channel-mode-types): New variable and getter to stash and retrieve server-local instance of the struct of the same name. (erc--process-channel-modes): New function to parse channel-mode changes, dispatch handlers for unary modes, and update the local variables `erc-channel-modes' and `erc--channel-modes'. (erc--user-modes): New local variable for remembering user modes per server. New function of the same name, a "getter" for the variable. (erc--parse-user-modes): New function to parse user modes only. (erc--update-user-modes): New function to update and sort `erc--user-modes'. (erc--update-channel-modes): New function to replace much of `erc-update-modes', currently a thin wrapper around `erc--process-channel-modes' to ensure it updates status prefixes. (erc--update-modes): New function to call appropriate mode-updating function for the current buffer. (erc--init-channel-modes): New function to update channel mode letters without status prefixes. (erc--handle-channel-mode): New generic function, a placeholder for an eventual API to handle specific "unary" mode letters, meaning those that specify a single parameter for setting or unsetting. (erc-update-channel-limit): Update doc string and answer question posed by ancient comment. (erc-message-english-user-mode-redundant-add, erc-message-english-user-mode-redundant-drop): New English catalog messages. * test/lisp/erc/erc-scenarios-base-chan-modes.el: New file. * test/lisp/erc/erc-tests.el (erc-parse-modes, erc--update-channel-modes, erc--update-user-modes, erc--user-modes, erc--parse-user-modes): New tests. * test/lisp/erc/resources/base/modes/chan-changed.eld: New test data file. (Bug#67220)
This commit is contained in:
F. Jason Park
parent
e7fa460e1d
commit
cca7956c82
11
etc/ERC-NEWS
11
etc/ERC-NEWS
|
|
@ -480,6 +480,17 @@ release lacks a similar solution for detecting "joinedness" directly,
|
|||
but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target'
|
||||
as a makeshift kludge.
|
||||
|
||||
*** Channel-mode handling has become stricter and more predictable.
|
||||
ERC has always processed channel modes using "standardized" letters
|
||||
and popular status prefixes. Starting with this release, ERC will
|
||||
begin preferring advertised "CHANMODES" when interpreting letters and
|
||||
their arguments. To facilitate this transition, the functions
|
||||
'erc-set-modes', 'erc-parse-modes', and 'erc-update-modes', have all
|
||||
been provisionally deprecated. Expect a new, replacement API for
|
||||
handling specific "MODE" types and letters in coming releases. If
|
||||
you'd like a say in shaping how this transpires, please share your
|
||||
ideas and use cases on the tracker.
|
||||
|
||||
*** Miscellaneous changes
|
||||
Two helper macros from GNU ELPA's Compat library are now available to
|
||||
third-party modules as 'erc-compat-call' and 'erc-compat-function'.
|
||||
|
|
|
|||
|
|
@ -132,8 +132,10 @@
|
|||
(defvar erc-verbose-server-ping)
|
||||
(defvar erc-whowas-on-nosuchnick)
|
||||
|
||||
(declare-function erc--init-channel-modes "erc" (channel raw-args))
|
||||
(declare-function erc--open-target "erc" (target))
|
||||
(declare-function erc--target-from-string "erc" (string))
|
||||
(declare-function erc--update-modes "erc" (raw-args))
|
||||
(declare-function erc-active-buffer "erc" nil)
|
||||
(declare-function erc-add-default-channel "erc" (channel))
|
||||
(declare-function erc-banlist-update "erc" (proc parsed))
|
||||
|
|
@ -179,7 +181,6 @@
|
|||
(declare-function erc-server-buffer "erc" nil)
|
||||
(declare-function erc-set-active-buffer "erc" (buffer))
|
||||
(declare-function erc-set-current-nick "erc" (nick))
|
||||
(declare-function erc-set-modes "erc" (tgt mode-string))
|
||||
(declare-function erc-time-diff "erc" (t1 t2))
|
||||
(declare-function erc-trim-string "erc" (s))
|
||||
(declare-function erc-update-mode-line "erc" (&optional buffer))
|
||||
|
|
@ -194,8 +195,6 @@
|
|||
(proc parsed nick login host msg))
|
||||
(declare-function erc-update-channel-topic "erc"
|
||||
(channel topic &optional modify))
|
||||
(declare-function erc-update-modes "erc"
|
||||
(tgt mode-string &optional _nick _host _login))
|
||||
(declare-function erc-update-user-nick "erc"
|
||||
(nick &optional new-nick host login full-name info))
|
||||
(declare-function erc-open "erc"
|
||||
|
|
@ -1804,7 +1803,7 @@ add things to `%s' instead."
|
|||
(t (erc-get-buffer tgt)))))
|
||||
(with-current-buffer (or buf
|
||||
(current-buffer))
|
||||
(erc-update-modes tgt mode nick host login))
|
||||
(erc--update-modes (cdr (erc-response.command-args parsed))))
|
||||
(if (or (string= login "") (string= host ""))
|
||||
(erc-display-message parsed 'notice buf
|
||||
'MODE-nick ?n nick
|
||||
|
|
@ -2165,7 +2164,7 @@ A server may send more than one 005 message."
|
|||
(let* ((nick (car (erc-response.command-args parsed)))
|
||||
(modes (mapconcat #'identity
|
||||
(cdr (erc-response.command-args parsed)) " ")))
|
||||
(erc-set-modes nick modes)
|
||||
(erc--update-modes (cdr (erc-response.command-args parsed)))
|
||||
(erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes)))
|
||||
|
||||
(define-erc-response-handler (252)
|
||||
|
|
@ -2331,7 +2330,7 @@ See `erc-display-server-message'." nil
|
|||
(let ((channel (cadr (erc-response.command-args parsed)))
|
||||
(modes (mapconcat #'identity (cddr (erc-response.command-args parsed))
|
||||
" ")))
|
||||
(erc-set-modes channel modes)
|
||||
(erc--init-channel-modes channel (cddr (erc-response.command-args parsed)))
|
||||
(erc-display-message
|
||||
parsed 'notice (erc-get-buffer channel proc)
|
||||
's324 ?c channel ?m modes)))
|
||||
|
|
|
|||
|
|
@ -113,6 +113,11 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter."
|
|||
(statuses "~&@%+" :type string)
|
||||
(alist nil :type (list-of cons)))
|
||||
|
||||
(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data))
|
||||
"Server-local \"CHANMODES\" data."
|
||||
(fallbackp nil :type boolean)
|
||||
(table (make-char-table 'erc--channel-mode-types) :type char-table))
|
||||
|
||||
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
|
||||
(defun erc--normalize-module-symbol (symbol)
|
||||
"Return preferred SYMBOL for `erc--modules'."
|
||||
|
|
|
|||
236
lisp/erc/erc.el
236
lisp/erc/erc.el
|
|
@ -732,9 +732,9 @@ See also: `erc-get-channel-user-list'."
|
|||
"A topic string for the channel. Should only be used in channel-buffers.")
|
||||
|
||||
(defvar-local erc-channel-modes nil
|
||||
"List of strings representing channel modes.
|
||||
E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\")
|
||||
\(not sure the ban list will be here, but why not)")
|
||||
"List of letters, as strings, representing channel modes.
|
||||
For example, (\"i\" \"m\" \"s\"). Modes that take accompanying
|
||||
parameters are not included.")
|
||||
|
||||
(defvar-local erc-insert-marker nil
|
||||
"The place where insertion of new text in erc buffers should happen.")
|
||||
|
|
@ -4552,6 +4552,10 @@ returns."
|
|||
(erc--send-input-lines (erc--run-send-hooks lines-obj)))
|
||||
t)
|
||||
|
||||
;; FIXME if the user types /MODE<RET>, LINE becomes "\n", which
|
||||
;; matches the pattern, so "\n" is sent to the server. Perhaps
|
||||
;; instead of `do-not-parse-args', this should just join &rest
|
||||
;; arguments.
|
||||
(defun erc-cmd-MODE (line)
|
||||
"Change or display the mode value of a channel or user.
|
||||
The first word specifies the target. The rest is the mode string
|
||||
|
|
@ -5915,9 +5919,19 @@ See also: `erc-echo-notice-in-user-buffers',
|
|||
The server buffer is given by BUFFER."
|
||||
(with-current-buffer buffer
|
||||
(when erc-user-mode
|
||||
(let ((mode (if (functionp erc-user-mode)
|
||||
(funcall erc-user-mode)
|
||||
erc-user-mode)))
|
||||
(let* ((mode (if (functionp erc-user-mode)
|
||||
(funcall erc-user-mode)
|
||||
erc-user-mode))
|
||||
(groups (erc--parse-user-modes mode (erc--user-modes) t))
|
||||
(superfluous (last groups 2))
|
||||
(redundant-want (car superfluous))
|
||||
(redundant-drop (cadr superfluous)))
|
||||
(when redundant-want
|
||||
(erc-display-message nil 'notice buffer 'user-mode-redundant-add
|
||||
?m (apply #'string redundant-want)))
|
||||
(when redundant-drop
|
||||
(erc-display-message nil 'notice buffer 'user-mode-redundant-drop
|
||||
?m (apply #'string redundant-drop)))
|
||||
(when (stringp mode)
|
||||
(erc-log (format "changing mode for %s to %s" nick mode))
|
||||
(erc-server-send (format "MODE %s %s" nick mode)))))))
|
||||
|
|
@ -6474,7 +6488,9 @@ TOPIC string to the current topic."
|
|||
|
||||
(defun erc-set-modes (tgt mode-string)
|
||||
"Set the modes for the TGT provided as MODE-STRING."
|
||||
(let* ((modes (erc-parse-modes mode-string))
|
||||
(declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
|
||||
(let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
|
||||
(erc-parse-modes mode-string)))
|
||||
(add-modes (nth 0 modes))
|
||||
;; list of triples: (mode-char 'on/'off argument)
|
||||
(arg-modes (nth 2 modes)))
|
||||
|
|
@ -6520,6 +6536,7 @@ for modes without parameters to add and remove respectively. The
|
|||
arg-modes is a list of triples of the form:
|
||||
|
||||
(MODE-CHAR ON/OFF ARGUMENT)."
|
||||
(declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
|
||||
(if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
|
||||
(let ((chars (mapcar #'char-to-string (match-string 1 mode-string)))
|
||||
;; arguments in channel modes
|
||||
|
|
@ -6564,8 +6581,10 @@ arg-modes is a list of triples of the form:
|
|||
"Update the mode information for TGT, provided as MODE-STRING.
|
||||
Optional arguments: NICK, HOST and LOGIN - the attributes of the
|
||||
person who changed the modes."
|
||||
(declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
|
||||
;; FIXME: neither of nick, host, and login are used!
|
||||
(let* ((modes (erc-parse-modes mode-string))
|
||||
(let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
|
||||
(erc-parse-modes mode-string)))
|
||||
(add-modes (nth 0 modes))
|
||||
(remove-modes (nth 1 modes))
|
||||
;; list of triples: (mode-char 'on/'off argument)
|
||||
|
|
@ -6614,9 +6633,202 @@ person who changed the modes."
|
|||
;; nick modes - ignored at this point
|
||||
(t nil))))
|
||||
|
||||
(defun erc--update-membership-prefix (nick letter state)
|
||||
"Update status prefixes for NICK in current channel buffer.
|
||||
Expect LETTER to be a status char and STATE to be a boolean."
|
||||
(erc-update-current-channel-member nick nil nil
|
||||
(and (= letter ?v) state)
|
||||
(and (= letter ?h) state)
|
||||
(and (= letter ?o) state)
|
||||
(and (= letter ?a) state)
|
||||
(and (= letter ?q) state)))
|
||||
|
||||
(defvar-local erc--channel-modes nil
|
||||
"When non-nil, a hash table of current channel modes.
|
||||
Keys are characters. Values are either a string, for types A-C,
|
||||
or t, for type D.")
|
||||
|
||||
(defvar-local erc--channel-mode-types nil
|
||||
"Possibly stale `erc--channel-mode-types' instance for the server.
|
||||
Use the getter of the same name to retrieve the current value.")
|
||||
|
||||
(defun erc--channel-mode-types ()
|
||||
"Return variable `erc--channel-mode-types', possibly initializing it."
|
||||
(erc--with-isupport-data CHANMODES erc--channel-mode-types
|
||||
(let ((types (or key '(nil "Kk" "Ll" nil)))
|
||||
(ct (make-char-table 'erc--channel-mode-types))
|
||||
(type ?a))
|
||||
(dolist (cs types)
|
||||
(dolist (c (append cs nil))
|
||||
(aset ct c type))
|
||||
(cl-incf type))
|
||||
(make-erc--channel-mode-types :key key
|
||||
:fallbackp (null key)
|
||||
:table ct))))
|
||||
|
||||
(defun erc--process-channel-modes (string args &optional status-letters)
|
||||
"Parse channel \"MODE\" changes and call unary letter handlers.
|
||||
Update `erc-channel-modes' and `erc--channel-modes'. With
|
||||
STATUS-LETTERS, also update channel membership prefixes. Expect
|
||||
STRING to be the second argument from an incoming \"MODE\"
|
||||
command and ARGS to be the remaining arguments, which should
|
||||
complement relevant letters in STRING."
|
||||
(cl-assert (erc--target-channel-p erc--target))
|
||||
(let* ((obj (erc--channel-mode-types))
|
||||
(table (erc--channel-mode-types-table obj))
|
||||
(fallbackp (erc--channel-mode-types-fallbackp obj))
|
||||
(+p t))
|
||||
(dolist (c (append string nil))
|
||||
(let ((letter (char-to-string c)))
|
||||
(cond ((= ?+ c) (setq +p t))
|
||||
((= ?- c) (setq +p nil))
|
||||
((and status-letters (string-search letter status-letters))
|
||||
(erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
|
||||
((and-let* ((group (or (aref table c) (and fallbackp ?d))))
|
||||
(erc--handle-channel-mode group c +p
|
||||
(and (or (/= group ?c) +p)
|
||||
(pop args)))
|
||||
t))
|
||||
((not fallbackp)
|
||||
(erc-display-message nil '(notice error) (erc-server-buffer)
|
||||
(format "Unknown channel mode: %S" c))))))
|
||||
(setq erc-channel-modes (sort erc-channel-modes #'string<))
|
||||
(erc-update-mode-line (current-buffer))))
|
||||
|
||||
(defvar-local erc--user-modes nil
|
||||
"Sorted list of current user \"MODE\" letters.
|
||||
Analogous to `erc-channel-modes' but chars rather than strings.")
|
||||
|
||||
(defun erc--user-modes (&optional as-type)
|
||||
"Return user \"MODE\" letters in a form described by AS-TYPE.
|
||||
When AS-TYPE is the symbol `strings' (plural), return a list of
|
||||
strings. When it's `string' (singular), return the same list
|
||||
concatenated into a single string. When it's a single char, like
|
||||
?+, return the same value as `string' but with AS-TYPE prepended.
|
||||
When AS-TYPE is nil, return a list of chars."
|
||||
(let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes))))
|
||||
(pcase as-type
|
||||
('strings (mapcar #'char-to-string modes))
|
||||
('string (apply #'string modes))
|
||||
((and (pred characterp) c) (apply #'string (cons c modes)))
|
||||
(_ modes))))
|
||||
|
||||
(defun erc--parse-user-modes (string &optional current extrap)
|
||||
"Return lists of chars from STRING to add to and drop from CURRENT.
|
||||
Expect STRING to be a so-called \"modestring\", the second
|
||||
parameter of a \"MODE\" command, here containing only valid
|
||||
user-mode letters. Expect CURRENT to be a list of chars
|
||||
resembling those found in `erc--user-modes'. With EXTRAP, return
|
||||
two additional lists of chars: those that would be added were
|
||||
they not already present in CURRENT and those that would be
|
||||
dropped were they not already absent."
|
||||
(let ((addp t)
|
||||
;;
|
||||
redundant-add redundant-drop adding dropping)
|
||||
;; For short strings, `append' appears to be no slower than
|
||||
;; iteration var + `aref' or `mapc' + closure.
|
||||
(dolist (c (append string nil))
|
||||
(pcase c
|
||||
(?+ (setq addp t))
|
||||
(?- (setq addp nil))
|
||||
(_ (push c (let ((hasp (and current (memq c current))))
|
||||
(if addp
|
||||
(if hasp redundant-add adding)
|
||||
(if hasp dropping redundant-drop)))))))
|
||||
(if extrap
|
||||
(list (nreverse adding) (nreverse dropping)
|
||||
(nreverse redundant-add) (nreverse redundant-drop))
|
||||
(list (nreverse adding) (nreverse dropping)))))
|
||||
|
||||
(defun erc--update-user-modes (string)
|
||||
"Update `erc--user-modes' from \"MODE\" STRING.
|
||||
Return its value, a list of characters sorted by character code."
|
||||
(setq erc--user-modes
|
||||
(pcase-let ((`(,adding ,dropping)
|
||||
(erc--parse-user-modes string erc--user-modes)))
|
||||
(sort (seq-difference (nconc erc--user-modes adding) dropping)
|
||||
#'<))))
|
||||
|
||||
(defun erc--update-channel-modes (string &rest args)
|
||||
"Update `erc-channel-modes' and call individual mode handlers.
|
||||
Also update membership prefixes, as needed. Expect STRING to be
|
||||
a \"modestring\" and ARGS to match mode-specific parameters."
|
||||
(let ((status-letters (or (erc-with-server-buffer
|
||||
(erc--parsed-prefix-letters
|
||||
(erc--parsed-prefix)))
|
||||
"qaovhbQAOVHB")))
|
||||
(erc--process-channel-modes string args status-letters)))
|
||||
|
||||
;; XXX this comment is referenced elsewhere (grep before deleting).
|
||||
;;
|
||||
;; The function `erc-update-modes' was deprecated in ERC 5.6 with no
|
||||
;; immediate public replacement. Third parties needing such a thing
|
||||
;; are encouraged to write to emacs-erc@gnu.org with ideas for a
|
||||
;; mode-handler API, possibly one incorporating letter-specific
|
||||
;; handlers, like `erc--handle-channel-mode' (below), which only
|
||||
;; handles mode types A-C.
|
||||
(defun erc--update-modes (raw-args)
|
||||
"Handle user or channel \"MODE\" update from server.
|
||||
Expect RAW-ARGS be a list consisting of a \"modestring\" followed
|
||||
by mode-specific arguments."
|
||||
(if (and erc--target (erc--target-channel-p erc--target))
|
||||
(apply #'erc--update-channel-modes raw-args)
|
||||
(erc--update-user-modes (car raw-args))))
|
||||
|
||||
(defun erc--init-channel-modes (channel raw-args)
|
||||
"Set CHANNEL modes from RAW-ARGS.
|
||||
Expect RAW-ARGS to be a \"modestring\" without any status-prefix
|
||||
chars, followed by applicable arguments."
|
||||
(erc-with-buffer (channel)
|
||||
(erc--process-channel-modes (car raw-args) (cdr raw-args))))
|
||||
|
||||
(cl-defgeneric erc--handle-channel-mode (type letter state arg)
|
||||
"Handle a STATE change for mode LETTER of TYPE with ARG.
|
||||
Expect to be called in the affected target buffer. Expect TYPE
|
||||
to be a character, like ?a, representing an advertised
|
||||
\"CHANMODES\" group. Expect LETTER to also be a character, and
|
||||
expect STATE to be a boolean and ARGUMENT either a string or nil."
|
||||
(erc-log (format "Channel-mode %c (type %s, arg %S) %s"
|
||||
letter type arg (if state 'enabled 'disabled))))
|
||||
|
||||
(cl-defmethod erc--handle-channel-mode :before (_ c state arg)
|
||||
"Record STATE change and ARG, if enabling, for mode letter C."
|
||||
(unless erc--channel-modes
|
||||
(cl-assert (erc--target-channel-p erc--target))
|
||||
(setq erc--channel-modes (make-hash-table)))
|
||||
(if state
|
||||
(puthash c (or arg t) erc--channel-modes)
|
||||
(remhash c erc--channel-modes)))
|
||||
|
||||
(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
|
||||
"Update `erc-channel-modes' for any character C of nullary type D.
|
||||
Remember when STATE is non-nil and forget otherwise."
|
||||
(setq erc-channel-modes
|
||||
(if state
|
||||
(cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
|
||||
(delete (char-to-string c) erc-channel-modes))))
|
||||
|
||||
;; We could specialize on type C, but that may be too brittle.
|
||||
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
|
||||
"Update channel user limit, remembering ARG when STATE is non-nil."
|
||||
(erc-update-channel-limit (erc--target-string erc--target)
|
||||
(if state 'on 'off)
|
||||
arg))
|
||||
|
||||
;; We could specialize on type B, but that may be too brittle.
|
||||
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg)
|
||||
"Update channel key, remembering ARG when state is non-nil."
|
||||
;; Mimic old parsing behavior in which an ARG of "*" was discarded
|
||||
;; even though `erc-update-channel-limit' checks STATE first.
|
||||
(erc-update-channel-key (erc--target-string erc--target)
|
||||
(if state 'on 'off)
|
||||
(if (equal arg "*") nil arg)))
|
||||
|
||||
(defun erc-update-channel-limit (channel onoff n)
|
||||
;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
|
||||
"Update CHANNEL's user limit to N."
|
||||
"Update CHANNEL's user limit to N.
|
||||
Expect ONOFF to be `on' when the mode is being enabled and `off'
|
||||
otherwise. And because this mode is of \"type C\", expect N to
|
||||
be non-nil only when enabling."
|
||||
(if (or (not (eq onoff 'on))
|
||||
(and (stringp n) (string-match "^[0-9]+$" n)))
|
||||
(erc-with-buffer
|
||||
|
|
@ -8292,6 +8504,10 @@ All windows are opened in the current frame."
|
|||
(ops . "%i operator%s: %o")
|
||||
(ops-none . "No operators in this channel.")
|
||||
(undefined-ctcp . "Undefined CTCP query received. Silently ignored")
|
||||
(user-mode-redundant-add
|
||||
. "Already have user mode(s): %m. Requesting again anyway.")
|
||||
(user-mode-redundant-drop
|
||||
. "Already without user mode(s): %m. Requesting removal anyway.")
|
||||
(variable-not-bound . "Variable not bound!")
|
||||
(ACTION . "* %n %a")
|
||||
(CTCP-CLIENTINFO . "Client info for %n: %m")
|
||||
|
|
|
|||
84
test/lisp/erc/erc-scenarios-base-chan-modes.el
Normal file
84
test/lisp/erc/erc-scenarios-base-chan-modes.el
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
;;; erc-scenarios-base-chan-modes.el --- Channel mode scenarios -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2023 Free Software Foundation, Inc.
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert-x)
|
||||
(eval-and-compile
|
||||
(let ((load-path (cons (ert-resource-directory) load-path)))
|
||||
(require 'erc-scenarios-common)))
|
||||
|
||||
;; This asserts that a bug present in ERC 5.4+ is now absent.
|
||||
;; Previously, ERC would attempt to parse a nullary channel mode as if
|
||||
;; it were a status prefix update, which led to a wrong-type error.
|
||||
;; This test does not address similar collisions with unary modes,
|
||||
;; such as "MODE +q foo!*@*", but it should.
|
||||
(ert-deftest erc-scenarios-base-chan-modes--plus-q ()
|
||||
:tags '(:expensive-test)
|
||||
(erc-scenarios-common-with-cleanup
|
||||
((erc-scenarios-common-dialog "base/modes")
|
||||
(erc-server-flood-penalty 0.1)
|
||||
(dumb-server (erc-d-run "localhost" t 'chan-changed))
|
||||
(erc-modules (cons 'fill-wrap erc-modules))
|
||||
(erc-autojoin-channels-alist '((Libera.Chat "#chan")))
|
||||
(expect (erc-d-t-make-expecter)))
|
||||
|
||||
(ert-info ("Connect to Libera.Chat")
|
||||
(with-current-buffer (erc :server "127.0.0.1"
|
||||
:port (process-contact dumb-server :service)
|
||||
:nick "tester"
|
||||
:full-name "tester")
|
||||
(funcall expect 5 "changed mode")))
|
||||
|
||||
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
|
||||
(should-not erc-channel-key)
|
||||
(should-not erc-channel-user-limit)
|
||||
|
||||
(ert-info ("Receive notice that mode has changed")
|
||||
(erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
|
||||
(erc-scenarios-common-say "ready before")
|
||||
(funcall expect 10 "<Chad> before")
|
||||
(funcall expect 10 " has changed mode for #chan to +Qu")
|
||||
(erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))))
|
||||
|
||||
(ert-info ("Key stored locally")
|
||||
(erc-scenarios-common-say "ready key")
|
||||
(funcall expect 10 "<Chad> doing key")
|
||||
(funcall expect 10 " has changed mode for #chan to +k hunter2")
|
||||
(should (equal erc-channel-key "hunter2")))
|
||||
|
||||
(ert-info ("Limit stored locally")
|
||||
(erc-scenarios-common-say "ready limit")
|
||||
(funcall expect 10 "<Chad> doing limit")
|
||||
(funcall expect 10 " has changed mode for #chan to +l 3")
|
||||
(erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
|
||||
(should (equal erc-channel-modes '("Q" "n" "t" "u"))))
|
||||
|
||||
(ert-info ("Modes removed and local state deletion succeeds")
|
||||
(erc-scenarios-common-say "ready drop")
|
||||
(funcall expect 10 "<Chad> dropping")
|
||||
(funcall expect 10 " has changed mode for #chan to -lu")
|
||||
(funcall expect 10 " has changed mode for #chan to -Qk *")
|
||||
(erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))))
|
||||
|
||||
(should-not erc-channel-key)
|
||||
(should-not erc-channel-user-limit)
|
||||
(funcall expect 10 "<Chad> after"))))
|
||||
|
||||
;;; erc-scenarios-base-chan-modes.el ends here
|
||||
|
|
@ -701,6 +701,152 @@
|
|||
(erc-with-server-buffer erc--parsed-prefix))
|
||||
expected)))))
|
||||
|
||||
;; This exists as a reference to assert legacy behavior in order to
|
||||
;; preserve and incorporate it as a fallback in the 5.6+ replacement.
|
||||
(ert-deftest erc-parse-modes ()
|
||||
(with-suppressed-warnings ((obsolete erc-parse-modes))
|
||||
(should (equal (erc-parse-modes "+u") '(("u") nil nil)))
|
||||
(should (equal (erc-parse-modes "-u") '(nil ("u") nil)))
|
||||
(should (equal (erc-parse-modes "+o bob") '(nil nil (("o" on "bob")))))
|
||||
(should (equal (erc-parse-modes "-o bob") '(nil nil (("o" off "bob")))))
|
||||
(should (equal (erc-parse-modes "+uo bob") '(("u") nil (("o" on "bob")))))
|
||||
(should (equal (erc-parse-modes "+o-u bob") '(nil ("u") (("o" on "bob")))))
|
||||
(should (equal (erc-parse-modes "+uo-tv bob alice")
|
||||
'(("u") ("t") (("o" on "bob") ("v" off "alice")))))
|
||||
|
||||
(ert-info ("Modes of type B are always grouped as unary")
|
||||
(should (equal (erc-parse-modes "+k h2") '(nil nil (("k" on "h2")))))
|
||||
;; Channel key args are thrown away.
|
||||
(should (equal (erc-parse-modes "-k *") '(nil nil (("k" off nil))))))
|
||||
|
||||
(ert-info ("Modes of type C are grouped as unary even when disabling")
|
||||
(should (equal (erc-parse-modes "+l 3") '(nil nil (("l" on "3")))))
|
||||
(should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
|
||||
|
||||
(ert-deftest erc--update-channel-modes ()
|
||||
(erc-mode)
|
||||
(setq erc-channel-users (make-hash-table :test #'equal)
|
||||
erc-server-users (make-hash-table :test #'equal)
|
||||
erc--isupport-params (make-hash-table)
|
||||
erc--target (erc--target-from-string "#test"))
|
||||
(erc-tests--set-fake-server-process "sleep" "1")
|
||||
|
||||
(let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
|
||||
calls)
|
||||
(cl-letf (((symbol-function 'erc--handle-channel-mode)
|
||||
(lambda (&rest r) (push r calls) (apply orig-handle-fn r)))
|
||||
((symbol-function 'erc-update-mode-line) #'ignore))
|
||||
|
||||
(ert-info ("Unknown user not created")
|
||||
(erc--update-channel-modes "+o" "bob")
|
||||
(should-not (erc-get-channel-user "bob")))
|
||||
|
||||
(ert-info ("Status updated when user known")
|
||||
(puthash "bob" (cons (erc-add-server-user
|
||||
"bob" (make-erc-server-user :nickname "bob"))
|
||||
(make-erc-channel-user))
|
||||
erc-channel-users)
|
||||
;; Also asserts fallback behavior for traditional prefixes.
|
||||
(should-not (erc-channel-user-op-p "bob"))
|
||||
(erc--update-channel-modes "+o" "bob")
|
||||
(should (erc-channel-user-op-p "bob"))
|
||||
(erc--update-channel-modes "-o" "bob") ; status revoked
|
||||
(should-not (erc-channel-user-op-p "bob")))
|
||||
|
||||
(ert-info ("Unknown nullary added and removed")
|
||||
(should-not erc--channel-modes)
|
||||
(should-not erc-channel-modes)
|
||||
(erc--update-channel-modes "+u")
|
||||
(should (equal erc-channel-modes '("u")))
|
||||
(should (eq t (gethash ?u erc--channel-modes)))
|
||||
(should (equal (pop calls) '(?d ?u t nil)))
|
||||
(erc--update-channel-modes "-u")
|
||||
(should (equal (pop calls) '(?d ?u nil nil)))
|
||||
(should-not (gethash ?u erc--channel-modes))
|
||||
(should-not erc-channel-modes)
|
||||
(should-not calls))
|
||||
|
||||
(ert-info ("Fallback for Type B includes mode letter k")
|
||||
(erc--update-channel-modes "+k" "h2")
|
||||
(should (equal (pop calls) '(?b ?k t "h2")))
|
||||
(should-not erc-channel-modes)
|
||||
(should (equal "h2" (gethash ?k erc--channel-modes)))
|
||||
(erc--update-channel-modes "-k" "*")
|
||||
(should (equal (pop calls) '(?b ?k nil "*")))
|
||||
(should-not calls)
|
||||
(should-not (gethash ?k erc--channel-modes))
|
||||
(should-not erc-channel-modes))
|
||||
|
||||
(ert-info ("Fallback for Type C includes mode letter l")
|
||||
(erc--update-channel-modes "+l" "3")
|
||||
(should (equal (pop calls) '(?c ?l t "3")))
|
||||
(should-not erc-channel-modes)
|
||||
(should (equal "3" (gethash ?l erc--channel-modes)))
|
||||
(erc--update-channel-modes "-l" nil)
|
||||
(should (equal (pop calls) '(?c ?l nil nil)))
|
||||
(should-not (gethash ?l erc--channel-modes))
|
||||
(should-not erc-channel-modes))
|
||||
|
||||
(ert-info ("Advertised supersedes heuristics")
|
||||
(setq erc-server-parameters
|
||||
'(("PREFIX" . "(ov)@+")
|
||||
;; Add phony 5th type for this CHANMODES value for
|
||||
;; robustness in case some server gets creative.
|
||||
("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE")))
|
||||
(erc--update-channel-modes "+qu" "fool!*@*")
|
||||
(should (equal (pop calls) '(?d ?u t nil)))
|
||||
(should (equal (pop calls) '(?a ?q t "fool!*@*")))
|
||||
(should (equal "fool!*@*" (gethash ?q erc--channel-modes)))
|
||||
(should (eq t (gethash ?u erc--channel-modes)))
|
||||
(should (equal erc-channel-modes '("u")))
|
||||
(should-not (erc-channel-user-owner-p "bob")))
|
||||
|
||||
(should-not calls))))
|
||||
|
||||
(ert-deftest erc--update-user-modes ()
|
||||
(let ((erc--user-modes (list ?a)))
|
||||
(should (equal (erc--update-user-modes "+a") '(?a)))
|
||||
(should (equal (erc--update-user-modes "-b") '(?a)))
|
||||
(should (equal erc--user-modes '(?a))))
|
||||
|
||||
(let ((erc--user-modes (list ?b)))
|
||||
(should (equal (erc--update-user-modes "+ac") '(?a ?b ?c)))
|
||||
(should (equal (erc--update-user-modes "+a-bc") '(?a)))
|
||||
(should (equal erc--user-modes '(?a)))))
|
||||
|
||||
(ert-deftest erc--user-modes ()
|
||||
(let ((erc--user-modes '(?a ?b)))
|
||||
(should (equal (erc--user-modes) '(?a ?b)))
|
||||
(should (equal (erc--user-modes 'string) "ab"))
|
||||
(should (equal (erc--user-modes 'strings) '("a" "b")))
|
||||
(should (equal (erc--user-modes '?+) "+ab"))))
|
||||
|
||||
(ert-deftest erc--parse-user-modes ()
|
||||
(should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
|
||||
(should (equal (erc--parse-user-modes "+a" '(?a)) '(() ())))
|
||||
(should (equal (erc--parse-user-modes "a" '()) '((?a) ())))
|
||||
(should (equal (erc--parse-user-modes "+a" '()) '((?a) ())))
|
||||
(should (equal (erc--parse-user-modes "-a" '()) '(() ())))
|
||||
(should (equal (erc--parse-user-modes "-a" '(?a)) '(() (?a))))
|
||||
|
||||
(should (equal (erc--parse-user-modes "+a-b" '(?a)) '(() ())))
|
||||
(should (equal (erc--parse-user-modes "+a-b" '(?b)) '((?a) (?b))))
|
||||
(should (equal (erc--parse-user-modes "+ab-c" '(?b)) '((?a) ())))
|
||||
(should (equal (erc--parse-user-modes "+ab-c" '(?b ?c)) '((?a) (?c))))
|
||||
(should (equal (erc--parse-user-modes "+a-c+b" '(?b ?c)) '((?a) (?c))))
|
||||
(should (equal (erc--parse-user-modes "-c+ab" '(?b ?c)) '((?a) (?c))))
|
||||
|
||||
;; Param `extrap' returns groups of redundant chars.
|
||||
(should (equal (erc--parse-user-modes "+a" '() t) '((?a) () () ())))
|
||||
(should (equal (erc--parse-user-modes "+a" '(?a) t) '(() () (?a) ())))
|
||||
(should (equal (erc--parse-user-modes "-a" '() t) '(() () () (?a))))
|
||||
(should (equal (erc--parse-user-modes "-a" '(?a) t) '(() (?a) () ())))
|
||||
|
||||
(should (equal (erc--parse-user-modes "+a-b" '(?a) t) '(() () (?a) (?b))))
|
||||
(should (equal (erc--parse-user-modes "-b+a" '(?a) t) '(() () (?a) (?b))))
|
||||
(should (equal (erc--parse-user-modes "+a-b" '(?b) t) '((?a) (?b) () ())))
|
||||
(should (equal (erc--parse-user-modes "-b+a" '(?b) t) '((?a) (?b) () ()))))
|
||||
|
||||
(ert-deftest erc--parse-isupport-value ()
|
||||
(should (equal (erc--parse-isupport-value "a,b") '("a" "b")))
|
||||
(should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c")))
|
||||
|
|
|
|||
55
test/lisp/erc/resources/base/modes/chan-changed.eld
Normal file
55
test/lisp/erc/resources/base/modes/chan-changed.eld
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
;; -*- mode: lisp-data; -*-
|
||||
((nick 10 "NICK tester"))
|
||||
((user 10 "USER user 0 * :tester")
|
||||
(0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
|
||||
(0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
|
||||
(0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC")
|
||||
(0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
|
||||
(0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
|
||||
(0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
|
||||
(0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server")
|
||||
(0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers")
|
||||
(0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
|
||||
(0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
|
||||
(0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
|
||||
(0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
|
||||
(0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187")
|
||||
(0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827")
|
||||
(0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)")
|
||||
(0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ")
|
||||
(0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)")
|
||||
(0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
|
||||
(0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat")
|
||||
(0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
|
||||
(0.00 ":tester MODE tester :+Ziw"))
|
||||
|
||||
((mode-tester 10 "MODE tester +i"))
|
||||
|
||||
((join-chan 10 "JOIN #chan")
|
||||
(0.09 ":tester!~tester@127.0.0.1 JOIN #chan"))
|
||||
|
||||
((mode-chan 10 "MODE #chan")
|
||||
(0.03 ":cadmium.libera.chat 353 tester = #chan :tester @Chad dummy")
|
||||
(0.02 ":cadmium.libera.chat 366 tester #chan :End of /NAMES list.")
|
||||
(0.00 ":cadmium.libera.chat 324 tester #chan +nt")
|
||||
(0.01 ":cadmium.libera.chat 329 tester #chan 1621432263"))
|
||||
|
||||
((privmsg-before 10 "PRIVMSG #chan :ready before")
|
||||
(0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan before")
|
||||
(0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +Qu"))
|
||||
|
||||
((privmsg-key 10 "PRIVMSG #chan :ready key")
|
||||
(0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing key")
|
||||
(0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +k hunter2"))
|
||||
|
||||
((privmsg-limit 10 "PRIVMSG #chan :ready limit")
|
||||
(0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing limit")
|
||||
(0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +l 3"))
|
||||
|
||||
((privmsg-drop 10 "PRIVMSG #chan :ready drop")
|
||||
(0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan dropping")
|
||||
(0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -lu")
|
||||
(0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -Qk *")
|
||||
(0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan after"))
|
||||
|
||||
((drop 0 DROP))
|
||||
Loading…
Reference in a new issue