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: Thu, 18 Jan 2024 17:21:29 -0800 Message-ID: <87mst2unhi.fsf__7765.08154101379$1705627362$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="36533"; 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 Jan 19 02:22:34 2024 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 1rQdab-0009Kh-QT for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 19 Jan 2024 02:22:34 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rQda7-0008Ve-17; Thu, 18 Jan 2024 20:22: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 1rQda4-0008VT-Hb for bug-gnu-emacs@gnu.org; Thu, 18 Jan 2024 20:22:00 -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 1rQda3-0005Pr-To for bug-gnu-emacs@gnu.org; Thu, 18 Jan 2024 20:22:00 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rQda5-0005wL-Q3 for bug-gnu-emacs@gnu.org; Thu, 18 Jan 2024 20:22: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, 19 Jan 2024 01:22: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.170562731122816 (code B ref 67220); Fri, 19 Jan 2024 01:22:01 +0000 Original-Received: (at 67220) by debbugs.gnu.org; 19 Jan 2024 01:21:51 +0000 Original-Received: from localhost ([127.0.0.1]:57036 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rQdZt-0005vu-G9 for submit@debbugs.gnu.org; Thu, 18 Jan 2024 20:21:51 -0500 Original-Received: from mail-108-mta196.mxroute.com ([136.175.108.196]:36761) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rQdZp-0005vY-Jp for 67220@debbugs.gnu.org; Thu, 18 Jan 2024 20:21:47 -0500 Original-Received: from filter006.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta196.mxroute.com (ZoneMTA) with ESMTPSA id 18d1f4f281a0003727.001 for <67220@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Fri, 19 Jan 2024 01:21:37 +0000 X-Zone-Loop: 11e13301f84b04756737ec11e7118c4f1efe01491728 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=AQJJDJWoRHg3Hgm5xsuvqfEndGMAV6bH/HEwqXP39XM=; b=jQOzPcvSh+5Rpe9cOjJp2dZHE+ EX0l04F4Yb96+tXE8U73CM9IvaCbnCG9n1Fjz/3BUx1Fhx45kKc7RNFo5Cpn8N4lVORQ9zP0UKCta 6eudqvFeA41v7Q+5wgfRE/Li0mIUffPXZgfskYmUbC9lUcYWdPQ79yTEzNcR0CNQr3jP/lapzMI4q FIcUCzDi/DNbsIBzQNhlmWqoxIaffe8Mj/mIK5bWhaaamHmivltakOApgsOTBlsFNHzm62YmyPeD+ oDoCNB0pZa5km8HxzG4YVSdWMgJboqyek7gK3B9tuHU9otmjSIyqieMWetTm6WKHm78J+CPOwCbQq vHVOftBg==; 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:278464 Archived-At: --=-=-= Content-Type: text/plain "J.P." writes: > Tags: patch > > In the early days of IRC, parsing a "MODE" command from the server was > comparatively straightforward. There were a few well known letters, some > taking a single argument, and a standard set of status prefixes. But > somewhere along the line, things got more complicated, and it seems ERC > never got the memo. While it may appear obvious that sticking to a > hard-coded, heuristics based approach doesn't really accommodate ERC's > core tenet of extensibility, the risk of shifting toward something more > parameter driven was probably never justifiable without a vocal demand. In the initial set of changes, I only partially implemented PREFIX-aware channel-membership handling (here and in bug#67677, for the formatting side). The main reason for this omission was that I mistakenly assumed the lack of a valid use case for doing so. However, a latent clue in our own test suite attesting to the contrary was staring me in the face the whole time (until I unceremoniously erased it [1]). Since then, I've come around on this and now think we might as well see it through the somewhat arduous last mile. See attached. Thanks. [1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=4939f413 ^ Grep for "Yqaohv". --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Actually-derive-channel-membership-from-PREFIX-i.patch >From 9c7260ef1cd9aa87bcfe98175307fed8b64e3ae5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 17 Jan 2024 21:42:02 -0800 Subject: [PATCH 3/3] [5.6] Actually derive channel membership from PREFIX in ERC * lisp/erc/erc-backend.el (erc--with-isupport-data): Add comment for possibly superior alternate implementation. * lisp/erc/erc-common.el (erc--get-isupport-entry): Use helper to initialize traditional prefixes slots in overridden well-known constructor. (erc--parsed-prefix): Reverse the order of characters in the `letters' and `statuses' slots, both by definition and in their defaults. (erc--strpos): New function, a utility for finding a single character in a string. * lisp/erc/erc.el (erc--define-channel-user-status-compat-getter): Modify to query advertised value for associated mode letter at runtime instead of baking it in. (erc-channel-user-voice, erc-channel-user-halfop, erc-channel-user-op, erc-channel-user-admin, erc-channel-user-owner): Supply second argument for associated mode letter. (erc--cusr-status-p, erc--cusr-change-status): New functions for querying and modifying `erc-channel-user' statuses. (erc-send-input-line): Update speaker time in own nick's `erc-channel-member' entry. (erc-get-channel-membership-prefix): Adapt code to prefer advertised prefix for mode letter. (erc--parsed-prefix): Save "reversed" `letters' and `statuses' so that they're ordered from lowest to highest ranked. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status): New functions for massaging hard-coded traditional prefixes so they're compatible with existing `erc-channel-member' update code. (erc-channel-receive-names): Refactor to use new status-aware `erc-channel-member' update and init workhorse functions. (erc--partition-prefixed-names): New function, separated for testing and for conversion to a generic in the near future when ERC supports extensions that list member rolls in a different format. (erc--create-current-channel-member): New "status-aware" function comprising the `addp' portion of `erc-update-current-channel-member'. (erc--update-current-channel-member): New "status-aware" function comprising the "update" portion of `erc-update-current-channel-member', which ran when an existing `erc-channel-member' entry for the queried nick was found. (erc-update-current-channel-member): Split code body into two constituent functions, both for readability and so callers can more explicitly request the desired operation in a "status-aware" manner. (erc--update-membership-prefix): Remove unused function, originally meant to be new in ERC 5.6. (erc--process-channel-modes): Call `erc--cusr-change-status' instead of `erc--update-membership-prefix'. (erc--shuffle-nuh-nickward): New utility so that functions similar to `erc--partition-prefixed-names' can use `erc--parse-nuh' in the near future. * test/lisp/erc/erc-tests.el (erc--parsed-prefix): Reverse expected order of various slot values in `erc--parsed-prefix' objects. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status, erc--cusr-status-p, erc--cusr-change-status): New tests. (erc--update-channel-modes, erc-process-input-line): Use common helpers. (Bug#67220) --- lisp/erc/erc-backend.el | 4 +- lisp/erc/erc-common.el | 25 ++- lisp/erc/erc.el | 361 +++++++++++++++++++++++-------------- test/lisp/erc/erc-tests.el | 122 ++++++++++--- 4 files changed, 344 insertions(+), 168 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 95207e56fd1..2d60ba3c9b0 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2201,7 +2201,9 @@ erc--get-isupport-entry ;; While it's better to depend on interfaces than specific types, ;; using `cl-struct-slot-value' or similar to extract a known slot at ;; runtime would incur a small "ducktyping" tax, which should probably -;; be avoided when running dozens of times per incoming message. +;; be avoided when running hundreds of times per incoming message. +;; Instead of separate keys per data type, we could use a crude +;; logical clock that gets incremented whenever a new 005 arrives. (defmacro erc--with-isupport-data (param var &rest body) "Return structured data stored in VAR for \"ISUPPORT\" PARAM. Expect VAR's value to be an instance of `erc--isupport-data'. If diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e7e70fffd3a..4c5a042a4e3 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -37,6 +37,7 @@ erc-server-users (defvar erc-session-server) (declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc--init-cusr-fallback-status "erc" (v h o a q)) (declare-function erc-get-buffer "erc" (target &optional proc)) (declare-function erc-server-buffer "erc" nil) (declare-function widget-apply-action "wid-edit" (widget &optional event)) @@ -76,11 +77,12 @@ erc-input make-erc-channel-user ( &key voice halfop op admin owner last-message-time - &aux (status (+ (if voice 1 0) - (if halfop 2 0) - (if op 4 0) - (if admin 8 0) - (if owner 16 0))))) + &aux (status + (or + (and (or voice halfop op admin owner) + (erc--init-cusr-fallback-status + voice halfop op admin owner)) + 0)))) :named) "Object containing channel-specific data for a single user." ;; voice halfop op admin owner @@ -140,9 +142,12 @@ erc--isupport-data (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))) + ( letters "vhoaq" :type string + :documentation "Status letters ranked lowest to highest.") + ( statuses "+%@&~" :type string + :documentation "Status prefixes ranked lowest to highest.") + ( alist nil :type (list-of cons) + :documentation "Alist of letters-prefix pairs.")) (cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) "Server-local \"CHANMODES\" data." @@ -594,6 +599,10 @@ erc-define-message-format-catalog (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form)))) `(erc--define-catalog ,language ,entries)) +(define-inline erc--strpos (char string) + "Return position of CHAR in STRING or nil if not found." + (inline-quote (string-search (string ,char) ,string))) + (defmacro erc--doarray (spec &rest body) "Map over ARRAY, running BODY with VAR bound to iteration element. Behave more or less like `seq-doseq', but tailor operations for diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 767a693a52e..5dd820784ce 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -598,28 +598,51 @@ erc-remove-channel-users erc-channel-users) (clrhash erc-channel-users))) -(defmacro erc--define-channel-user-status-compat-getter (name n) +(defmacro erc--define-channel-user-status-compat-getter (name c d) "Define a gv getter for historical `erc-channel-user' status slot NAME. -Expect NAME to be a string and N to be its associated power-of-2 -\"enumerated flag\" integer." +Expect NAME to be a string, C to be its traditionally associated +letter, and D to be its fallback power-of-2 integer." `(defun ,(intern (concat "erc-channel-user-" name)) (u) ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'." name) (declare (gv-setter (lambda (v) (macroexp-let2 nil v v - (,'\`(let ((val (erc-channel-user-status ,',u))) + (,'\`(let ((val (erc-channel-user-status ,',u)) + (n (or (erc--get-prefix-flag ,c) ,d))) (setf (erc-channel-user-status ,',u) (if ,',v - (logior val ,n) - (logand val ,(lognot n)))) + (logior val n) + (logand val (lognot n)))) ,',v)))))) - (= ,n (logand ,n (erc-channel-user-status u))))) - -(erc--define-channel-user-status-compat-getter "voice" 1) -(erc--define-channel-user-status-compat-getter "halfop" 2) -(erc--define-channel-user-status-compat-getter "op" 4) -(erc--define-channel-user-status-compat-getter "admin" 8) -(erc--define-channel-user-status-compat-getter "owner" 16) + (let ((n (or (erc--get-prefix-flag ,c) ,d))) + (= n (logand n (erc-channel-user-status u)))))) + +(erc--define-channel-user-status-compat-getter "voice" ?v 1) +(erc--define-channel-user-status-compat-getter "halfop" ?h 2) +(erc--define-channel-user-status-compat-getter "op" ?o 4) +(erc--define-channel-user-status-compat-getter "admin" ?a 8) +(erc--define-channel-user-status-compat-getter "owner" ?q 16) + +;; This is a generalized version of the compat-oriented getters above. +(defun erc--cusr-status-p (nick-or-cusr letter) + "Return non-nil if NICK-OR-CUSR has channel membership status LETTER." + (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (= n (logand n (erc-channel-user-status cusr))))) + +(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp) + "Add or remove membership status associated with LETTER for NICK-OR-CUSR. +With RESETP, clear the user's status info completely. If ENABLEP +is non-nil, add the status value associated with LETTER." + (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (cl-callf (lambda (v) + (if resetp + (if enablep n 0) + (if enablep (logior v n) (logand v (lognot n))))) + (erc-channel-user-status cusr)))) (defun erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." @@ -3900,6 +3923,10 @@ erc-send-input-line-function (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." + (when-let ((target) + (cmem (erc-get-channel-member (erc-current-nick)))) + (setf (erc-channel-user-last-message-time (cdr cmem)) + (erc-compat--current-lisp-time))) (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -6141,17 +6168,15 @@ erc-get-channel-membership-prefix (catch 'done (pcase-dolist (`(,letter . ,pfx) (erc--parsed-prefix-alist pfx-obj)) - (pcase letter - ((and ?q (guard (erc-channel-user-owner nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "owner"))) - ((and ?a (guard (erc-channel-user-admin nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "admin"))) - ((and ?o (guard (erc-channel-user-op nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "operator"))) - ((and ?h (guard (erc-channel-user-halfop nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "half-op"))) - ((and ?v (guard (erc-channel-user-voice nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "voice"))))) + (when (erc--cusr-status-p nick-or-cusr letter) + (throw 'done + (pcase letter + (?q (propertize (string pfx) 'help-echo "owner")) + (?a (propertize (string pfx) 'help-echo "admin")) + (?o (propertize (string pfx) 'help-echo "operator")) + (?h (propertize (string pfx) 'help-echo "half-op")) + (?v (propertize (string pfx) 'help-echo "voice")) + (_ (string pfx)))))) ""))) (t (cond ((erc-channel-user-owner nick-or-cusr) @@ -6763,12 +6788,52 @@ erc--parsed-prefix ordering intact. If no such parameter has yet arrived, return a stand-in from the fallback value \"(qaohv)~&@%+\"." (erc--with-isupport-data PREFIX erc--parsed-prefix - (let ((alist (nreverse (erc-parse-prefix)))) + (let ((alist (erc-parse-prefix))) (make-erc--parsed-prefix :key key :letters (apply #'string (map-keys alist)) :statuses (apply #'string (map-values alist)) - :alist alist)))) + :alist (nreverse alist))))) + +(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p) + "Return numeric rank for CHAR or nil if unknown. +For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, +and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a +`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to +be a prefix instead." + (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) + (pos (erc--strpos char (if from-prefix-p + (erc--parsed-prefix-statuses obj) + (erc--parsed-prefix-letters obj))))) + (ash 1 pos))) + +(defun erc--init-cusr-fallback-status (voice halfop op admin owner) + "Return channel-membership based on traditional status semantics. +Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into +an internal numeric value suitable for the `status' slot of a new +`erc-channel-user' object." + (let ((pfx (erc--parsed-prefix))) + (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0) + (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0) + (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0) + (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0) + (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0)))) + +(defun erc--compute-cusr-fallback-status (current v h o a q) + "Return current channel membership after toggling V H O A Q as requested. +Assume `erc--parsed-prefix' is non-nil in the current buffer. +Expect status switches V, H, O, A, Q, when non-nil, to be the +symbol `on' or `off'. Return an internal numeric value suitable +for the `status' slot of an `erc-channel-user' object." + (let (on off) + (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off))) + (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off))) + (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off))) + (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off))) + (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off))) + (when on (setq current (apply #'logior current on))) + (when off (setq current (apply #'logand current (mapcar #'lognot off))))) + current) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -6776,48 +6841,40 @@ erc-channel-members-changed-hook :group 'erc-hooks :type 'hook) -(defun erc-channel-receive-names (names-string) - "This function is for internal use only. +(defun erc--partition-prefixed-names (name) + "From NAME, return a list of (STATUS NICK LOGIN HOST). +Expect NAME to be a prefixed name, like @bob." + (unless (string-empty-p name) + (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p)) + (nick (if status (substring name 1) name))) + (unless (string-empty-p nick) + (list status nick nil nil))))) -Update `erc-channel-users' according to NAMES-STRING. -NAMES-STRING is a string listing some of the names on the -channel." - (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))) - (adm-ch (cdr (assq ?a prefix))) - (own-ch (cdr (assq ?q prefix))) - (names (delete "" (split-string names-string))) - name op voice halfop admin owner) - (let ((erc-channel-members-changed-hook nil)) - (dolist (item names) - (let ((updatep t) - (ch (aref item 0))) - (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off) - (if (rassq ch prefix) - (if (= (length item) 1) - (setq updatep nil) - (setq name (substring item 1)) - (setf (pcase ch - ((pred (eq voice-ch)) voice) - ((pred (eq hop-ch)) halfop) - ((pred (eq op-ch)) op) - ((pred (eq adm-ch)) admin) - ((pred (eq own-ch)) owner) - (_ (message "Unknown prefix char `%S'" ch) voice)) - 'on))) - (when updatep +(defun erc-channel-receive-names (names-string) + "Update `erc-channel-members' from NAMES-STRING. +Expect NAMES-STRING to resemble the trailing argument of a 353 +RPL_NAMREPLY. Call internal handlers for parsing individual +names, whose expected composition may differ depending on enabled +extensions." + (let ((names (delete "" (split-string names-string))) + (erc-channel-members-changed-hook nil)) + (dolist (name names) + (when-let ((args (erc--partition-prefixed-names name))) + (pcase-let* ((`(,status ,nick ,login ,host) args) + (cmem (erc-get-channel-user nick))) + (progn ;; If we didn't issue the NAMES request (consider two clients ;; talking to an IRC proxy), `erc-channel-begin-receiving-names' ;; will not have been called, so we have to do it here. (unless erc-channel-new-member-names (erc-channel-begin-receiving-names)) - (puthash (erc-downcase name) t - erc-channel-new-member-names) - (erc-update-current-channel-member - name name t voice halfop op admin owner))))) - (run-hooks 'erc-channel-members-changed-hook))) + (puthash (erc-downcase nick) t erc-channel-new-member-names) + (if cmem + (erc--update-current-channel-member cmem status nil + nick host login) + (erc--create-current-channel-member nick status nil + nick host login))))))) + (run-hooks 'erc-channel-members-changed-hook)) (defun erc-update-user-nick (nick &optional new-nick host login full-name info) @@ -6869,17 +6926,85 @@ erc-update-user (run-hooks 'erc-channel-members-changed-hook)))))) changed)) +(defun erc--create-current-channel-member + (nick status timep &optional new-nick host login full-name info) + "Add an `erc-channel-member' entry for NICK. +Create a new `erc-server-users' entry if necessary, and ensure +`erc-channel-members-changed-hook' runs exactly once, regardless. +Pass STATUS to the `erc-channel-user' constructor. With TIMEP, +assume NICK has just spoken, and initialize `last-message-time'. +Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to +`erc-update-user' if a server user exists and otherwise to the +`erc-server-user' constructor." + (cl-assert (null (erc-get-channel-member nick))) + (let* ((user-changed-p nil) + (down (erc-downcase nick)) + (user (gethash down (erc-with-server-buffer erc-server-users)))) + (if user + (progn + (cl-pushnew (current-buffer) (erc-server-user-buffers user)) + ;; Update *after* ^ so hook has chance to run. + (setf user-changed-p (erc-update-user user new-nick host login + full-name info))) + (erc-add-server-user nick + (setq user (make-erc-server-user + :nickname (or new-nick nick) + :host host + :full-name full-name + :login login + :info nil + :buffers (list (current-buffer)))))) + (let ((cusr (erc-channel-user--make + :status (or status 0) + :last-message-time (and timep + (erc-compat--current-lisp-time))))) + (puthash down (cons user cusr) erc-channel-users)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (unless user-changed-p + (run-hooks 'erc-channel-members-changed-hook)) + t)) + +(defun erc--update-current-channel-member (cmem status timep &rest user-args) + "Update existing `erc-channel-member' entry. +Set the `status' slot of the entry's `erc-channel-user' side to +STATUS and, with TIMEP, update its `last-message-time'. When +actual changes are made, run `erc-channel-members-changed-hook', +and return non-nil." + (cl-assert cmem) + (let ((cusr (cdr cmem)) + (user (car cmem)) + cusr-changed-p user-changed-p) + (when (and status (/= status (erc-channel-user-status cusr))) + (setf (erc-channel-user-status cusr) status + cusr-changed-p t)) + (when timep + (setf (erc-channel-user-last-message-time cusr) + (erc-compat--current-lisp-time))) + ;; Ensure `erc-channel-members-changed-hook' runs on change. + (cl-assert (memq (current-buffer) (erc-server-user-buffers user))) + (setq user-changed-p (apply #'erc-update-user user user-args)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (when (and cusr-changed-p (null user-changed-p)) + (run-hooks 'erc-channel-members-changed-hook)) + (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) + (or cusr-changed-p user-changed-p))) + (defun erc-update-current-channel-member - (nick new-nick &optional addp voice halfop op admin owner host login full-name info - update-message-time) + (nick new-nick &optional addp voice halfop op admin owner host login + full-name info update-message-time) "Update or create entry for NICK in current `erc-channel-members' table. -With ADDP, ensure an entry exists. If one already does, call -`erc-update-user' to handle updates to HOST, LOGIN, FULL-NAME, -INFO, and NEW-NICK. Expect any non-nil membership status -switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the -symbol `on' or `off' when needing to influence a new or existing -`erc-channel-user' object's `status' slot. Likewise, when -UPDATE-MESSAGE-TIME is non-nil, update or initialize the +With ADDP, ensure an entry exists. When an entry does exist or +when ADDP is non-nil and an `erc-server-users' entry already +exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN, +FULL-NAME, and INFO. Expect any non-nil membership +status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be +the symbol `on' or `off' when needing to influence a new or +existing `erc-channel-user' object's `status' slot. Likewise, +when UPDATE-MESSAGE-TIME is non-nil, update or initialize the `last-message-time' slot to the current-time. If changes occur, including creation, run `erc-channel-members-changed-hook'. Return non-nil when meaningful changes, including creation, have @@ -6889,62 +7014,26 @@ erc-update-current-channel-member exists. When it doesn't, assume the sender is a non-joined entity, like the server itself or a historical speaker, or assume the prior buffer for the channel was killed without parting." - (let* (cusr-changed-p - user-changed-p - (cmem (erc-get-channel-member nick)) - (cusr (cdr cmem)) - (down (erc-downcase nick)) - (user (or (car cmem) - (gethash down (erc-with-server-buffer erc-server-users))))) - (if cusr - (progn - (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) - (when-let (((or voice halfop op admin owner)) - (existing (erc-channel-user-status cusr))) - (when voice (setf (erc-channel-user-voice cusr) (eq voice 'on))) - (when halfop (setf (erc-channel-user-halfop cusr) (eq halfop 'on))) - (when op (setf (erc-channel-user-op cusr) (eq op 'on))) - (when admin (setf (erc-channel-user-admin cusr) (eq admin 'on))) - (when owner (setf (erc-channel-user-owner cusr) (eq owner 'on))) - (setq cusr-changed-p (= existing (erc-channel-user-status cusr)))) - (when update-message-time - (setf (erc-channel-user-last-message-time cusr) (current-time))) - ;; Assume `user' exists and its `buffers' slot contains the - ;; current buffer so that `erc-channel-members-changed-hook' - ;; will run if changes are made. - (setq user-changed-p - (erc-update-user user new-nick - host login full-name info))) - (when addp - (if (null user) - (progn - (setq user (make-erc-server-user - :nickname nick - :host host - :full-name full-name - :login login - :info info - :buffers (list (current-buffer)))) - (erc-add-server-user nick user)) - (setf (erc-server-user-buffers user) - (cons (current-buffer) - (erc-server-user-buffers user)))) - (setq cusr (make-erc-channel-user - :voice (and voice (eq voice 'on)) - :halfop (and halfop (eq halfop 'on)) - :op (and op (eq op 'on)) - :admin (and admin (eq admin 'on)) - :owner (and owner (eq owner 'on)) - :last-message-time (if update-message-time - (current-time)))) - (puthash down (cons user cusr) erc-channel-users) - (setq cusr-changed-p t))) - ;; An existing `cusr' was changed or a new one was added, and - ;; `user' was not updated, though possibly just created (since - ;; `erc-update-user' runs this same hook in all a user's buffers). - (when (and cusr-changed-p (null user-changed-p)) - (run-hooks 'erc-channel-members-changed-hook)) - (or cusr-changed-p user-changed-p))) +(let* ((cmem (erc-get-channel-member nick)) + (status (and (or voice halfop op admin owner) + (if cmem + (erc--compute-cusr-fallback-status + (erc-channel-user-status (cdr cmem)) + voice halfop op admin owner) + (erc--init-cusr-fallback-status + (and voice (eq voice 'on)) + (and halfop (eq halfop 'on)) + (and op (eq op 'on)) + (and admin (eq admin 'on)) + (and owner (eq owner 'on))))))) + (if cmem + (erc--update-current-channel-member cmem status update-message-time + new-nick host login + full-name info) + (when addp + (erc--create-current-channel-member nick status update-message-time + new-nick host login + full-name info))))) (defun erc-update-channel-member (channel nick new-nick &optional add voice halfop op admin owner host login @@ -7134,16 +7223,6 @@ 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, @@ -7189,7 +7268,7 @@ erc--process-channel-modes (cond ((= ?+ c) (setq +p t)) ((= ?- c) (setq +p nil)) ((and status-letters (string-search (string c) status-letters)) - (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) + (erc--cusr-change-status (pop args) c +p)) ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) (erc--handle-channel-mode group c +p (and (/= group ?d) @@ -7511,6 +7590,12 @@ erc--parse-nuh (match-string 2 string) (match-string 3 string)))) +(defun erc--shuffle-nuh-nickward (nick login host) + "Interpret results of `erc--parse-nuh', promoting loners to nicks." + (cond (nick (cl-assert (null login)) (list nick login host)) + ((and (null login) host) (list host nil nil)) + ((and login (null host)) (list login nil nil)))) + (defun erc-extract-nick (string) "Return the nick corresponding to a user specification STRING. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 49c72836a22..b51bd67ae04 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -674,7 +674,7 @@ erc--parsed-prefix ;; checking if null beforehand. (should-not erc--parsed-prefix) (should (equal (erc--parsed-prefix) - #s(erc--parsed-prefix nil "qaohv" "~&@%+" + #s(erc--parsed-prefix nil "vhoaq" "+%@&~" ((?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v . ?+))))) (let ((cached (should erc--parsed-prefix))) @@ -696,7 +696,7 @@ 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 ("(ov)@+") "ov" "@+" + #s(erc--parsed-prefix ("(ov)@+") "vo" "+@" ((?o . ?@) (?v . ?+))))) ;; Second target buffer reuses cached value. (with-temp-buffer @@ -714,6 +714,88 @@ erc--parsed-prefix (erc-with-server-buffer erc--parsed-prefix)) '((?q . ?~) (?h . ?%))))))) +(ert-deftest erc--get-prefix-flag () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (should (= (erc--get-prefix-flag ?v) 1)) + (should (= (erc--get-prefix-flag ?h) 2)) + (should (= (erc--get-prefix-flag ?o) 4)) + (should (= (erc--get-prefix-flag ?a) 8)) + (should (= (erc--get-prefix-flag ?q) 16)) + + (ert-info ("With optional `from-prefix-p'") + (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1)) + (should (= (erc--get-prefix-flag ?% nil 'fpp) 2)) + (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4)) + (should (= (erc--get-prefix-flag ?& nil 'fpp) 8)) + (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16))) + (should erc--parsed-prefix)) + +(ert-deftest erc--init-cusr-fallback-status () + ;; Fallback behavior active because no `erc--parsed-prefix'. + (should-not erc--parsed-prefix) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should-not erc--parsed-prefix) ; not created in non-ERC buffer. + + ;; Uses advertised server parameter. + (erc-tests-common-make-server-buf (buffer-name)) + (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-"))) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should erc--parsed-prefix)) + +(ert-deftest erc--compute-cusr-fallback-status () + ;; Useless without an `erc--parsed-prefix'. + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on))) + + (erc-tests-common-make-server-buf (buffer-name)) + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil))) + (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil)))) + +(ert-deftest erc--cusr-status-p () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (let ((cusr (make-erc-channel-user :voice t :op t))) + (should-not (erc--cusr-status-p cusr ?q)) + (should-not (erc--cusr-status-p cusr ?a)) + (should-not (erc--cusr-status-p cusr ?h)) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v))) + (should erc--parsed-prefix)) + +(ert-deftest erc--cusr-change-status () + (erc-tests-common-make-server-buf (buffer-name)) + (let ((cusr (make-erc-channel-user))) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?o t) + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v)) + + (ert-info ("Reset with optional param") + (erc--cusr-change-status cusr ?q t 'reset) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (should (erc--cusr-status-p cusr ?q))) + + (ert-info ("Clear with optional param") + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?q nil 'reset) + (should-not (erc--cusr-status-p cusr ?v)) + (should-not (erc--cusr-status-p cusr ?q))))) + ;; 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 () @@ -737,12 +819,9 @@ erc-parse-modes (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil)))))))) (ert-deftest erc--update-channel-modes () - (erc-mode) + (erc-tests-common-make-server-buf) (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-common-init-server-proc "sleep" "1") (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) calls) @@ -1715,13 +1794,13 @@ erc-extract-command-from-line ;; regardless of whether a command handler is summoned. (ert-deftest erc-process-input-line () - (let (erc-server-last-sent-time - erc-server-flood-queue - (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) - (erc-default-recipients '("#chan")) + (erc-tests-common-make-server-buf) + (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) + (pop-flood-queue (lambda () (erc-with-server-buffer + (pop erc-server-flood-queue)))) calls) - (with-temp-buffer - (erc-tests-common-init-server-proc "sleep" "1") + (setq erc-server-current-nick "tester") + (with-current-buffer (erc--open-target "#chan") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) @@ -1735,49 +1814,50 @@ erc-process-input-line (ert-info ("Baseline") (erc-process-input-line "/msg #chan hi\n") (should (equal (pop calls) " #chan hi")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Quote preserves line intact") (erc-process-input-line "/QUOTE FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Unknown command respected") (erc-process-input-line "/FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "/msg #chan hi you\n") (should (equal (pop calls) " #chan hi you")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line honored") (erc-process-input-line "/msg #chan\n") (should (equal (pop calls) " #chan")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :\r\n" . utf-8))))) (ert-info ("Implicit cmd via `erc-send-input-line-function'") (ert-info ("Baseline") (erc-process-input-line "hi\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "hi you\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line transmitted with injected-space kludge") (erc-process-input-line "\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan : \r\n" . utf-8)))) - (should-not calls)))))) + (should-not calls))))) + (erc-tests-common-kill-buffers)) (ert-deftest erc--get-inserted-msg-beg/basic () (erc-tests-common-assert-get-inserted-msg/basic -- 2.42.0 --=-=-=--