mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-09-02 01:35:32 +00:00
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)
This commit is contained in:
parent
5f84213c98
commit
6888bbbe83
6 changed files with 292 additions and 5 deletions
|
@ -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
|
||||
|
|
28
etc/ERC-NEWS
28
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue