master 04477cf97be 5/8: Tether query rolls to channel membership in ERC

[F. Jason Park]

branch: master
commit 04477cf97be9eb2bb5ae09eff114252864461f05
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Tether query rolls to channel membership in ERC
    
    * lisp/erc/erc-backend.el (erc-server-JOIN): Update query membership
    via `erc--ensure-query-member' when someone else joins a channel.
    (erc-server-NICK): Update query membership via
    `erc--ensure-query-member' after someone else changes their nick.
    (erc-server-PRIVMSG): After printing a query message from some other
    person, remove their nick's data from the query buffer's user table if
    they're "untracked," i.e., not a member of a channel.
    (erc-server-263, erc-server-263-functions): New function and variable,
    a default response handler and hook for "RPL_TRYAGAIN", which servers
    send for things like rejecting "WHO" and "WHOX" responses due to rate
    limiting.
    (erc-server-311): Fix call to `erc-update-user-nick' so the userhost
    login component is no longer supplied as the `info' parameter but
    rather, correctly, as the `login'.
    (erc--extract-352-full-name): Factor out trailing hop-count and GECOS
    parsing for use by overriding handlers or those for adjacent numerics.
    (erc-server-352): Refactor to handle asterisk as `channel' parameter,
    which indicates a nick rather than a channel target.
    (erc-server-366): Update membership in all query buffers via
    `erc--ensure-query-members' after all names have been received.
    (erc-server-401): Forget a known user completely when the server
    reports them as nonexistent.
    * lisp/erc/erc-common.el (erc--get-server-user): New function, a thin
    wrapper around `erc-get-server-user' for cases were inlining would
    require declaring symbols not defined in erc-common.
    * lisp/erc/erc.el (erc-channel-members): Mention that instances are
    used for query-participant tables as well.
    (erc--decouple-query-and-channel-membership-p): New variable, a
    compatibility flag to access pre-5.6 query bookkeeping behavior.
    (erc--ensure-query-member, erc--ensure-query-members): New functions.
    (erc-cmd-QUERY): Ensure parties are present in the query buffer's
    membership table if they're known to be on the server by simple virtue
    of being present in some joined channel.
    (erc-message-english-s352-you): New variable.
    * test/lisp/erc/erc-scenarios-base-query-participants.el
    (erc-scenarios-base-query-participants)
    (erc-scenarios-base-query-participants/legacy): Rename former to
    latter.  Enable compat flag to activate legacy query behavior in which
    channel membership does not impact query membership.
    (erc-scenarios-base-query-participants/coupled): New test asserting
    new behavior in which channel membership dictates query
    membership.  (Bug#70928)
---
 lisp/erc/erc-backend.el                            | 70 +++++++++++-----
 lisp/erc/erc-common.el                             |  3 +
 lisp/erc/erc.el                                    | 43 +++++++++-
 .../erc/erc-scenarios-base-query-participants.el   | 93 +++++++++++++++++++++-
 4 files changed, 183 insertions(+), 26 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 97aab0e25c3..a26cdd50dd7 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -118,6 +118,8 @@
 (defvar erc-nick-change-attempt-count)
 (defvar erc-verbose-server-ping)
 
+(declare-function erc--ensure-query-member "erc" (name))
+(declare-function erc--ensure-query-members "erc" ())
 (declare-function erc--init-channel-modes "erc" (channel raw-args))
 (declare-function erc--open-target "erc" (target))
 (declare-function erc--parse-nuh "erc" (string))
@@ -1781,6 +1783,8 @@ add things to `%s' instead."
                       (list 'JOIN ?n nick ?u login ?h host ?c chnl)))))
           (when buffer (set-buffer buffer))
           (erc-update-channel-member chnl nick nick t nil nil nil nil nil host 
login)
+          (unless (erc-current-nick-p nick)
+            (erc--ensure-query-member nick))
           ;; on join, we want to stay in the new channel buffer
           ;;(set-buffer ob)
           (apply #'erc-display-message parsed 'notice buffer args))))))
@@ -1906,7 +1910,8 @@ Return a list of buffers in which to announce the change."
         (run-hook-with-args 'erc-nick-changed-functions nn nick))
        (t
         (when erc-server-connected
-          (erc-networks--id-reload erc-networks--id proc parsed))
+          (erc-networks--id-reload erc-networks--id proc parsed)
+          (erc--ensure-query-member nn))
         (erc-handle-user-status-change 'nick (list nick login host) (list nn))
         (erc-display-message parsed 'notice bufs 'NICK ?n nick
                              ?u login ?h host ?N nn))))))
@@ -2054,7 +2059,7 @@ like `erc-insert-modify-hook'.")
              (erc--speaker-status-prefix-wanted-p nil)
              (erc-current-message-catalog erc--message-speaker-catalog)
              ;;
-             buffer statusmsg cmem-prefix fnick)
+             finalize buffer statusmsg cmem-prefix fnick)
         (setq buffer (erc-get-buffer (if privp nick tgt) proc))
         ;; Even worth checking for empty target here? (invalid anyway)
         (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0))
@@ -2081,10 +2086,14 @@ like `erc-insert-modify-hook'.")
               (setq buffer (erc--open-target tgt))))))
         (when buffer
           (with-current-buffer buffer
-            (when privp (erc--unhide-prompt))
-            ;; update the chat partner info.  Add to the list if private
-            ;; message.  We will accumulate private identities indefinitely
-            ;; at this point.
+            (when privp
+              (erc--unhide-prompt)
+              ;; Remove untracked query partners after display.
+              (defvar erc--decouple-query-and-channel-membership-p)
+              (unless (or erc--decouple-query-and-channel-membership-p
+                          (erc--get-server-user nick))
+                (setq finalize (lambda ()
+                                 (erc-remove-channel-member buffer nick)))))
             (erc-update-channel-member (if privp nick tgt) nick nick
                                        privp nil nil nil nil nil host login 
nil nil t)
             (defvar erc--cmem-from-nick-function)
@@ -2123,7 +2132,9 @@ like `erc-insert-modify-hook'.")
                   (run-hook-with-args 'erc-echo-notice-always-hook
                                       fmtmsg parsed buffer nick)
                   (run-hook-with-args-until-success
-                   'erc-echo-notice-hook fmtmsg parsed buffer nick))))))))))
+                   'erc-echo-notice-hook fmtmsg parsed buffer nick)))))
+          (when finalize (funcall finalize)))
+        nil))))
 
 (define-erc-response-handler (QUIT)
   "Another user has quit IRC." nil
@@ -2335,6 +2346,9 @@ A server may send more than one 005 message."
 See `erc-display-server-message'." nil
   (erc-display-server-message proc parsed))
 
+(define-erc-response-handler (263) "RPL_TRYAGAIN." nil
+  (erc-handle-unknown-server-response proc parsed))
+
 (define-erc-response-handler (275)
   "Display secure connection message." nil
   (pcase-let ((`(,nick ,_user ,_message)
@@ -2387,7 +2401,7 @@ See `erc-display-server-message'." nil
         (catalog-entry (intern (format "s%s" (erc-response.command parsed)))))
     (pcase-let ((`(,nick ,user ,host)
                  (cdr (erc-response.command-args parsed))))
-      (erc-update-user-nick nick nick host nil fname user)
+      (erc-update-user-nick nick nick host user fname)
       (erc-display-message
        parsed 'notice 'active catalog-entry
        ?n nick ?f fname ?u user ?h host))))
@@ -2549,18 +2563,28 @@ See `erc-display-server-message'." nil
     (erc-display-message parsed 'notice (erc-get-buffer channel proc)
                          's341 ?n nick ?c channel)))
 
-;; FIXME update or add server user instead when channel is "*".
+(defun erc--extract-352-full-name (contents)
+  "Return full name from 352 trailing param, discarding hop count."
+  (pcase contents
+    ((rx (: bot (+ (any "0-9")) " ") (let full-name (group (* nonl))) eot)
+     full-name)
+    (_ contents)))
+
 (define-erc-response-handler (352)
-  "WHO notice." nil
-  (pcase-let ((`(,channel ,user ,host ,_server ,nick ,away-flag)
-               (cdr (erc-response.command-args parsed))))
-    (let ((full-name (erc-response.contents parsed)))
-      (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
-        (setq full-name (match-string 2 full-name)))
-      (erc-update-channel-member channel nick nick nil nil nil nil nil nil 
host user full-name)
-      (erc-display-message parsed 'notice 'active 's352
-                           ?c channel ?n nick ?a away-flag
-                           ?u user ?h host ?f full-name))))
+  "RPL_WHOREPLY response." nil
+  (pcase-let*
+      ((`(,_ ,channel ,user ,host ,_server ,nick ,flags, hop-real)
+        (erc-response.command-args parsed))
+       (full-name (erc--extract-352-full-name hop-real))
+       (selfp (string= channel "*"))
+       (template (if selfp 's352-you 's352)))
+    (if selfp
+        (erc-update-user-nick nick nick host user full-name)
+      (erc-update-channel-member channel nick nick nil nil nil nil nil nil
+                                 host user full-name))
+    (erc-display-message parsed 'notice 'active template
+                         ?c channel ?n nick ?a flags
+                         ?u user ?h host ?f full-name)))
 
 (define-erc-response-handler (353)
   "NAMES notice." nil
@@ -2575,7 +2599,9 @@ See `erc-display-server-message'." nil
 (define-erc-response-handler (366)
   "End of NAMES." nil
   (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc)
-    (erc-channel-end-receiving-names)))
+    (erc-channel-end-receiving-names))
+  (erc--ensure-query-members)
+  nil)
 
 (define-erc-response-handler (367)
   "Channel ban list entries." nil
@@ -2641,7 +2667,9 @@ See `erc-display-server-message'." nil
       (erc-log (format "cmd: WHOWAS: %s" nick/channel))
       (erc-server-send (format "WHOWAS %s 1" nick/channel)))
     (erc-display-message parsed '(notice error) 'active
-                         's401 ?n nick/channel)))
+                         's401 ?n nick/channel)
+    (unless (erc-channel-p nick/channel)
+      (erc-remove-user nick/channel))))
 
 (define-erc-response-handler (402)
   "No such server." nil
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 51a93bdaa50..c01ee6546cb 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -557,6 +557,9 @@ Use the CASEMAPPING ISUPPORT parameter to determine the 
style."
      (gethash (erc-downcase ,nick)
               (erc-with-server-buffer erc-server-users)))))
 
+(defun erc--get-server-user (nick)
+  (erc-get-server-user nick))
+
 (defmacro erc--with-dependent-type-match (type &rest features)
   "Massage Custom :type TYPE with :match function that pre-loads FEATURES."
   `(backquote-list* ',(car type)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4de7f089aaf..5be557dee4a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -509,7 +509,7 @@ Functions are passed a buffer as the first argument."
 
 (defvaralias 'erc-channel-users 'erc-channel-members)
 (defvar-local erc-channel-members nil
-  "Hash table of members in the current channel.
+  "Hash table of members in the current channel or query buffer.
 It associates nicknames with cons cells of the form
 \(SERVER-USER . MEMBER-DATA), where SERVER-USER is a
 `erc-server-user' object and MEMBER-DATA is a `erc-channel-user'
@@ -549,6 +549,37 @@ Adds USER with nickname NICK to the `erc-server-users' 
hash table."
   (erc-with-server-buffer
     (puthash (erc-downcase nick) user erc-server-users)))
 
+(defvar erc--decouple-query-and-channel-membership-p nil
+  "When non-nil, don't tether query participation to channel membership.
+Specifically, add users to query tables when they speak, don't remove
+them when they leave all channels, and allow removing the client's own
+user from `erc-server-users'.  Note that enabling this compatibility
+flag degrades the user experience and isn't guaranteed to correctly
+restore the described historical behavior.")
+
+(defun erc--ensure-query-member (nick)
+  "Populate membership table in query buffer for online NICK."
+  (erc-with-buffer (nick)
+    (when-let (((not erc--decouple-query-and-channel-membership-p))
+               ((zerop (hash-table-count erc-channel-users)))
+               (user (erc-get-server-user nick)))
+      (erc-update-current-channel-member nick nil t)
+      (erc--unhide-prompt)
+      t)))
+
+(defun erc--ensure-query-members ()
+  "Update membership tables in all query buffers.
+Ensure targets with an entry in `erc-server-users' are present in
+`erc-channel-members'."
+  (erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p
+    (when-let (((not erc--decouple-query-and-channel-membership-p))
+               ((zerop (hash-table-count erc-channel-users)))
+               (target (erc-target))
+               ((erc-get-server-user target)))
+      (erc-update-current-channel-member target nil t)
+      (erc--unhide-prompt))
+    erc-server-process))
+
 (defun erc-remove-server-user (nick)
   "This function is for internal use only.
 
@@ -5155,8 +5186,7 @@ just as you provided it.  Use this command with care!"
 
 (defun erc-cmd-QUERY (&optional user)
   "Open a query with USER.
-How the query is displayed (in a new window, frame, etc.) depends
-on the value of `erc-interactive-display'."
+Display the query buffer in accordance with `erc-interactive-display'."
   ;; FIXME: The doc string used to say at the end:
   ;; "If USER is omitted, close the current query buffer if one exists
   ;; - except this is broken now ;-)"
@@ -5172,7 +5202,11 @@ on the value of `erc-interactive-display'."
         (erc--display-context `((erc-interactive-display . /QUERY)
                                 ,@erc--display-context)))
     (erc-with-server-buffer
-     (erc--open-target user))))
+      (if-let ((buffer (erc-get-buffer user erc-server-process)))
+          (prog1 buffer
+            (erc-setup-buffer buffer))
+        (prog1 (erc--open-target user) ; becomes current buffer
+          (erc--ensure-query-member user))))))
 
 (defalias 'erc-cmd-Q #'erc-cmd-QUERY)
 
@@ -9525,6 +9559,7 @@ SOFTP, only do so when defined as a variable."
    (s333   . "%c: topic set by %n, %t")
    (s341   . "Inviting %n to channel %c")
    (s352   . "%-11c %-10n %-4a %u@%h (%f)")
+   (s352-you . "%n %a %u@%h (%f)")
    (s353   . "Users on %c: %u")
    (s367   . "Ban for %b on %c")
    (s367-set-by . "Ban for %b on %c set by %s on %t")
diff --git a/test/lisp/erc/erc-scenarios-base-query-participants.el 
b/test/lisp/erc/erc-scenarios-base-query-participants.el
index 9e9109091ac..30c04974bb6 100644
--- a/test/lisp/erc/erc-scenarios-base-query-participants.el
+++ b/test/lisp/erc/erc-scenarios-base-query-participants.el
@@ -24,7 +24,7 @@
   (let ((load-path (cons (ert-resource-directory) load-path)))
     (require 'erc-scenarios-common)))
 
-(ert-deftest erc-scenarios-base-query-participants ()
+(ert-deftest erc-scenarios-base-query-participants/legacy ()
   :tags '(:expensive-test)
 
   (erc-scenarios-common-with-cleanup
@@ -32,6 +32,7 @@
        (erc-server-flood-penalty 0.1)
        (dumb-server (erc-d-run "localhost" t 'legacy))
        (expect (erc-d-t-make-expecter))
+       (erc--decouple-query-and-channel-membership-p t)
        (port (process-contact dumb-server :service)))
 
     (ert-info ("Connect to foonet")
@@ -113,5 +114,95 @@
         (should-not (erc-get-server-user "bob")) ; missing from query
         (should (erc-get-server-user "dummy"))))))
 
+(ert-deftest erc-scenarios-base-query-participants/coupled ()
+  :tags '(:expensive-test)
+
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/query-participants")
+       (erc-server-flood-penalty 0.1)
+       (dumb-server (erc-d-run "localhost" t 'legacy))
+       (expect (erc-d-t-make-expecter))
+       (port (process-contact dumb-server :service)))
+
+    (ert-info ("Connect to foonet")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester"
+                                :user "tester"
+                                :full-name "tester")
+        (funcall expect 10 "This server is in debug mode")
+        (erc-scenarios-common-say "/query bob")))
+
+    (ert-info ("Opening query on untracked user bob doesn't create entry.")
+      (with-current-buffer "bob"
+        (should-not (erc-get-channel-member "bob"))))
+
+    (ert-info ("DM from untracked user also doesn't create a query entry.")
+      (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy"))
+        (funcall expect 10 "<dummy> hi")
+        (should-not (erc-get-channel-member "dummy"))
+        (should-not (erc-get-server-user "dummy"))))
+
+    (with-current-buffer "foonet"
+      (erc-scenarios-common-say "/join #chan"))
+
+    (ert-info ("Members in new chan added to existing query buffers")
+      (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+        (funcall expect 10 "bob ")) ; bob is present in #chan (353)
+      (with-current-buffer "bob"
+        (should (erc-get-server-user "bob"))
+        ;; Can't assert immediately: must wait until 366 arrives.
+        (erc-d-t-wait-for 10 (erc-get-channel-member "bob"))))
+
+    (ert-info ("Opening query on tracked user creates entry")
+      (with-current-buffer "#chan"
+        (funcall expect 10 " alice") ;; alice is present
+        (erc-scenarios-common-say "hi channel") ; gate
+        (funcall expect 10 "<tester> hi channel")
+        (erc-scenarios-common-say "/query alice"))
+      (with-current-buffer "alice"
+        (should (erc-get-channel-member "alice"))))
+
+    ;; Bob says something.
+    (with-current-buffer "bob"
+      (funcall expect 10 "<bob> hi")
+      (should (erc-get-channel-member "bob")))
+
+    (ert-info ("Query pal parting channel removes them from query")
+      ;; Identical result if they're kicked: they're removed from the
+      ;; server AND their target buffers
+      (with-current-buffer "#chan"
+        (funcall expect 10 "has left")
+        (should-not (erc-get-channel-member "dummy"))
+        (should-not (erc-get-server-user "dummy")))
+      (with-current-buffer "dummy"
+        (should-not (erc-get-channel-member "dummy"))))
+
+    ;; This is unchanged from legacy behavior.
+    (ert-info ("Query pal quitting channel removes them everywhere")
+      (with-current-buffer "#chan"
+        (funcall expect 10 "has quit")
+        (should-not (erc-get-channel-member "bob"))
+        (should-not (erc-get-server-user "bob")))
+      (with-current-buffer "bob"
+        (should-not (erc-get-channel-member "bob"))))
+
+    (ert-info ("Query pal re-joining repopulates query")
+      (with-current-buffer "#chan"
+        (erc-scenarios-common-say "bob gone")
+        (funcall expect 10 "<alice> bob, welcome back!")
+        (should (erc-get-server-user "bob")))
+      (with-current-buffer "bob"
+        (should (erc-get-channel-member "bob"))))
+
+    (ert-info ("Parting removes chan members from server and queries")
+      (with-current-buffer "#chan"
+        (erc-scenarios-common-say "/part")
+        (funcall expect 10 "you have left")
+        (should-not (erc-get-server-user "fsbot"))
+        (should-not (erc-get-server-user "alice")) ; she never said anything
+        (should-not (erc-get-server-user "bob")) ; missing from query
+        (should-not (erc-get-server-user "dummy"))))))
+
 
 ;;; erc-scenarios-base-query-participants.el ends here