diff options
| author | F. Jason Park | 2024-06-05 00:22:28 -0700 |
|---|---|---|
| committer | F. Jason Park | 2024-06-08 12:21:14 -0700 |
| commit | f6bfa1844b53d6ccd24fd02092ae482d481fc5a5 (patch) | |
| tree | 030032b2370b6fa1197db8f24f50cba69ec32f8b | |
| parent | 772fb960a948b6951f24442b372ce6833887669b (diff) | |
| download | emacs-f6bfa1844b53d6ccd24fd02092ae482d481fc5a5.tar.gz emacs-f6bfa1844b53d6ccd24fd02092ae482d481fc5a5.zip | |
Restore deferred date-stamp insertions in ERC
* lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect): Treat
`erc-stamp--deferred-date-stamp' as a permanent-local variable.
(erc-stamp--date): Document expected possible values for `fn' slot.
(erc-stamp--defer-date-insertion-on-post-modify): Use the function
`ignore' to mean a new `erc-timer-hook' member has been requested.
Use nil to mean one has already run. Deferred date stamps are new in
ERC 5.6 and Emacs 30.
(erc-stamp--date-mode): Improve doc string.
* test/lisp/erc/erc-scenarios-stamp.el
(erc-scenarios-stamp--date-mode/reconnect): New test.
| -rw-r--r-- | lisp/erc/erc-stamp.el | 28 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-stamp.el | 46 |
2 files changed, 70 insertions, 4 deletions
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a9ffdb18ba7..7788f0b2d68 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el | |||
| @@ -203,6 +203,7 @@ from entering them and instead jump over them." | |||
| 203 | (dolist (var '(erc-timestamp-last-inserted | 203 | (dolist (var '(erc-timestamp-last-inserted |
| 204 | erc-timestamp-last-inserted-left | 204 | erc-timestamp-last-inserted-left |
| 205 | erc-timestamp-last-inserted-right | 205 | erc-timestamp-last-inserted-right |
| 206 | erc-stamp--deferred-date-stamp | ||
| 206 | erc-stamp--date-stamps)) | 207 | erc-stamp--date-stamps)) |
| 207 | (when-let (existing (alist-get var priors)) | 208 | (when-let (existing (alist-get var priors)) |
| 208 | (set var existing))))) | 209 | (set var existing))))) |
| @@ -668,7 +669,9 @@ value of t means the option's value doesn't require trimming.") | |||
| 668 | :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.") | 669 | :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.") |
| 669 | ( str (error "Missing `str' field") :type string | 670 | ( str (error "Missing `str' field") :type string |
| 670 | :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.") | 671 | :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.") |
| 671 | ( fn nil :type (or null function) | 672 | ( fn #'ignore :type (or null function) |
| 673 | ;; Use `ignore' as a third state to mean the creation of a bespoke | ||
| 674 | ;; date-insertion function has been requested but not completed. | ||
| 672 | :documentation "Deferred insertion function created by post-modify hook.") | 675 | :documentation "Deferred insertion function created by post-modify hook.") |
| 673 | ( marker (make-marker) :type marker | 676 | ( marker (make-marker) :type marker |
| 674 | :documentation "Insertion marker.")) | 677 | :documentation "Insertion marker.")) |
| @@ -701,6 +704,9 @@ Non-nil between insertion-modification and \"done\" (or timer) hook.") | |||
| 701 | (defun erc-stamp--find-insertion-point (p target-time) | 704 | (defun erc-stamp--find-insertion-point (p target-time) |
| 702 | "Scan buffer backwards from P looking for TARGET-TIME. | 705 | "Scan buffer backwards from P looking for TARGET-TIME. |
| 703 | Return P or, if found, a position less than P." | 706 | Return P or, if found, a position less than P." |
| 707 | ;; Continue searching after encountering a message without a | ||
| 708 | ;; timestamp because date stamps must be unique, and | ||
| 709 | ;; "Re-establishing connection" messages should have stamps. | ||
| 704 | (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) | 710 | (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) |
| 705 | (qq (erc--get-inserted-msg-beg q)) | 711 | (qq (erc--get-inserted-msg-beg q)) |
| 706 | (ts (get-text-property qq 'erc--ts)) | 712 | (ts (get-text-property qq 'erc--ts)) |
| @@ -720,7 +726,7 @@ inserted is a date stamp." | |||
| 720 | Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are | 726 | Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are |
| 721 | non-nil." | 727 | non-nil." |
| 722 | (when-let ((data erc-stamp--deferred-date-stamp) | 728 | (when-let ((data erc-stamp--deferred-date-stamp) |
| 723 | ((null (erc-stamp--date-fn data))) | 729 | ((eq (erc-stamp--date-fn data) #'ignore)) |
| 724 | (ct (erc-stamp--date-ts data)) | 730 | (ct (erc-stamp--date-ts data)) |
| 725 | (rendered (erc-stamp--date-str data)) | 731 | (rendered (erc-stamp--date-str data)) |
| 726 | (buffer (current-buffer)) | 732 | (buffer (current-buffer)) |
| @@ -730,7 +736,7 @@ non-nil." | |||
| 730 | (fset symbol | 736 | (fset symbol |
| 731 | (lambda (&rest _) | 737 | (lambda (&rest _) |
| 732 | (remove-hook hook-var symbol) | 738 | (remove-hook hook-var symbol) |
| 733 | (setf (erc-stamp--date-fn data) #'ignore) | 739 | (setf (erc-stamp--date-fn data) nil) |
| 734 | (when (buffer-live-p buffer) | 740 | (when (buffer-live-p buffer) |
| 735 | (with-current-buffer buffer | 741 | (with-current-buffer buffer |
| 736 | (setq erc-stamp--date-stamps | 742 | (setq erc-stamp--date-stamps |
| @@ -770,7 +776,21 @@ non-nil." | |||
| 770 | ;; a standalone module to allow completely decoupling from and | 776 | ;; a standalone module to allow completely decoupling from and |
| 771 | ;; possibly deprecating `erc-insert-timestamp-left-and-right'. | 777 | ;; possibly deprecating `erc-insert-timestamp-left-and-right'. |
| 772 | (define-minor-mode erc-stamp--date-mode | 778 | (define-minor-mode erc-stamp--date-mode |
| 773 | "Insert date stamps as standalone messages." | 779 | "When enabled, insert date stamps as standalone messages. |
| 780 | Only do so when `erc-insert-timestamp-function' is set to | ||
| 781 | `erc-insert-timestamp-left-and-right'. On `erc-insert-modify-hook', | ||
| 782 | hold off on inserting a date stamp immediately because that would force | ||
| 783 | other members of the hook to rely on heuristics and implementation | ||
| 784 | details to detect a prepended stamp's presence, not to mention | ||
| 785 | compromise the integrity of the `erc-parsed' text property. Instead, | ||
| 786 | tell `erc-insert-post-hook', via `erc-stamp--deferred-date-stamp', to | ||
| 787 | schedule a date stamp for insertion on the next go around of | ||
| 788 | `erc-timer-hook', which only runs on server-sent messages. Expect users | ||
| 789 | to know that non-server-sent messages, such as local informational | ||
| 790 | messages, won't induce a date stamp's insertion but will instead defer | ||
| 791 | it until the next arrival, which can include \"PING\"s or messages that | ||
| 792 | otherwise don't insert anything, such as those skipped on account of | ||
| 793 | `erc-ignore'." | ||
| 774 | :interactive nil | 794 | :interactive nil |
| 775 | (if erc-stamp--date-mode | 795 | (if erc-stamp--date-mode |
| 776 | (progn | 796 | (progn |
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index 6f2fbc1b7e9..2e836e163bc 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el | |||
| @@ -180,4 +180,50 @@ | |||
| 180 | 180 | ||
| 181 | (funcall expect 5 "This server is in debug mode"))))) | 181 | (funcall expect 5 "This server is in debug mode"))))) |
| 182 | 182 | ||
| 183 | ;; Assert that only one date stamp per day appears in the server | ||
| 184 | ;; buffer when reconnecting. | ||
| 185 | (ert-deftest erc-scenarios-stamp--date-mode/reconnect () | ||
| 186 | :tags '(:expensive-test) | ||
| 187 | (erc-scenarios-common-with-cleanup | ||
| 188 | ((erc-scenarios-common-dialog "base/reconnect") | ||
| 189 | (erc-server-flood-penalty 0.1) | ||
| 190 | (erc-stamp--tz t) | ||
| 191 | (erc-server-auto-reconnect t) | ||
| 192 | ;; Start close to midnight: 2024-06-02T23:58:11.055Z | ||
| 193 | (erc-stamp--current-time (if (< emacs-major-version 29) | ||
| 194 | '(26205 1811 55000 0) | ||
| 195 | '(1717372691055 . 1000))) | ||
| 196 | (erc-insert-post-hook (cons (lambda () | ||
| 197 | (setq erc-stamp--current-time | ||
| 198 | (time-add erc-stamp--current-time 0.1))) | ||
| 199 | erc-insert-post-hook)) | ||
| 200 | (dumb-server (erc-d-run "localhost" t | ||
| 201 | 'unexpected-disconnect 'unexpected-disconnect)) | ||
| 202 | ;; Define overriding formatting function for catalog entry | ||
| 203 | ;; `disconnected' to spoof time progressing past midnight. | ||
| 204 | (erc-message-english-disconnected | ||
| 205 | (let ((orig erc-message-english-disconnected)) | ||
| 206 | (lambda (&rest _) | ||
| 207 | (setq erc-stamp--current-time | ||
| 208 | (time-add erc-stamp--current-time 120)) | ||
| 209 | orig))) | ||
| 210 | (port (process-contact dumb-server :service)) | ||
| 211 | (expect (erc-d-t-make-expecter))) | ||
| 212 | |||
| 213 | (ert-info ("Connect") | ||
| 214 | (with-current-buffer (erc :server "127.0.0.1" | ||
| 215 | :port port | ||
| 216 | :nick "tester" | ||
| 217 | :full-name "tester") | ||
| 218 | (funcall expect 10 "debug mode"))) | ||
| 219 | |||
| 220 | ;; Ensure date stamps are unique per server buffer. | ||
| 221 | (with-current-buffer "FooNet" | ||
| 222 | (funcall expect 10 "[Mon Jun 3 2024]") | ||
| 223 | (funcall expect -0.1 "[Mon Jun 3 2024]") ; no duplicates | ||
| 224 | (funcall expect 10 "[00:00]") | ||
| 225 | (funcall expect -0.1 "[00:00]") | ||
| 226 | (funcall expect 10 "Welcome to the foonet") | ||
| 227 | (delete-process erc-server-process)))) | ||
| 228 | |||
| 183 | ;;; erc-scenarios-stamp.el ends here | 229 | ;;; erc-scenarios-stamp.el ends here |