Add ERC module querypoll as monitor placeholder

* doc/misc/erc.texi: Add module `querypoll' to list of built-in
modules'.
* etc/ERC-NEWS: Mention new module `querypoll', and explain new
default behavior for deriving query membership from that of channels.
* lisp/erc/erc-goodies.el (erc--querypoll-ring)
(erc--querypoll-timer): New variables.
(erc-querypoll-exclude-regexp): New option.
(erc-querypoll-mode, erc-querypoll-enable, erc-querypoll-disable): New
module for polling with "WHO" requests for the presence of otherwise
"untracked" query targets.
(erc-querypoll-period-params): New variable.
(erc--querypoll-compute-period)
(erc--querypoll-target-in-chan-p)
(erc--querypoll-get-length)
(erc--querypoll-get-next)
(erc--querypoll-subscribe)
(erc--querypoll-on-352)
(erc--querypoll-send): New functions.
* lisp/erc/erc-speedbar.el (erc-speedbar-buttons): Dispatch queries as
if they were channels when `erc--queries-current-p' returns non-nil.
That is, show head counts alongside query targets as users come and
go.
(erc-speedbar-insert-target): Defer to `erc--queries-current-p' to
know whether to show a query in the style of a channel.  This affects
both the plain speedbar integration as well as the `nickbar' module
added for bug#63595.  Also, use question marks rather than the empty
string for query bullets, so that query and channel items are aligned
vertically.
* lisp/erc/erc.el (erc--queries-current-p): New function.
* test/lisp/erc/erc-goodies-tests.el
(erc--querypoll-compute-period)
(erc--querypoll-target-in-chan-p)
(erc--querypoll-get-length)
(erc--querypoll-get-next): New tests.  (Bug#70928)

6 files changed, 292 insertions, 5 deletions

diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 0c7e3b09f41..c7cbf7908b8 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -518,6 +518,10 @@ or your nickname is mentioned
 @item page
 Process CTCP PAGE requests from IRC
 
+@cindex modules, querypoll
+@item querypoll
+Update query participant data by continually polling the server
+
 @cindex modules, readonly
 @item readonly
 Make displayed lines read-only
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index acad0f03572..1fad62e1999 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -100,6 +100,18 @@ one's optionally accessible from the keyboard, just like any other
 side window.  Hit '<RET>' over a nick to spawn a "/QUERY" or a
 "Lastlog" (Occur) session.  See 'erc-nickbar-mode' for more.
 
+** New module to keep tabs on query pals who aren't in your channels.
+ERC has gotten a bit pickier about managing participants in query
+buffers.  "Untracked" correspondents no longer appear automatically in
+membership tables, even if you respond or initiate contact.  Instead,
+ERC only adds and removes participant data when these same users join
+and leave channels.  Anyone uncomfortable with the apparent
+uncertainty this brings can look to the new 'querypoll' module, which
+periodically sends WHO requests to keep track of correspondents.
+Those familiar with the IRCv3 Monitor extension can think of this as
+"fallback code" and a temporary placeholder for the real thing.
+Add 'querypoll' (and 'nickbar') to 'erc-modules' to try it out.
+
 ** Option 'erc-timestamp-use-align-to' more versatile.
 While this option has always offered to right-align stamps via the
 'display' text property, it's now more effective at doing so when set
@@ -563,6 +575,22 @@ redubbed 'erc-channel-members'.  Similarly, the utility function
 'erc-get-channel-user' has been renamed to 'erc-get-channel-member'.
 Expect deprecations of the old names to follow in a future release.
 
+*** Query participant tables now depend on channel membership.
+ERC has always been inconsistent and difficult to predict in its
+handling of records describing other IRC users.  This has made simple
+things like detecting the online status of query peers and the
+presence of one's own user in 'erc-server-users' especially
+unreliable.  From now on, ERC resolves to be more sensible and
+conservative in such areas.  For example, it now retains its own user
+info, once discovered, for the remainder of a session.  It also relies
+solely on channel membership to "drive" query participant information.
+That is, when another IRC user departs their last known channel, any
+queries with them will consider them absent, even if they're likely
+still online.  Anyone with difficulty adapting to this new paradigm
+should contact the mailing list to inquire about associated
+compatibility flags, which can be made public on request.  Also see
+the related news item announcing the module 'querypoll'.
+
 *** The 'erc-channel-user' struct has a changed internally.
 The five boolean slots for membership prefixes have been folded
 ("encoded") into a single integer slot.  However, the old 'setf'-able
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index fe44c3bdfcb..9837ec302ee 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -1114,6 +1114,196 @@ servers.  If called from a program, PROC specifies the server process."
              nil erc-server-process)))
   (multi-occur (erc-buffer-list nil proc) string))
 
+
+;;;; querypoll
+
+(declare-function ring-empty-p "ring" (ring))
+(declare-function ring-insert "ring" (ring item))
+(declare-function ring-insert+extend "ring" (ring item))
+(declare-function ring-length "ring" (ring))
+(declare-function ring-member "ring" (ring item))
+(declare-function ring-ref "ring" (ring index))
+(declare-function ring-remove "ring" (ring &optional index))
+
+(defvar-local erc--querypoll-ring nil)
+(defvar-local erc--querypoll-timer nil)
+
+(defcustom erc-querypoll-exclude-regexp
+  (rx bot (or (: "*" (+ nonl)) (: (+ (in "A-Za-z")) "Serv")) eot)
+  "Pattern to skip polling for bots and services you regularly query."
+  :group 'erc
+  :package-version '(ERC . "5.6")
+  :type 'regexp)
+
+;;;###autoload(autoload 'erc-querypoll-mode "erc-goodies" nil t)
+(define-erc-module querypoll nil
+  "Send periodic \"WHO\" requests for each query buffer.
+Omit query participants who are currently present in some channel.
+Instead of announcing arrivals and departures, rely on other modules,
+like `nickbar', to provide UI feedback when changes occur.
+
+Once ERC implements the `monitor' extension, this module will serve as
+an optional fallback for keeping query-participant rolls up to date on
+servers that lack support or are stingy with their allotments.  Until
+such time, this module should be considered experimental.
+
+This is a local ERC module, so selectively polling only a subset of
+query targets is possible but cumbersome.  To do so, ensure
+`erc-querypoll-mode' is enabled in the server buffer, and then toggle it
+as appropriate in desired query buffers.  To stop polling for the
+current connection, toggle off the command \\[erc-querypoll-mode] from a
+server buffer, or run \\`M-x C-u erc-querypoll-disable RET' from a
+target buffer."
+  ((if erc--target
+       (if (erc-query-buffer-p)
+           (progn ; accommodate those who eschew `erc-modules'
+             (erc-with-server-buffer
+               (unless erc-querypoll-mode
+                 (erc-querypoll-mode +1)))
+             (erc--querypoll-subscribe (current-buffer)))
+         (erc-querypoll-mode -1))
+     (cl-assert (not erc--decouple-query-and-channel-membership-p))
+     (setq-local erc--querypoll-ring (make-ring 5))
+     (erc-with-all-buffers-of-server erc-server-process nil
+       (unless erc-querypoll-mode
+         (erc-querypoll-mode +1)))))
+  ((when erc--querypoll-timer
+     (cancel-timer erc--querypoll-timer))
+   (if erc--target
+       (when-let (((erc-query-buffer-p))
+                  (ring (erc-with-server-buffer erc--querypoll-ring))
+                  (index (ring-member ring (current-buffer)))
+                  ((not (erc--querypoll-target-in-chan-p (current-buffer)))))
+         (ring-remove ring index)
+         (unless (erc-current-nick-p (erc-target))
+           (erc-remove-current-channel-member (erc-target))))
+     (erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p
+       (erc-querypoll-mode -1)))
+   (kill-local-variable 'erc--querypoll-ring)
+   (kill-local-variable 'erc--querypoll-timer))
+  'local)
+
+(cl-defmethod erc--queries-current-p (&context (erc-querypoll-mode (eql t))) t)
+
+(defvar erc-querypoll-period-params '(10 10 1)
+  "Parameters affecting the delay with respect to the number of buffers.
+The elements represent some parameters of an exponential decay function,
+a(e)^{-x/b}+c.  The first number (a) affects the overall scaling.  A
+higher value means longer delays for all query buffers relative to queue
+length.  The second number (b) determines how quickly the delay
+decreases as the queue length increases.  Larger values make the delay
+taper off more gradually.  The last number (c) sets the minimum delay
+between updates regardless of queue length.")
+
+(defun erc--querypoll-compute-period (queue-size)
+  "Calculate delay based on QUEUE-SIZE."
+  (let ((scale (nth 0 erc-querypoll-period-params))
+        (rate (* 1.0 (nth 1 erc-querypoll-period-params)))
+        (min (nth 2 erc-querypoll-period-params)))
+    (+ (* scale (exp (/ (- queue-size) rate))) min)))
+
+(defun erc--querypoll-target-in-chan-p (buffer)
+  "Determine whether buffer's target, as a user, is joined to any channels."
+  (and-let*
+      ((target (erc--target-string (buffer-local-value 'erc--target buffer)))
+       (user (erc-get-server-user target))
+       (buffers (erc-server-user-buffers user))
+       ((seq-some #'erc-channel-p buffers)))))
+
+(defun erc--querypoll-get-length (ring)
+  "Return the effective length of RING, discounting chan members."
+  (let ((count 0))
+    (dotimes (i (ring-length ring))
+      (unless (erc--querypoll-target-in-chan-p (ring-ref ring i))
+        (cl-incf count 1)))
+    count))
+
+(defun erc--querypoll-get-next (ring)
+  (let ((n (ring-length ring)))
+    (catch 'found
+      (while (natnump (cl-decf n))
+        (when-let ((buffer (ring-remove ring))
+                   ((buffer-live-p buffer)))
+          ;; Push back buffers for users joined to some chan.
+          (if (erc--querypoll-target-in-chan-p buffer)
+              (ring-insert ring buffer)
+            (throw 'found buffer)))))))
+
+(defun erc--querypoll-subscribe (query-buffer &optional penalty)
+  "Add QUERY-BUFFER to FIFO and ensure timer is running."
+  (when query-buffer
+    (cl-assert (erc-query-buffer-p query-buffer)))
+  (erc-with-server-buffer
+    (when (and query-buffer
+               (not (with-current-buffer query-buffer
+                      (or (erc-current-nick-p (erc-target))
+                          (string-match erc-querypoll-exclude-regexp
+                                        (erc-target)))))
+               (not (ring-member erc--querypoll-ring query-buffer)))
+      (ring-insert+extend erc--querypoll-ring query-buffer))
+    (unless erc--querypoll-timer
+      (setq erc--querypoll-timer
+            (let* ((length (erc--querypoll-get-length erc--querypoll-ring))
+                   (period (erc--querypoll-compute-period length)))
+              (run-at-time (+ (or penalty 0) period)
+                           nil #'erc--querypoll-send (current-buffer)))))))
+
+(defun erc--querypoll-on-352 (target-nick args)
+  "Add or update `erc-server-users' data for TARGET-NICK from ARGS.
+Then add user to participant rolls in any existing query buffers."
+  (pcase-let
+      ((`(,_ ,channel ,login ,host ,_server ,nick ,_flags, hop-real) args))
+    (when (and (string= channel "*") (erc-nick-equal-p nick target-nick))
+      (if-let ((user (erc-get-server-user nick)))
+          (erc-update-user user nick host login
+                           (erc--extract-352-full-name hop-real))
+        ;; Don't add unless target is already known.
+        (when (erc-get-buffer nick erc-server-process)
+          (erc-add-server-user
+           nick (make-erc-server-user
+                 :nickname nick :login login :host host
+                 :full-name (erc--extract-352-full-name hop-real)))))
+      (erc--ensure-query-member nick)
+      t)))
+
+;; This uses heuristics to associate replies to the initial request
+;; because ERC does not yet support `labeled-response'.
+(defun erc--querypoll-send (server-buffer)
+  "Send a captive \"WHO\" in SERVER-BUFFER."
+  (when (and (buffer-live-p server-buffer)
+             (buffer-local-value 'erc-server-connected server-buffer))
+    (with-current-buffer server-buffer
+      (setq erc--querypoll-timer nil)
+      (if-let ((buffer (erc--querypoll-get-next erc--querypoll-ring)))
+          (letrec
+              ((target (erc--target-string
+                        (buffer-local-value 'erc--target buffer)))
+               (penalty 0)
+               (here-fn (erc-once-with-server-event
+                         "352" (lambda (_ parsed)
+                                 (erc--querypoll-on-352
+                                  target (erc-response.command-args parsed)))))
+               (done-fn (erc-once-with-server-event
+                         "315"
+                         (lambda (_ parsed)
+                           (if (memq here-fn erc-server-352-functions)
+                               (erc-remove-user
+                                (nth 1 (erc-response.command-args parsed)))
+                             (remove-hook 'erc-server-352-functions here-fn t))
+                           (remove-hook 'erc-server-263-functions fail-fn t)
+                           (remove-hook 'erc-server-315-functions done-fn t)
+                           (erc--querypoll-subscribe buffer penalty)
+                           t)))
+               (fail-fn (erc-once-with-server-event
+                         "263"
+                         (lambda (proc parsed)
+                           (setq penalty 60)
+                           (funcall done-fn proc parsed)
+                           t))))
+            (erc-server-send (concat "WHO " target)))
+        (unless (ring-empty-p erc--querypoll-ring)
+          (erc--querypoll-subscribe nil 30))))))
+
 (provide 'erc-goodies)
 
 ;;; erc-goodies.el ends here
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 9cde452be58..d4f91bb363a 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -133,7 +133,7 @@ This will add a speedbar major display mode."
 (defun erc-speedbar-buttons (buffer)
   "Create buttons for speedbar in BUFFER."
   (erase-buffer)
-  (let (serverp chanp queryp)
+  (let (serverp chanp queryp queries-current-p)
     (with-current-buffer buffer
       ;; The function `dframe-help-echo' checks the default value of
       ;; `dframe-help-echo-function' when deciding whether to visit
@@ -145,13 +145,14 @@ This will add a speedbar major display mode."
       (setq-local dframe-help-echo-function #'ignore)
       (setq serverp (erc--server-buffer-p))
       (setq chanp (erc-channel-p (erc-default-target)))
-      (setq queryp (erc-query-buffer-p)))
+      (setq queryp (erc-query-buffer-p)
+            queries-current-p (erc--queries-current-p)))
     (defvar erc-nickbar-mode)
     (cond ((and erc-nickbar-mode (null (get-buffer-window speedbar-buffer)))
            (run-at-time 0 nil #'erc-nickbar-mode -1))
           (serverp
            (erc-speedbar-channel-buttons nil 0 buffer))
-          (chanp
+          ((or chanp (and queryp queries-current-p))
            (erc-speedbar-insert-target buffer 0)
            (forward-line -1)
            (erc-speedbar-expand-channel "+" buffer 0))
@@ -205,7 +206,8 @@ This will add a speedbar major display mode."
           t)))))
 
 (defun erc-speedbar-insert-target (buffer depth)
-  (if (erc--target-channel-p (buffer-local-value 'erc--target buffer))
+  (if (with-current-buffer buffer
+        (or (erc--target-channel-p erc--target) (erc--queries-current-p)))
       (progn
         (speedbar-make-tag-line
          'bracket ?+ 'erc-speedbar-expand-channel buffer
@@ -218,8 +220,9 @@ This will add a speedbar major display mode."
             (speedbar-add-indicator (format "(%d)" (hash-table-count table)))
             (rx "(" (+ (any "0-9")) ")"))))
     ;; Query target
+    (cl-assert (erc-query-buffer-p buffer))
     (speedbar-make-tag-line
-     nil nil nil nil
+     'bracket ?? nil nil
      (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
      depth)))
 
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 565f18163df..b375df1edb6 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -557,6 +557,11 @@ 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.")
 
+(cl-defmethod erc--queries-current-p ()
+  "Return non-nil if ERC actively updates query manifests."
+  (and (not erc--decouple-query-and-channel-membership-p)
+       (erc-query-buffer-p) (erc-get-channel-member (erc-target))))
+
 (defun erc--ensure-query-member (nick)
   "Populate membership table in query buffer for online NICK."
   (erc-with-buffer (nick)
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index 7cbaa39d3f7..ead0bf5a979 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -609,4 +609,61 @@
      (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
 
 
+;;;; querypoll
+
+(ert-deftest erc--querypoll-compute-period ()
+  (should (equal (mapcar (lambda (i)
+                           (/ (round (* 100 (erc--querypoll-compute-period i)))
+                              100.0))
+                         (number-sequence 0 10))
+                 '(11.0 10.05 9.19 8.41 7.7 7.07 6.49 5.97 5.49 5.07 4.68))))
+
+(declare-function ring-insert "ring" (ring item))
+
+(ert-deftest erc--querypoll-target-in-chan-p ()
+  (erc-tests-common-make-server-buf)
+  (with-current-buffer (erc--open-target "#chan")
+    (erc-update-current-channel-member "bob" "bob" 'addp))
+
+  (with-current-buffer (erc--open-target "bob")
+    (should (erc--querypoll-target-in-chan-p (current-buffer))))
+
+  (with-current-buffer (erc--open-target "alice")
+    (should-not (erc--querypoll-target-in-chan-p (current-buffer))))
+
+  (when noninteractive
+    (erc-tests-common-kill-buffers)))
+
+(ert-deftest erc--querypoll-get-length ()
+  (erc-tests-common-make-server-buf)
+  (with-current-buffer (erc--open-target "#chan")
+    (erc-update-current-channel-member "bob" "bob" 'addp))
+
+  (let ((ring (make-ring 5)))
+    (ring-insert ring (with-current-buffer (erc--open-target "bob")))
+    (should (= 0 (erc--querypoll-get-length ring)))
+    (ring-insert ring (with-current-buffer (erc--open-target "alice")))
+    (should (= 1 (erc--querypoll-get-length ring))))
+
+  (when noninteractive
+    (erc-tests-common-kill-buffers)))
+
+(ert-deftest erc--querypoll-get-next ()
+  (erc-tests-common-make-server-buf)
+  (with-current-buffer (erc--open-target "#chan")
+    (erc-update-current-channel-member "bob" "bob" 'addp)
+    (erc-update-current-channel-member "alice" "alice" 'addp))
+
+  (let ((ring (make-ring 5)))
+    (ring-insert ring (with-current-buffer (erc--open-target "bob")))
+    (ring-insert ring (with-current-buffer (erc--open-target "dummy")))
+    (ring-insert ring (with-current-buffer (erc--open-target "alice")))
+    (ring-insert ring (with-current-buffer (erc--open-target "tester")))
+    (kill-buffer (get-buffer "dummy"))
+
+    (should (eq (get-buffer "tester") (erc--querypoll-get-next ring))))
+
+  (when noninteractive
+    (erc-tests-common-kill-buffers)))
+
 ;;; erc-goodies-tests.el ends here