mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Add ERC module querypoll as monitor placeholder

Browse source 
* 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:
F. Jason Park 2024-05-22 22:59:54 -07:00
parent 5f84213c98
commit 6888bbbe83
6 changed files with 292 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

190
lisp/erc/erc-goodies.el
View file

@ -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

13
lisp/erc/erc-speedbar.el
View file

@ -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)))

5
lisp/erc/erc.el
View file

@ -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)