aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorF. Jason Park2024-04-01 15:27:47 -0700
committerF. Jason Park2024-04-07 12:59:21 -0700
commite0df2841fb78251d5461a17e2d9be581c152bdc2 (patch)
treec69f5b6ad1b26189ba196bec9a4e18e1435a638b
parentc1266d355a2801271f2f875a1f7d47030c6c0e7a (diff)
downloademacs-e0df2841fb78251d5461a17e2d9be581c152bdc2.tar.gz
emacs-e0df2841fb78251d5461a17e2d9be581c152bdc2.zip
Allow updating of /IGNORE timeouts in ERC
* lisp/erc/erc.el (erc--read-time-period, erc--decode-time-period): Move body of former, now a superficial wrapper, to latter, a new function. (erc--format-time-period): New function. (erc--get-ignore-timer-args): New function. (erc--find-ignore-timer): New function to search through `timer-list' to find matching ignore timer. (erc-cmd-IGNORE): Refactor and redo doc string. Add new optional `timespec' parameter, primarily to aid in testing. Update an existing timer instead of always creating one, and display time remaining in "ignore list" output. Pass server buffer instead of current buffer to timer callbacks because `erc--unignore-user' displays its messages in the `active' buffer, not necessarily the issuing one. Note that doing this does discard potentially useful information, so if ever reverting, we can change the `cl-find' :test in `erc--find-ignore-timer' to something that compares the `erc-server-process' of both buffers. ;; ;; Something like: ;; ;; (defun erc--ignore-timers-equal-p (a b) ;; (and (equal (car a) (car b)) ;; (eq (buffer-local-value 'erc-server-process (cadr a)) ;; (buffer-local-value 'erc-server-process (cadr b))))) ;; (erc-cmd-UNIGNORE): Pass `erc-ignore-list' member matching `user' parameter to `erc--unignore-user' instead of original, raw parameter, along with the server buffer. (erc--unignore-user): Cancel existing timer and don't bother switching to server buffer since we're already there. (erc-message-english-ignore-list): New variable. * test/lisp/erc/erc-scenarios-ignore.el: New file. * test/lisp/erc/erc-tests.el (erc--read-time-period): New test. (erc-cmd-UNIGNORE): New test. (Bug#70127)
-rw-r--r--lisp/erc/erc.el92
-rw-r--r--test/lisp/erc/erc-scenarios-ignore.el79
-rw-r--r--test/lisp/erc/erc-tests.el28
3 files changed, 176 insertions, 23 deletions
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0750463a4e7..4ed77655f19 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4191,8 +4191,11 @@ If there's no letter spec, the input is interpreted as a number of seconds.
4191 4191
4192If input is blank, this function returns nil. Otherwise it 4192If input is blank, this function returns nil. Otherwise it
4193returns the time spec converted to a number of seconds." 4193returns the time spec converted to a number of seconds."
4194 (let ((period (string-trim 4194 (erc--decode-time-period
4195 (read-string prompt nil 'erc--read-time-period-history)))) 4195 (string-trim (read-string prompt nil 'erc--read-time-period-history))))
4196
4197(defun erc--decode-time-period (period)
4198 (progn ; unprogn on next major refactor
4196 (cond 4199 (cond
4197 ;; Blank input. 4200 ;; Blank input.
4198 ((zerop (length period)) 4201 ((zerop (length period))
@@ -4223,36 +4226,76 @@ returns the time spec converted to a number of seconds."
4223 (user-error "%s is not a valid time period" period)) 4226 (user-error "%s is not a valid time period" period))
4224 (decoded-time-period time)))))) 4227 (decoded-time-period time))))))
4225 4228
4226(defun erc-cmd-IGNORE (&optional user) 4229(defun erc--format-time-period (secs)
4227 "Ignore USER. This should be a regexp matching nick!user@host. 4230 "Return a string with hour/minute/second labels for duration in SECS."
4228If no USER argument is specified, list the contents of `erc-ignore-list'." 4231 (let* ((hours (floor secs 3600))
4232 (minutes (floor (mod secs 3600) 60))
4233 (seconds (mod secs 60)))
4234 (cond ((>= secs 3600) (format "%dh%dm%ds" hours minutes (floor seconds)))
4235 ((>= secs 60) (format "%dm%ds" minutes (floor seconds)))
4236 (t (format "%ds" (floor seconds))))))
4237
4238(defun erc--get-ignore-timer-args (inst)
4239 ;; The `cl-struct' `pcase' pattern and `cl-struct-slot-value' emit
4240 ;; warnings when compiling because `timer' is un-`:named'.
4241 (when (and (timerp inst)
4242 (eq (aref inst (cl-struct-slot-offset 'timer 'function))
4243 'erc--unignore-user))
4244 (aref inst (cl-struct-slot-offset 'timer 'args))))
4245
4246(defun erc--find-ignore-timer (&rest args)
4247 "Find an existing ignore timer."
4248 (cl-find args timer-list :key #'erc--get-ignore-timer-args :test #'equal))
4249
4250(defun erc-cmd-IGNORE (&optional user timespec)
4251 "Drop messages from senders, like nick!user@host, matching regexp USER.
4252With human-readable TIMESPEC, ignore messages from matched senders for
4253the specified duration, like \"20m\". Without USER, list the contents
4254of `erc-ignore-list'."
4229 (if user 4255 (if user
4230 (let ((quoted (regexp-quote user))) 4256 (let ((quoted (regexp-quote user))
4257 (prompt "Add a timeout? (Blank for no, or a time spec like 2h): ")
4258 timeout msg)
4231 (when (and (not (string= user quoted)) 4259 (when (and (not (string= user quoted))
4232 (y-or-n-p (format "Use regexp-quoted form (%s) instead? " 4260 (y-or-n-p (format "Use regexp-quoted form (%s) instead? "
4233 quoted))) 4261 quoted)))
4234 (setq user quoted)) 4262 (setq user quoted))
4235 (let ((timeout 4263 (unless timespec
4236 (erc--read-time-period 4264 (setq timespec
4237 "Add a timeout? (Blank for no, or a time spec like 2h): ")) 4265 (read-string prompt nil 'erc--read-time-period-history)))
4238 (buffer (current-buffer))) 4266 (setq timeout (erc--decode-time-period (string-trim timespec))
4267 msg (if timeout
4268 (format "Now ignoring %s for %s" user
4269 (erc--format-time-period timeout))
4270 (format "Now ignoring %s" user)))
4271 (erc-with-server-buffer
4239 (when timeout 4272 (when timeout
4240 (run-at-time timeout nil 4273 (if-let ((existing (erc--find-ignore-timer user (current-buffer))))
4241 (lambda () 4274 (timer-set-time existing (timer-relative-time nil timeout))
4242 (erc--unignore-user user buffer)))) 4275 (run-at-time timeout nil #'erc--unignore-user user
4243 (erc-display-message nil 'notice 'active 4276 (current-buffer))))
4244 (format "Now ignoring %s" user)) 4277 (erc-display-message nil 'notice 'active msg)
4245 (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))) 4278 (cl-pushnew user erc-ignore-list :test #'equal)))
4246 (if (null (erc-with-server-buffer erc-ignore-list)) 4279 (if (null (erc-with-server-buffer erc-ignore-list))
4247 (erc-display-message nil 'notice 'active "Ignore list is empty") 4280 (erc-display-message nil 'notice 'active "Ignore list is empty")
4248 (erc-display-message nil 'notice 'active "Ignore list:") 4281 (erc-display-message nil 'notice 'active "Ignore list:")
4249 (mapc (lambda (item) 4282 (erc-with-server-buffer
4250 (erc-display-message nil 'notice 'active item)) 4283 (let ((seen (copy-sequence erc-ignore-list)))
4251 (erc-with-server-buffer erc-ignore-list)))) 4284 (dolist (timer timer-list)
4285 (when-let ((args (erc--get-ignore-timer-args timer))
4286 ((eq (current-buffer) (nth 1 args)))
4287 (user (car args))
4288 (delta (- (timer-until timer (current-time))))
4289 (duration (erc--format-time-period delta)))
4290 (setq seen (delete user seen))
4291 (erc-display-message nil 'notice 'active 'ignore-list
4292 ?p user ?s duration)))
4293 (dolist (pattern seen)
4294 (erc-display-message nil 'notice 'active pattern))))))
4252 t) 4295 t)
4253 4296
4254(defun erc-cmd-UNIGNORE (user) 4297(defun erc-cmd-UNIGNORE (user)
4255 "Remove the user specified in USER from the ignore list." 4298 "Remove the first pattern in `erc-ignore-list' matching USER."
4256 (let ((ignored-nick (car (erc-with-server-buffer 4299 (let ((ignored-nick (car (erc-with-server-buffer
4257 (erc-member-ignore-case (regexp-quote user) 4300 (erc-member-ignore-case (regexp-quote user)
4258 erc-ignore-list))))) 4301 erc-ignore-list)))))
@@ -4264,16 +4307,18 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
4264 (erc-display-message nil 'notice 'active 4307 (erc-display-message nil 'notice 'active
4265 (format "%s is not currently ignored!" user)))) 4308 (format "%s is not currently ignored!" user))))
4266 (when ignored-nick 4309 (when ignored-nick
4267 (erc--unignore-user user (current-buffer)))) 4310 (erc--unignore-user ignored-nick (erc-server-buffer))))
4268 t) 4311 t)
4269 4312
4270(defun erc--unignore-user (user buffer) 4313(defun erc--unignore-user (user buffer)
4271 (when (buffer-live-p buffer) 4314 (when (buffer-live-p buffer)
4272 (with-current-buffer buffer 4315 (with-current-buffer buffer
4316 (cl-assert (erc--server-buffer-p))
4273 (erc-display-message nil 'notice 'active 4317 (erc-display-message nil 'notice 'active
4274 (format "No longer ignoring %s" user)) 4318 (format "No longer ignoring %s" user))
4275 (erc-with-server-buffer 4319 (setq erc-ignore-list (delete user erc-ignore-list))
4276 (setq erc-ignore-list (delete user erc-ignore-list)))))) 4320 (when-let ((existing (erc--find-ignore-timer user buffer)))
4321 (cancel-timer existing)))))
4277 4322
4278(defvar erc--pre-clear-functions nil 4323(defvar erc--pre-clear-functions nil
4279 "Abnormal hook run when truncating buffers. 4324 "Abnormal hook run when truncating buffers.
@@ -9299,6 +9344,7 @@ SOFTP, only do so when defined as a variable."
9299 . "\n\n*** Connection failed! Re-establishing connection...\n") 9344 . "\n\n*** Connection failed! Re-establishing connection...\n")
9300 (disconnected-noreconnect 9345 (disconnected-noreconnect
9301 . "\n\n*** Connection failed! Not re-establishing connection.\n") 9346 . "\n\n*** Connection failed! Not re-establishing connection.\n")
9347 (ignore-list . "%-8p %s")
9302 (reconnecting . "Reconnecting in %ms: attempt %i/%n ...") 9348 (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
9303 (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...") 9349 (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
9304 (finished . "\n\n*** ERC finished ***\n") 9350 (finished . "\n\n*** ERC finished ***\n")
diff --git a/test/lisp/erc/erc-scenarios-ignore.el b/test/lisp/erc/erc-scenarios-ignore.el
new file mode 100644
index 00000000000..1142bbef14d
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-ignore.el
@@ -0,0 +1,79 @@
1;;; erc-scenarios-ignore.el --- /IGNORE scenarios ERC -*- lexical-binding: t -*-
2
3;; Copyright (C) 2024 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; TODO add test covering the same ignored speaker in two different
23;; channels on the same server: they should be ignored in both.
24
25;;; Code:
26
27(require 'ert-x)
28(eval-and-compile
29 (let ((load-path (cons (ert-resource-directory) load-path)))
30 (require 'erc-scenarios-common)))
31
32(ert-deftest erc-scenarios-ignore/basic ()
33 :tags '(:expensive-test)
34 (erc-scenarios-common-with-cleanup
35 ((erc-scenarios-common-dialog "base/assoc/multi-net")
36 (erc-server-flood-penalty 0.1)
37 (dumb-server-foonet (erc-d-run "localhost" t 'foonet))
38 (dumb-server-barnet (erc-d-run "localhost" t 'barnet))
39 (erc-autojoin-channels-alist '((foonet "#chan") (barnet "#chan")))
40 (port-foonet (process-contact dumb-server-foonet :service))
41 (port-barnet (process-contact dumb-server-barnet :service))
42 (expect (erc-d-t-make-expecter)))
43
44 (ert-info ("Connect to two networks")
45 (with-current-buffer (erc :server "127.0.0.1"
46 :port port-barnet
47 :nick "tester"
48 :password "changeme"
49 :full-name "tester"))
50 (with-current-buffer (erc :server "127.0.0.1"
51 :port port-foonet
52 :nick "tester"
53 :password "changeme"
54 :full-name "tester")
55 (funcall expect 10 "debug mode")))
56
57 (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@foonet"))
58 (funcall expect 10 "<bob> tester, welcome!")
59 (funcall expect 10 "<alice> tester, welcome!")
60 (erc-scenarios-common-say "/ignore alice 1m")
61 (erc-scenarios-common-say "/ignore mike 1h")
62 (funcall expect 10 "ignoring alice for 1m0s")
63 (funcall expect 10 "<bob> alice: Signior Iachimo")
64 (erc-scenarios-common-say "/ignore")
65 (funcall expect 10 "alice 59s")
66 (funcall expect 10 "mike 59m59s")
67 (funcall expect -0.1 "<alice>")
68 (funcall expect 10 "<bob> alice: The ground is bloody")
69 (erc-scenarios-common-say "/unignore alice")
70 (funcall expect 10 "<alice>"))
71
72 ;; No <mike> messages were ignored on network barnet.
73 (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet"))
74 (funcall expect 10 "<mike> tester, welcome!")
75 (funcall expect 10 "<joe> tester, welcome!")
76 (funcall expect 10 "<mike> joe: Whipp'd")
77 (funcall expect 10 "<mike> joe: Double"))))
78
79;;; erc-scenarios-ignore.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 3e8ddef3731..22432a68034 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -50,6 +50,34 @@
50 (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) 50 (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
51 (should (equal (erc--read-time-period "foo: ") 86400)))) 51 (should (equal (erc--read-time-period "foo: ") 86400))))
52 52
53(ert-deftest erc--format-time-period ()
54 (should (equal (erc--format-time-period 59) "59s"))
55 (should (equal (erc--format-time-period 59.9) "59s"))
56 (should (equal (erc--format-time-period 60) "1m0s"))
57 (should (equal (erc--format-time-period 119) "1m59s"))
58 (should (equal (erc--format-time-period 119.9) "1m59s"))
59 (should (equal (erc--format-time-period 120.9) "2m0s"))
60 (should (equal (erc--format-time-period 3599.9) "59m59s"))
61 (should (equal (erc--format-time-period 3600) "1h0m0s")))
62
63;; This asserts that the first pattern on file matching a supplied
64;; `user' parameter will be removed after confirmation.
65(ert-deftest erc-cmd-UNIGNORE ()
66 ;; XXX these functions mutate `erc-ignore-list' via `delete'.
67 (should (local-variable-if-set-p 'erc-ignore-list))
68 (erc-tests-common-make-server-buf)
69
70 (setq erc-ignore-list (list ".")) ; match anything
71 (ert-simulate-keys (list ?\r)
72 (erc-cmd-IGNORE "abc"))
73 (should (equal erc-ignore-list (list "abc" ".")))
74
75 (cl-letf (((symbol-function 'y-or-n-p) #'always))
76 (erc-cmd-UNIGNORE "abcdef")
77 (should (equal erc-ignore-list (list ".")))
78 (erc-cmd-UNIGNORE "foo"))
79 (should-not erc-ignore-list))
80
53(ert-deftest erc-with-all-buffers-of-server () 81(ert-deftest erc-with-all-buffers-of-server ()
54 (let (proc-exnet 82 (let (proc-exnet
55 proc-onet 83 proc-onet