From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC Date: Fri, 17 Nov 2023 10:30:22 -0800 Message-ID: <87zfzcnsg1.fsf__47653.1414476753$1700245897$gmane$org@neverwas.me> References: <87pm0aphr2.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="451"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 67220@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Nov 17 19:31:30 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1r43cn-000AV3-IY for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 17 Nov 2023 19:31:30 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1r43cN-00051f-TB; Fri, 17 Nov 2023 13:31:03 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1r43cM-000511-8d for bug-gnu-emacs@gnu.org; Fri, 17 Nov 2023 13:31:02 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1r43cM-0003xX-0X for bug-gnu-emacs@gnu.org; Fri, 17 Nov 2023 13:31:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1r43cL-0000X1-PS for bug-gnu-emacs@gnu.org; Fri, 17 Nov 2023 13:31:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 17 Nov 2023 18:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 67220 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 67220-submit@debbugs.gnu.org id=B67220.17002458402012 (code B ref 67220); Fri, 17 Nov 2023 18:31:01 +0000 Original-Received: (at 67220) by debbugs.gnu.org; 17 Nov 2023 18:30:40 +0000 Original-Received: from localhost ([127.0.0.1]:47137 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r43bw-0000WL-9o for submit@debbugs.gnu.org; Fri, 17 Nov 2023 13:30:39 -0500 Original-Received: from mail-108-mta198.mxroute.com ([136.175.108.198]:36041) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r43br-0000W6-4S for 67220@debbugs.gnu.org; Fri, 17 Nov 2023 13:30:35 -0500 Original-Received: from filter006.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta198.mxroute.com (ZoneMTA) with ESMTPSA id 18bde8c7080000190b.001 for <67220@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Fri, 17 Nov 2023 18:30:27 +0000 X-Zone-Loop: 1109731a69cca258485cb4f513b53f0886922b08b633 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=iWpOmTQrlUEVb70QPDaAbPJRst7f8ALVT/2Dd0V+8D0=; b=mpuM0TOL5MCdJfk0X/wBxzQCSM aiJdLRakzrSVVDI+l6VGyZm5USeVKsABy5sN/aVxi4UZKQUWCVVbC9DrBM/8l/sz1LWJ8jp8IDB/C NUaDb8npDl8oaIAp9S/ZRoI2h0MTA8zQwz0/NUQ0hv2RYMhNTowlr2Id784LBYNdV1Fz/LgX+YeQO K6jkzrUQZ9zCQTmcHzDFrB+DD+/pmPjBfO3+A4djv+fJKHoOBj63J8hBbA1+2YnmwfMy+f93WheF9 ZIYbngv94RCkbfTol/PkspFT4AFhA5BQY7Mst9mp3etoxjRweT/FkIng0GF4k7GhlPOHEOFUf4lCm 7yFPX+8w==; In-Reply-To: <87pm0aphr2.fsf@neverwas.me> (J. P.'s message of "Wed, 15 Nov 2023 18:13:53 -0800") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:274511 Archived-At: --=-=-= Content-Type: text/plain v2. Account for nonstandard CHANMODES beyond type D. Make mode-letter handling more extensible and modular. Provide convenience macro for caching processed data originating from ISUPPORT values. Retain original parsed channel-mode data. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 8f7f44aeca735a988c9eb0a18aca3497f07c8480 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 17 Nov 2023 06:58:44 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Make wrangling ISUPPORT data more convenient in ERC [5.6] Use caching variant of erc-parse-prefix internally [5.6] Rework MODE processing in ERC etc/ERC-NEWS | 11 + lisp/erc/erc-backend.el | 27 +- lisp/erc/erc-common.el | 16 + lisp/erc/erc.el | 279 ++++++++++++++++-- .../lisp/erc/erc-scenarios-base-chan-modes.el | 84 ++++++ .../lisp/erc/erc-scenarios-display-message.el | 2 - test/lisp/erc/erc-tests.el | 198 +++++++++++++ .../erc/resources/base/modes/chan-changed.eld | 55 ++++ 8 files changed, 636 insertions(+), 36 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-chan-modes.el create mode 100644 test/lisp/erc/resources/base/modes/chan-changed.eld Interdiff: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ace46cf84f5..7b5d1e35189 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2107,6 +2107,18 @@ erc--get-isupport-entry (when table (remhash key table)))) +(defmacro erc--with-isupport-data (param var &rest body) + "Return processed data for \"ISUPPORT\" PARAM value stored VAR. +Expect VAR's value to be an instance of an object whose \"class\" +inherits from `erc--isupport-data'. If VAR is uninitialized or +stale, evaluate BODY and assign the result to VAR." + (declare (indent defun)) + `(erc-with-server-buffer + (pcase-let (((,@(list '\` (list param '\, 'key))) + (erc--get-isupport-entry ',param))) + (or (and ,var (eq key (erc--isupport-data-key ,var)) ,var) + (setq ,var (progn ,@body)))))) + (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 930e8032f6d..48d29883d8f 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -101,6 +101,22 @@ erc--target (contents "" :type string) (tags '() :type list)) +(cl-defstruct erc--isupport-data + "Abstract class for parsed ISUPPORT data." + (key nil :type (or null cons))) + +(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data)) + "Server-local data for recognized membership-status prefixes. +Derived from the advertised \"PREFIX\" ISUPPORT parameter." + (letters "qaohv" :type string) + (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'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8a74414cb0c..78a4f363af2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5921,10 +5921,10 @@ erc-set-initial-user-mode (let* ((mode (if (functionp erc-user-mode) (funcall erc-user-mode) erc-user-mode)) - (as-pair (erc--parse-user-modes mode)) - (have (erc--user-modes)) - (redundant-want (seq-intersection (car as-pair) have)) - (redundant-drop (seq-difference (cadr as-pair) have))) + (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))) @@ -6221,38 +6221,21 @@ erc-parse-prefix collected)) (defvar-local erc--parsed-prefix nil - "Cons of latest advertised PREFIX and its parsed alist. -Only usable for the current server session.") - -;; As of ERC 5.6, `erc-channel-receive-names' is the only caller, and -;; it runs infrequently. In the future, extensions, like -;; `multi-prefix', may benefit more from a two-way translation table. -(cl-defstruct erc--parsed-prefix - "Server-local channel-membership-prefix data." - (key nil :type (or null string)) - (letters "qaohv" :type string) - (statuses "~&@%+" :type string) - (alist nil :type (list-of cons))) - -(defun erc--parse-prefix () - "Return (possibly cached) status prefix translation alist for the server. + "Current `erc--parsed-prefix' struct instance for the server.") + +(defun erc--parsed-prefix () + "Return possibly cached `erc--parsed-prefix' object for the server. Ensure the returned value describes the most recent \"PREFIX\" -ISUPPORT parameter received from the current server and that the -original ordering is preserved." - (erc-with-server-buffer - (let ((key (erc--get-isupport-entry 'PREFIX))) - (or (and key - erc--parsed-prefix - (eq (cdr key) (erc--parsed-prefix-key erc--parsed-prefix)) - (erc--parsed-prefix-alist erc--parsed-prefix)) - (let ((alist (nreverse (erc-parse-prefix)))) - (setq erc--parsed-prefix - (make-erc--parsed-prefix - :key (cdr key) - :letters (apply #'string (map-keys alist)) - :statuses (apply #'string (map-values alist)) - :alist alist)) - alist))))) +ISUPPORT parameter received from the current server, with the +original ordering intact. If no such parameter has yet arrived, +return a stand-in from the standard value \"(qaohv)~&@%+\"." + (erc--with-isupport-data PREFIX erc--parsed-prefix + (let ((alist (nreverse (erc-parse-prefix)))) + (make-erc--parsed-prefix + :key key + :letters (apply #'string (map-keys alist)) + :statuses (apply #'string (map-values alist)) + :alist alist)))) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -6266,7 +6249,7 @@ erc-channel-receive-names Update `erc-channel-users' according to NAMES-STRING. NAMES-STRING is a string listing some of the names on the channel." - (let* ((prefix (erc-parse-prefix)) + (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix))) (voice-ch (cdr (assq ?v prefix))) (op-ch (cdr (assq ?o prefix))) (hop-ch (cdr (assq ?h prefix))) @@ -6657,115 +6640,175 @@ erc--update-membership-prefix (and (= letter ?a) state) (and (= letter ?q) state))) -(defvar erc--update-channel-modes-omit-status-p nil) - -(defun erc--update-channel-modes (string &rest args) - "Update `erc-channel-modes' and dispatch individual mode handlers. -Also update status prefixes, as needed. Expect STRING to be a -\"modestring\" and ARGS to match mode-specific parameters. When -`erc--update-channel-modes-omit-status-p' is non-nil, forgo -setting status prefixes for channel members." - (cl-assert erc-server-process) - (cl-assert erc--target) +(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 + "Current `erc--channel-mode-types' instance for the server.") + +(defun erc--channel-mode-types () + "Return `erc--channel-mode-types', possibly creating 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) + (seq-doseq (c cs) + (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)) - (pcase-let* ((status-letters - (and (not erc--update-channel-modes-omit-status-p) - (or (erc-with-server-buffer - (erc--parse-prefix) - (erc--parsed-prefix-letters erc--parsed-prefix)) - "qaovhbQAOVHB"))) - (`(,type-a ,type-b ,type-c ,type-d) - (or (cdr (erc--get-isupport-entry 'CHANMODES)) - '(nil "Kk" "Ll" nil))) - (+p t)) + (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 type-a (string-search letter type-a)) - (erc--handle-channel-mode 'a c +p (pop args))) - ((string-search letter type-b) - (erc--handle-channel-mode 'b c +p (pop args))) - ((string-search letter type-c) - (erc--handle-channel-mode 'c c +p (and +p (pop args)))) - ((or (null type-d) (string-search letter type-d)) - (setq erc-channel-modes - (if +p - (cl-pushnew letter erc-channel-modes :test #'equal) - (delete letter erc-channel-modes)))) - (type-d ; OK to print error because server buffer exists + ((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 (erc-sort-strings erc-channel-modes)) + (setq erc-channel-modes (sort erc-channel-modes #'string<)) (erc-update-mode-line (current-buffer)))) (defvar-local erc--user-modes nil - "List of current user modes, analogous to `erc-channel-modes'.") - -(defun erc--user-modes (&optional as-string-p) - "Return user mode letters as chars or, with AS-STRING-P, a single string." - (let ((modes (erc-with-server-buffer erc--user-modes))) - (if as-string-p - (apply #'string (if (memq as-string-p '(+ ?+)) (cons '?+ modes) modes)) - modes))) - -(defun erc--parse-user-modes (string) - "Return a list of mode chars to add and remove, based on STRING." + "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) - add-modes remove-modes) + ;; + redundant-add redundant-drop adding dropping) (seq-doseq (c string) (pcase c (?+ (setq addp t)) (?- (setq addp nil)) - (_ (push c (if addp add-modes remove-modes))))) - (list (nreverse add-modes) - (nreverse remove-modes)))) + (_ (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 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--merge-user-modes (adding dropping) - "Update `erc--user-modes' with chars ADDING and DROPPING." - (sort (seq-difference (seq-union 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 mode-letter specific -;; handlers, like `erc--handle-channel-mode' below. +;; 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 to be a \"modestring\" followed by mode-specific -arguments." + "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) - (setq erc--user-modes - (apply #'erc--merge-user-modes - (erc--parse-user-modes (car raw-args)))))) + (erc--update-user-modes (car raw-args)))) (defun erc--init-channel-modes (channel raw-args) - "Set CHANNEL modes from RAW-ARGS." - (let ((erc--update-channel-modes-omit-status-p t)) - (erc-with-buffer (channel) - (apply #'erc--update-channel-modes 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 symbol, namely, one of `a', `b', `c', or `d'. Expect -LETTER to be a character, STATE to be a boolean, and ARGUMENT to -be either a string or nil." +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)))) -;; We could specialize on (eql 'c), but that may be too brittle. +(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) (erc-update-channel-limit (erc--target-string erc--target) (if state 'on 'off) arg)) -;; We could specialize on (eql 'b), but that may be too brittle. +;; We could specialize on type B, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg) ;; Mimic old parsing behavior in which an ARG of "*" was discarded ;; even though `erc-update-channel-limit' checks STATE first. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 1ff5f4890a8..b7a0b29d06d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -643,11 +643,24 @@ erc-parse-user (should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy")))))) -(ert-deftest erc--parse-prefix () +(ert-deftest erc--parsed-prefix () (erc-mode) (erc-tests--set-fake-server-process "sleep" "1") - (setq erc--isupport-params (make-hash-table) - erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + (setq erc--isupport-params (make-hash-table)) + + ;; Uses fallback values when no PREFIX parameter yet received, thus + ;; ensuring caller can use slot accessors immediately intead of + ;; checking if null beforehand. + (should-not erc--parsed-prefix) + (should (equal (erc--parsed-prefix) + #s(erc--parsed-prefix nil "qaohv" "~&@%+" + ((?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))))) + (let ((cached (should erc--parsed-prefix))) + (should (eq (erc--parsed-prefix) cached))) + + ;; Cache broken. (Notice not setting `erc--parsed-prefix' to nil). + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) (let ((proc erc-server-process) (expected '((?Y . ?!) (?q . ?~) (?a . ?&) @@ -657,33 +670,33 @@ erc--parse-prefix (with-temp-buffer (erc-mode) (setq erc-server-process proc) - (should (equal expected (erc--parse-prefix)))) + (should (equal expected + (erc--parsed-prefix-alist (erc--parsed-prefix))))) (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) (setq cached erc--parsed-prefix) (should (equal cached - #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") - "Yqaohv" "!~&@%+" + #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") "Yqaohv" "!~&@%+" ((?Y . ?!) (?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v . ?+))))) ;; Second target buffer reuses cached value. (with-temp-buffer (erc-mode) (setq erc-server-process proc) - (should (eq (erc--parsed-prefix-alist cached) (erc--parse-prefix)))) + (should (eq cached (erc--parsed-prefix)))) ;; New value computed when cache broken. (puthash 'PREFIX (list "(Yqaohv)!~&@%+") erc--isupport-params) (with-temp-buffer (erc-mode) (setq erc-server-process proc) - (should-not (eq (erc--parsed-prefix-alist cached) (erc--parse-prefix))) + (should-not (eq cached (erc--parsed-prefix))) (should (equal (erc--parsed-prefix-alist (erc-with-server-buffer erc--parsed-prefix)) expected))))) -;; This tests exists to prove legacy behavior in order to incorporate -;; it as a fallback in the 5.6+ replacement. +;; 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))) @@ -712,9 +725,10 @@ erc--update-channel-modes erc--target (erc--target-from-string "#test")) (erc-tests--set-fake-server-process "sleep" "1") - (let (calls) + (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))) + (lambda (&rest r) (push r calls) (apply orig-handle-fn r))) ((symbol-function 'erc-update-mode-line) #'ignore)) (ert-info ("Unknown user not created") @@ -734,40 +748,99 @@ erc--update-channel-modes (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 (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 (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 (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 (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)@+") - ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) + ;; 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) '(a ?q t "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"))) -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Make-wrangling-ISUPPORT-data-more-convenient-in-.patch >From b05b60a0d79aad70cb71681b4b9f1f519bba40e4 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Nov 2023 18:24:59 -0800 Subject: [PATCH 1/3] [5.6] Make wrangling ISUPPORT data more convenient in ERC * lisp/erc/erc-backend.el (erc--get-isupport-entry): Check server for `erc-server-parameters' if it's empty in the current buffer. This is a bug fix. (erc--with-isupport-data): New macro for accessing and caching data derived from some ISUPPORT value. * lisp/erc/erc-common.el (erc--isupport-data): New type for storing cached ISUPPORT data. * test/lisp/erc/erc-scenarios-display-message.el: Remove stray `require'. (Bug#67220) --- lisp/erc/erc-backend.el | 16 +++++++++++++++- lisp/erc/erc-common.el | 4 ++++ test/lisp/erc/erc-scenarios-display-message.el | 2 -- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9281c107d06..573079272e6 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2096,7 +2096,9 @@ erc--get-isupport-entry (erc-with-server-buffer erc--isupport-params))) (value (with-memoization (gethash key table) (when-let ((v (assoc (symbol-name key) - erc-server-parameters))) + (or erc-server-parameters + (erc-with-server-buffer + erc-server-parameters))))) (if (cdr v) (erc--parse-isupport-value (cdr v)) '--empty--))))) @@ -2106,6 +2108,18 @@ erc--get-isupport-entry (when table (remhash key table)))) +(defmacro erc--with-isupport-data (param var &rest body) + "Return processed data for \"ISUPPORT\" PARAM value stored VAR. +Expect VAR's value to be an instance of an object whose \"class\" +inherits from `erc--isupport-data'. If VAR is uninitialized or +stale, evaluate BODY and assign the result to VAR." + (declare (indent defun)) + `(erc-with-server-buffer + (pcase-let (((,@(list '\` (list param '\, 'key))) + (erc--get-isupport-entry ',param))) + (or (and ,var (eq key (erc--isupport-data-key ,var)) ,var) + (setq ,var (progn ,@body)))))) + (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 930e8032f6d..683b05c3543 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -101,6 +101,10 @@ erc--target (contents "" :type string) (tags '() :type list)) +(cl-defstruct erc--isupport-data + "Abstract class for parsed ISUPPORT data." + (key nil :type (or null cons))) + ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) "Return preferred SYMBOL for `erc--modules'." diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el index 51bdf305ad5..5751a32212d 100644 --- a/test/lisp/erc/erc-scenarios-display-message.el +++ b/test/lisp/erc/erc-scenarios-display-message.el @@ -59,6 +59,4 @@ erc-scenarios-display-message--multibuf (erc-cmd-QUIT ""))) -(eval-when-compile (require 'erc-join)) - ;;; erc-scenarios-display-message.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Use-caching-variant-of-erc-parse-prefix-internal.patch >From 0640c127d9242267b3e7f50f02589971f6a578af Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Nov 2023 18:24:59 -0800 Subject: [PATCH 2/3] [5.6] Use caching variant of erc-parse-prefix internally * lisp/erc/erc-common.el (erc--parsed-prefix): New struct for data relevant to working with advertised ISUPPORT PREFIX. * lisp/erc/erc.el (erc-parse-prefix): Rework slightly for readability. (erc--parsed-prefix): New variable for caching the result of `erc-parse-prefix' locally. (erc--parse-prefix): New function to cache reversed result of `erc-parse-prefix' in an `erc--parsed-prefix' object. (erc-channel-receive-names): Use `erc--parse-prefix'. * test/lisp/erc/erc-tests.el (erc--parse-prefix): New test. (Bug#67220) --- lisp/erc/erc-common.el | 7 +++++ lisp/erc/erc.el | 48 ++++++++++++++++++++++------------- test/lisp/erc/erc-tests.el | 52 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 90 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 683b05c3543..65cc4630156 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -105,6 +105,13 @@ erc--isupport-data "Abstract class for parsed ISUPPORT data." (key nil :type (or null cons))) +(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data)) + "Server-local data for recognized membership-status prefixes. +Derived from the advertised \"PREFIX\" ISUPPORT parameter." + (letters "qaohv" :type string) + (statuses "~&@%+" :type string) + (alist nil :type (list-of cons))) + ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) "Return preferred SYMBOL for `erc--modules'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index edcfcf085e6..125d9fcd3a1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6192,22 +6192,36 @@ erc-channel-end-receiving-names (defun erc-parse-prefix () "Return an alist of valid prefix character types and their representations. -Example: (operator) o => @, (voiced) v => +." - (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t)) - ;; provide a sane default - "(qaohv)~&@%+")) - types chars) - (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str) - (setq types (match-string 1 str) - chars (match-string 2 str)) - (let ((len (min (length types) (length chars))) - (i 0) - (alist nil)) - (while (< i len) - (setq alist (cons (cons (elt types i) (elt chars i)) - alist)) - (setq i (1+ i))) - alist)))) +For example, if the current ISUPPORT \"PREFIX\" is \"(ov)@+\", +return an alist `equal' to ((?v . ?+) (?o . ?@)). For historical +reasons, ensure the ordering of the returned alist is opposite +that of the advertised parameter." + (let* ((str (or (erc--get-isupport-entry 'PREFIX t) "(qaohv)~&@%+")) + (i 0) + (j (string-search ")" str)) + collected) + (when j + (while-let ((u (aref str (cl-incf i))) + ((not (= ?\) u)))) + (push (cons u (aref str (cl-incf j))) collected))) + collected)) + +(defvar-local erc--parsed-prefix nil + "Current `erc--parsed-prefix' struct instance for the server.") + +(defun erc--parsed-prefix () + "Return possibly cached `erc--parsed-prefix' object for the server. +Ensure the returned value describes the most recent \"PREFIX\" +ISUPPORT parameter received from the current server, with the +original ordering intact. If no such parameter has yet arrived, +return a stand-in from the standard value \"(qaohv)~&@%+\"." + (erc--with-isupport-data PREFIX erc--parsed-prefix + (let ((alist (nreverse (erc-parse-prefix)))) + (make-erc--parsed-prefix + :key key + :letters (apply #'string (map-keys alist)) + :statuses (apply #'string (map-values alist)) + :alist alist)))) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -6221,7 +6235,7 @@ erc-channel-receive-names Update `erc-channel-users' according to NAMES-STRING. NAMES-STRING is a string listing some of the names on the channel." - (let* ((prefix (erc-parse-prefix)) + (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix))) (voice-ch (cdr (assq ?v prefix))) (op-ch (cdr (assq ?o prefix))) (hop-ch (cdr (assq ?h prefix))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e7422d330c0..b61a601143a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -643,6 +643,58 @@ erc-parse-user (should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy")))))) +(ert-deftest erc--parsed-prefix () + (erc-mode) + (erc-tests--set-fake-server-process "sleep" "1") + (setq erc--isupport-params (make-hash-table)) + + ;; Uses fallback values when no PREFIX parameter yet received, thus + ;; ensuring caller can use slot accessors immediately intead of + ;; checking if null beforehand. + (should-not erc--parsed-prefix) + (should (equal (erc--parsed-prefix) + #s(erc--parsed-prefix nil "qaohv" "~&@%+" + ((?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))))) + (let ((cached (should erc--parsed-prefix))) + (should (eq (erc--parsed-prefix) cached))) + + ;; Cache broken. (Notice not setting `erc--parsed-prefix' to nil). + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + + (let ((proc erc-server-process) + (expected '((?Y . ?!) (?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))) + cached) + + (with-temp-buffer + (erc-mode) + (setq erc-server-process proc) + (should (equal expected + (erc--parsed-prefix-alist (erc--parsed-prefix))))) + + (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) + (setq cached erc--parsed-prefix) + (should (equal cached + #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") "Yqaohv" "!~&@%+" + ((?Y . ?!) (?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))))) + ;; Second target buffer reuses cached value. + (with-temp-buffer + (erc-mode) + (setq erc-server-process proc) + (should (eq cached (erc--parsed-prefix)))) + + ;; New value computed when cache broken. + (puthash 'PREFIX (list "(Yqaohv)!~&@%+") erc--isupport-params) + (with-temp-buffer + (erc-mode) + (setq erc-server-process proc) + (should-not (eq cached (erc--parsed-prefix))) + (should (equal (erc--parsed-prefix-alist + (erc-with-server-buffer erc--parsed-prefix)) + expected))))) + (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"))) -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Rework-MODE-processing-in-ERC.patch >From 8f7f44aeca735a988c9eb0a18aca3497f07c8480 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 14 Nov 2023 21:10:39 -0800 Subject: [PATCH 3/3] [5.6] Rework MODE processing in ERC * etc/ERC-NEWS: Mention shift toward CHANMODES ISUPPORT parameter for dictating 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 type 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. (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 to store server-local instance of 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 variable `erc-channel-modes'. (erc--user-modes): New local variable for remembering user modes per server. New function of the same name, a getter for that 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. (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 file. (Bug#67220) --- etc/ERC-NEWS | 11 + lisp/erc/erc-backend.el | 11 +- lisp/erc/erc-common.el | 5 + lisp/erc/erc.el | 231 +++++++++++++++++- .../lisp/erc/erc-scenarios-base-chan-modes.el | 84 +++++++ test/lisp/erc/erc-tests.el | 146 +++++++++++ .../erc/resources/base/modes/chan-changed.eld | 55 +++++ 7 files changed, 527 insertions(+), 16 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-chan-modes.el create mode 100644 test/lisp/erc/resources/base/modes/chan-changed.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 04b11fc19f0..3bb9a30cfb2 100644 --- a/etc/ERC-NEWS +++ b/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'. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 573079272e6..7b5d1e35189 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -132,8 +132,10 @@ erc-reuse-buffers (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 @@ erc-whowas-on-nosuchnick (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 @@ erc-whowas-on-nosuchnick (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" @@ -1802,7 +1801,7 @@ erc--server-determine-join-display-context (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 @@ -2156,7 +2155,7 @@ erc--with-isupport-data (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) @@ -2322,7 +2321,7 @@ erc-server-322-message (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))) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 65cc4630156..48d29883d8f 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -112,6 +112,11 @@ erc--isupport-data (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'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 125d9fcd3a1..78a4f363af2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -732,9 +732,9 @@ erc-channel-topic "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 @@ erc--send-message-nested (erc--send-input-lines (erc--run-send-hooks lines-obj))) t) +;; FIXME if the user types /MODE, 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 @@ -5914,9 +5918,19 @@ erc-set-initial-user-mode 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))))))) @@ -6471,7 +6485,9 @@ erc-update-channel-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))) @@ -6517,6 +6533,7 @@ erc-parse-modes 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 @@ -6561,8 +6578,10 @@ erc-update-modes "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) @@ -6611,9 +6630,197 @@ erc-update-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 + "Current `erc--channel-mode-types' instance for the server.") + +(defun erc--channel-mode-types () + "Return `erc--channel-mode-types', possibly creating 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) + (seq-doseq (c cs) + (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) + (seq-doseq (c string) + (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 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) + (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) + ;; 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 @@ -8289,6 +8496,10 @@ erc-define-catalog (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") diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el new file mode 100644 index 00000000000..9c63d8aff8e --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el @@ -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 . + +;;; 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 " 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 " 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 " 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 " 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 " after")))) + +;;; erc-scenarios-base-chan-modes.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b61a601143a..b7a0b29d06d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -695,6 +695,152 @@ erc--parsed-prefix (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"))) diff --git a/test/lisp/erc/resources/base/modes/chan-changed.eld b/test/lisp/erc/resources/base/modes/chan-changed.eld new file mode 100644 index 00000000000..6cf6596b0b2 --- /dev/null +++ b/test/lisp/erc/resources/base/modes/chan-changed.eld @@ -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)) -- 2.41.0 --=-=-=--