mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 02:31:03 -08:00
Code Issues Projects Releases Wiki Activity

Tether query rolls to channel membership in ERC

Browse source 
* 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)
This commit is contained in:
F. Jason Park 2024-05-08 19:04:13 -07:00
parent 75aefe6514
commit 04477cf97b
4 changed files with 183 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

70
lisp/erc/erc-backend.el
View file

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

3
lisp/erc/erc-common.el
View file

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

43
lisp/erc/erc.el
View file

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

93
test/lisp/erc/erc-scenarios-base-query-participants.el
View file

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