From 8757eeafbee2c1befafa2ce277c39c195350f802 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 8 Apr 2024 14:21:43 -0700 Subject: [PATCH 2/2] [5.6] Don't nest date stamp insertions in erc-stamp * etc/ERC-NEWS: Don't mention certain insertion-adjacent hooks being suppressed for date stamps, which is no longer true. * lisp/erc/erc-fill.el (erc-fill-wrap): Don't move last-message marker when encountering a date stamp. * lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect): Restore `erc-stamp--date-stamps' on reconnect or rejoin. (erc-stamp--date): New struct. (erc-stamp--deferred-date-stamp): New internal variable to pass state between hook members. (erc-stamp--date-stamps): New internal variable to store a reference to all inserted timestamps. (erc-stamp--find-insertion-point): New helper function. (erc-stamp--insert-date-stamp-as-phony-message) (erc-stamp--lr-date-on-pre-modify): Remove. (erc-stamp--defer-date-insertion-on-post-modify) (erc-stamp--defer-date-insertion-on-post-insert) (erc-stamp--defer-date-insertion-on-post-send): New function. (erc-stamp--date-mode): Update hook-member functions. (erc-stamp-prepend-date-stamps-p): Revise doc. (erc-insert-timestamp-left-and-right): Remove code to initialize a date stamp in place. Pre-render date stamp and stash it for retrieval by `erc-stamp--defer-date-insertion-on-post-modify'. (erc-stamp--setup): Kill `erc-stamp--deferred-date-stamp' and `erc-stamp--date-stamps'. (erc-stamp--reset-on-clear): Account for `erc--insert-marker' being non-nil and remove trimmed stamps from `erc-stamp--date-stamps'. * lisp/erc/erc.el (erc--insert-line-function): Expand doc string. (erc--hide-message): Add new parameter `splicep' for hiding messages being inserted between existing ones rather than at the prompt. * test/lisp/erc/erc-button-tests.el (erc-button-tests--erc-button-alist--function-as-form): Update expected button bounds. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg) (erc-fill-tests--wrap-populate, erc-fill-wrap-tests--merge-action) (erc-fill-line-spacing): Use `erc-display-message' wrappers to intercept `erc-timer-hook' modifications. * test/lisp/erc/resources/erc-tests-common.el (erc-tests--common-display-message) (erc-tests-common-display-message) (erc-tests-common-with-date-aware-display-message): New functions and macro for running `erc-display-message' while intercepting additions to `erc-timer-hook'. (erc-tests-common-snapshot-compare): Insert expected output into its own buffer. This change is unrelated to the rest of this commit. (Bug#60936) --- etc/ERC-NEWS | 18 +- lisp/erc/erc-fill.el | 2 - lisp/erc/erc-stamp.el | 209 ++++++++++++-------- lisp/erc/erc.el | 16 +- test/lisp/erc/erc-button-tests.el | 8 +- test/lisp/erc/erc-fill-tests.el | 48 ++--- test/lisp/erc/resources/erc-tests-common.el | 34 +++- 7 files changed, 204 insertions(+), 131 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index d7f513addfb..b66ea6a7a02 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -486,16 +486,14 @@ these areas without inflicting collateral damage. Despite the rationale, this move admittedly ushers in a heightened potential for disruption because third-party members of ERC's modification hooks may not take kindly to encountering stamp-only -messages. They may also expect members of 'erc-insert-pre-hook' and -'erc-insert-done-hook' to run unconditionally, even though ERC -suppresses those hooks when inserting date stamps. Third parties may -also not appreciate that 'erc-timestamp-last-inserted-left' no longer -records the final trailing newline in 'erc-timestamp-format-left'. If -these inconveniences prove too encumbering to deal with right away, -see the escape hatch 'erc-stamp-prepend-date-stamps-p', which should -help ease the transition. As for detecting these new stamp-only -messages from members of 'erc-insert-modify-hook' and friends, see the -function 'erc-stamp-inserting-date-stamp-p'. +messages or the new behavior of 'erc-timestamp-last-inserted-left', +which no longer records the final trailing newline in the variable +'erc-timestamp-format-left'. If these inconveniences prove too +encumbering to deal with right away, see the escape hatch +'erc-stamp-prepend-date-stamps-p', which should help ease the +transition. As for detecting these new stamp-only messages from +members of 'erc-insert-modify-hook' and friends, see the function +'erc-stamp-inserting-date-stamp-p'. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and "provided" library diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index aa12b807fbc..c40026683ad 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -679,8 +679,6 @@ erc-fill-wrap (skip-syntax-forward "^-") (forward-char) (cond ((eq msg-prop 'datestamp) - (when erc-fill--wrap-last-msg - (set-marker erc-fill--wrap-last-msg (point-min))) (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bcb9b4aafef..63abbfefcb3 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -202,7 +202,8 @@ erc-stamp--recover-on-reconnect (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left - erc-timestamp-last-inserted-right)) + erc-timestamp-last-inserted-right + erc-stamp--date-stamps)) (when-let (existing (alist-get var priors)) (set var existing))))) @@ -652,7 +653,7 @@ erc-insert-timestamp-right (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) (defvar erc-stamp--insert-date-hook nil - "Functions appended to send and modify hooks when inserting date stamp.") + "Hook run when inserting a date stamp.") (defvar-local erc-stamp--date-format-end nil "Tristate value indicating how and whether date stamps have been set up. @@ -661,9 +662,27 @@ erc-stamp--date-format-end truncating `erc-timestamp-format-left' prior to rendering. A value of t means the option's value doesn't require trimming.") -(defun erc-stamp--propertize-left-date-stamp () +;; This struct and its namesake variable exist to assist in testing. +(cl-defstruct erc-stamp--date + "Data relevant to life cycle of date-stamp insertion." + ( ts (error "Missing `ts' field") :type (or cons integer) + :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.") + ( str (error "Missing `str' field") :type string + :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.") + ( fn nil :type (or null function) + :documentation "Deferred insertion function created by post-modify hook.") + ( marker (make-marker) :type marker + :documentation "Insertion marker.")) + +(defvar-local erc-stamp--deferred-date-stamp nil + "Active `erc-stamp--date' instance. +Non-nil between insertion-modification and \"done\" (or timer) hook.") + +(defvar-local erc-stamp--date-stamps nil + "List of stamps in the current buffer.") + +(defun erc-stamp--propertize-left-date-stamp (&rest _) (add-text-properties (point-min) (1- (point-max)) '(field erc-timestamp)) - (erc--hide-message 'timestamp) (run-hooks 'erc-stamp--insert-date-hook)) (defun erc-stamp--format-date-stamp (ct) @@ -680,6 +699,16 @@ erc-stamp--format-date-stamp 0 erc-stamp--date-format-end) erc-timestamp-format-left)))) +(defun erc-stamp--find-insertion-point (p target-time) + "Scan buffer backwards from P looking for TARGET-TIME. +Return P or, if found, a position less than P." + (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (qq (erc--get-inserted-msg-beg q)) + (ts (get-text-property qq 'erc--ts)) + ((not (time-less-p ts target-time)))) + (setq p qq)) + p) + (defun erc-stamp-inserting-date-stamp-p () "Return non-nil if the narrowed buffer contains a date stamp. Expect to be called by members of `erc-insert-modify-hook' and @@ -687,75 +716,76 @@ erc-stamp-inserting-date-stamp-p inserted is a date stamp." (erc--check-msg-prop 'erc--msg 'datestamp)) -;; Calling `erc-display-message' from within a hook it's currently -;; running is roundabout, but it's a definite means of ensuring hooks -;; can act on the date stamp as a standalone message to do things like -;; adjust invisibility props. -(defun erc-stamp--insert-date-stamp-as-phony-message (string) - (cl-assert (string-empty-p string)) - (setq string erc-timestamp-last-inserted-left) - (let ((erc-stamp--skip t) - (erc-insert-modify-hook `(,@erc-insert-modify-hook - erc-stamp--propertize-left-date-stamp)) - (erc--insert-line-function #'insert-before-markers) - ;; Don't run hooks that aren't expecting a narrowed buffer. - (erc-insert-pre-hook nil) - (erc-insert-done-hook nil)) - (erc-display-message nil nil (current-buffer) string))) - -(defun erc-stamp--lr-date-on-pre-modify (_) - (when-let (((not erc-stamp--skip)) - (ct (erc-stamp--current-time)) - (rendered (erc-stamp--format-date-stamp ct)) - ((not (string-equal rendered erc-timestamp-last-inserted-left))) - (erc-insert-timestamp-function - #'erc-stamp--insert-date-stamp-as-phony-message)) - (save-excursion - (save-restriction - (narrow-to-region (or erc--insert-marker erc-insert-marker) - (or erc--insert-marker erc-insert-marker)) - ;; Ensure all hooks, like `erc-stamp--insert-date-hook', only - ;; see the let-bound value below during `erc-add-timestamp'. - (setq erc-timestamp-last-inserted-left nil) - (let* ((aligned (erc-stamp--time-as-day ct)) - (erc-stamp--current-time aligned) - ;; Forget current `erc--cmd', etc. - (erc--msg-props (map-into `((erc--msg . datestamp)) - 'hash-table)) - (erc-timestamp-last-inserted-left rendered) - erc-timestamp-format erc-away-timestamp-format) - (erc-add-timestamp)) - (setq erc-timestamp-last-inserted-left rendered))))) - -;; This minor mode is just a placeholder and currently unhelpful for -;; managing complexity. A useful version would leave a marker during -;; post-modify hooks and then perform insertions (before markers) -;; during "done" hooks. This would enable completely decoupling from -;; and possibly deprecating `erc-insert-timestamp-left-and-right'. -;; However, doing this would require expanding the internal API to -;; include insertion and deletion handlers for twiddling and massaging -;; text properties based on context immediately after modifying text -;; earlier in a buffer (away from `erc-insert-marker'). Without such -;; handlers, things like "merged" `fill-wrap' speakers and invisible -;; messages may be damaged by buffer modifications. +(defun erc-stamp--defer-date-insertion-on-post-modify (hook-var) + "Schedule a date stamp to be inserted via HOOK-VAR. +Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are +non-nil." + (when-let ((data erc-stamp--deferred-date-stamp) + ((null (erc-stamp--date-fn data))) + (ct (erc-stamp--date-ts data)) + (rendered (erc-stamp--date-str data)) + (buffer (current-buffer)) + (symbol (make-symbol "erc-stamp--insert-date")) + (marker (setf (erc-stamp--date-marker data) (point-min-marker)))) + (setf (erc-stamp--date-fn data) symbol) + (fset symbol + (lambda (&rest _) + (remove-hook hook-var symbol) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (setq erc-stamp--date-stamps + (cl-sort (cons data erc-stamp--date-stamps) #'time-less-p + :key #'erc-stamp--date-ts)) + (setq erc-stamp--deferred-date-stamp nil) + (set-marker-insertion-type marker t) + (let* ((aligned (erc-stamp--time-as-day ct)) + (pt (erc-stamp--find-insertion-point marker aligned)) + (erc--insert-marker (set-marker marker pt)) + (erc-stamp--current-time aligned) + (erc--msg-props (map-into '((erc--msg . datestamp)) + 'hash-table)) + (erc-insert-post-hook + `(,(lambda () (erc--hide-message 'timestamp 'splice)) + ,@erc-insert-post-hook)) + (erc-insert-timestamp-function + #'erc-stamp--propertize-left-date-stamp) + (erc--insert-line-function #'insert-before-markers) + ;; + erc-timestamp-format erc-away-timestamp-format) + (erc-display-message nil nil (current-buffer) rendered) + (setf (erc-stamp--date-ts data) aligned)) + (setq erc-timestamp-last-inserted-left rendered))))) + (add-hook hook-var symbol -90))) + +(defun erc-stamp--defer-date-insertion-on-post-insert () + (erc-stamp--defer-date-insertion-on-post-modify 'erc-timer-hook)) + +(defun erc-stamp--defer-date-insertion-on-post-send () + (erc-stamp--defer-date-insertion-on-post-modify 'erc-send-completed-hook)) + +;; This minor mode is hopefully just a placeholder because it's quite +;; unhelpful for managing complexity. A useful version would exist as +;; a standalone module to allow completely decoupling from and +;; possibly deprecating `erc-insert-timestamp-left-and-right'. (define-minor-mode erc-stamp--date-mode "Insert date stamps as standalone messages." :interactive nil (if erc-stamp--date-mode - (progn (add-hook 'erc-insert-pre-hook - #'erc-stamp--lr-date-on-pre-modify 10 t) - (add-hook 'erc-pre-send-functions - #'erc-stamp--lr-date-on-pre-modify 10 t)) + (progn + (add-hook 'erc-insert-post-hook + #'erc-stamp--defer-date-insertion-on-post-insert 0 t) + (add-hook 'erc-send-post-hook + #'erc-stamp--defer-date-insertion-on-post-send 0 t)) (kill-local-variable 'erc-timestamp-last-inserted-left) - (remove-hook 'erc-insert-pre-hook - #'erc-stamp--lr-date-on-pre-modify t) - (remove-hook 'erc-pre-send-functions - #'erc-stamp--lr-date-on-pre-modify t))) + (remove-hook 'erc-insert-post-hook + #'erc-stamp--defer-date-insertion-on-post-insert t) + (remove-hook 'erc-send-post-hook + #'erc-stamp--defer-date-insertion-on-post-send t))) (defvar erc-stamp-prepend-date-stamps-p nil "When non-nil, date stamps are not independent messages. -This flag restores pre-5.6 behavior in which date stamps formed -the leading portion of affected messages. Beware that enabling +This flag restores pre-5.6 behavior in which date stamps were +prepended to normal chat messages. Beware that enabling this degrades the user experience by causing 5.6+ features, like `fill-wrap', dynamic invisibility, etc., to malfunction. When non-nil, none of the newline twiddling mentioned in the doc @@ -775,26 +805,17 @@ erc-insert-timestamp-left-and-right Allow the stamp's `invisible' property to span that same interval but also cover the previous newline, in order to satisfy folding requirements related to `erc-legacy-invisible-bounds-p'. -Additionally, ensure every date stamp is identifiable as such so -that internal modules can easily distinguish between other -left-sided stamps and date stamps inserted by this function." +Additionally, ensure every date stamp is identifiable as such via +the function `erc-stamp-inserting-date-stamp-p' so that internal +modules can easily distinguish between other left-sided stamps +and date stamps inserted by this function." (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p (and (or (null erc-timestamp-format-left) (string-empty-p ; compat (string-trim erc-timestamp-format-left "\n"))) (always (erc-stamp--date-mode -1)) (setq erc-stamp-prepend-date-stamps-p t))) - (erc-stamp--date-mode +1) - ;; Hooks used by ^ are the preferred means of inserting date - ;; stamps. But they'll never see this inaugural message, so it - ;; must be handled specially. - (let ((erc--insert-marker (point-min-marker)) - (end-marker (point-max-marker))) - (set-marker-insertion-type erc--insert-marker t) - (erc-stamp--lr-date-on-pre-modify nil) - (narrow-to-region erc--insert-marker end-marker) - (set-marker end-marker nil) - (set-marker erc--insert-marker nil))) + (erc-stamp--date-mode +1)) (let* ((ct (erc-stamp--current-time)) (ts-right (with-suppressed-warnings ((obsolete erc-timestamp-format-right)) @@ -805,12 +826,22 @@ erc-insert-timestamp-left-and-right ;; "prepended" date stamps as well. However, since this is a ;; compatibility oriented code path, and pre-5.6 did no such ;; thing, better to punt. - (when-let ((erc-stamp-prepend-date-stamps-p) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) - ((not (string= ts-left erc-timestamp-last-inserted-left)))) - (goto-char (point-min)) - (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) - (insert (setq erc-timestamp-last-inserted-left ts-left))) + (if-let ((erc-stamp-prepend-date-stamps-p) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + ((not (string= ts-left erc-timestamp-last-inserted-left)))) + (progn + (goto-char (point-min)) + (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp + ts-left) + (insert (setq erc-timestamp-last-inserted-left ts-left))) + (when-let + (((null erc-stamp--deferred-date-stamp)) + (rendered (erc-stamp--format-date-stamp ct)) + ((not (string-equal rendered erc-timestamp-last-inserted-left))) + ((null (cl-find rendered erc-stamp--date-stamps + :test #'string= :key #'erc-stamp--date-str)))) + (setq erc-stamp--deferred-date-stamp + (make-erc-stamp--date :ts ct :str rendered)))) ;; insert right timestamp (let ((erc-timestamp-only-if-changed-flag t) (erc-timestamp-last-inserted erc-timestamp-last-inserted-right)) @@ -924,6 +955,8 @@ erc-stamp--setup (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) (kill-local-variable 'erc-timestamp-last-inserted-right) + (kill-local-variable 'erc-stamp--deferred-date-stamp) + (kill-local-variable 'erc-stamp--date-stamps) (kill-local-variable 'erc-stamp--date-format-end))) (defun erc-hide-timestamps () @@ -993,7 +1026,11 @@ erc-stamp--update-saved-position (defun erc-stamp--reset-on-clear (pos) "Forget last-inserted stamps when POS is at insert marker." - (when (= pos (1- erc-insert-marker)) + (when (= pos (1- (or erc--insert-marker erc-insert-marker))) + (when erc-stamp--date-stamps + (setq erc-stamp--date-stamps + (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos)) + erc-stamp--date-stamps))) (when erc-stamp--date-mode (add-hook 'erc-stamp--insert-date-hook #'erc-stamp--update-saved-position 0 t)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4ed77655f19..4ec8c40c7c6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3325,7 +3325,11 @@ erc--insert-invisible-as-intangible-p time, so if you need them, please let ERC know with \\[erc-bug].") (defvar erc--insert-line-function nil - "When non-nil, an alterntive to `insert' for inserting messages.") + "When non-nil, an `insert'-like function for inserting messages. +Modules, like `fill-wrap', that leave a marker at the beginning of an +inserted message clearly want that marker to advance along with text +inserted at that position. This can be addressed by binding this +variable to `insert-before-markers' around calls to `display-message'.") (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") @@ -3573,13 +3577,15 @@ erc-legacy-invisible-bounds-p (make-obsolete-variable 'erc-legacy-invisible-bounds-p "decremented interval now permanent" "30.1") -(defun erc--hide-message (value) +(defun erc--hide-message (value &optional splicep) "Apply `invisible' text-property with VALUE to current message. Expect to run in a narrowed buffer during message insertion. Begin the invisible interval at the previous message's trailing newline and end before the current message's. If the preceding message ends in a double newline or there is no previous message, -don't bother including the preceding newline." +don't bother including the preceding newline. With SPLICEP, +transplant the `invisible' props from the trailing newline before +`point-min' to the inserted newline at `point-max'." (if erc-legacy-invisible-bounds-p ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. @@ -3588,6 +3594,10 @@ erc--hide-message (end (point-max))) (save-restriction (widen) + (when-let ((splicep) + (bval (get-text-property (1- beg) 'invisible))) + (put-text-property (1- end) end 'invisible bval) + (remove-text-properties (1- beg) beg '(invisible nil))) (when (or (<= beg 4) (= ?\n (char-before (- beg 2)))) (cl-incf beg)) (erc--merge-prop (1- beg) (1- end) 'invisible value))))) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 603b3745a27..9d8fb0081c5 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -74,9 +74,11 @@ erc-button-tests--erc-button-alist--function-as-form (entry (list (rx "+1") 0 func #'ignore 0)) (erc-button-alist (cons entry erc-button-alist))) - (erc-display-message nil 'notice (current-buffer) "Foo bar baz") - (erc-display-message nil nil (current-buffer) "+1") - (erc-display-message nil 'notice (current-buffer) "Spam") + (erc-tests-common-display-message nil 'notice (current-buffer) + "Foo bar baz") + (erc-tests-common-display-message nil nil (current-buffer) "+1") + (erc-tests-common-display-message nil 'notice (current-buffer) "Spam") + (should (equal (pop erc-button-tests--form) '(53 55 ignore nil ("+1") "\\+1"))) (should-not erc-button-tests--form) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 3c4ad04abd7..250ade90587 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -48,7 +48,7 @@ erc-fill-tests--insert-privmsg :command "PRIVMSG" :command-args (list "#chan" msg) :contents msg))) - (erc-display-message parsed nil (current-buffer) msg))) + (erc-tests-common-display-message parsed nil (current-buffer) msg))) (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) @@ -79,7 +79,7 @@ erc-fill-tests--wrap-populate (erc-update-channel-member "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) - (erc-display-message + (erc-tests-common-display-message nil 'notice (current-buffer) (concat "This server is in debug mode and is logging all user I/O. " "If you do not wish for everything you send to be readable " @@ -260,29 +260,31 @@ erc-fill-wrap-tests--merge-action (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "bob" "0.5") - (erc-process-ctcp-query - erc-server-process - (make-erc-response - :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1" - :sender "bob!~u@fake" - :command "PRIVMSG" - :command-args '("#chan" "\1ACTION one.\1") - :contents "\1ACTION one.\1") - "bob" "~u" "fake") + (erc-tests-common-with-date-aware-display-message + (erc-process-ctcp-query + erc-server-process + (make-erc-response + :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1" + :sender "bob!~u@fake" + :command "PRIVMSG" + :command-args '("#chan" "\1ACTION one.\1") + :contents "\1ACTION one.\1") + "bob" "~u" "fake")) (erc-fill-tests--insert-privmsg "bob" "two.") (erc-fill-tests--insert-privmsg "bob" "2.5") ;; Compat switch to opt out of overhanging speaker. - (let (erc-fill--wrap-action-dedent-p) - (erc-process-ctcp-query - erc-server-process - (make-erc-response - :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1" - :sender "bob!~u@fake" :command "PRIVMSG" - :command-args '("#chan" "\1ACTION three\1") - :contents "\1ACTION three\1") - "bob" "~u" "fake")) + (erc-tests-common-with-date-aware-display-message + (let (erc-fill--wrap-action-dedent-p) + (erc-process-ctcp-query + erc-server-process + (make-erc-response + :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1" + :sender "bob!~u@fake" :command "PRIVMSG" + :command-args '("#chan" "\1ACTION three\1") + :contents "\1ACTION three\1") + "bob" "~u" "fake"))) (erc-fill-tests--insert-privmsg "bob" "four.")) @@ -320,8 +322,10 @@ erc-fill-line-spacing (erc-fill-tests--wrap-populate (lambda () (erc-fill-tests--insert-privmsg "bob" "This buffer is for text.") - (erc-display-message nil 'notice (current-buffer) "one two three") - (erc-display-message nil 'notice (current-buffer) "four five six") + (erc-tests-common-display-message nil 'notice + (current-buffer) "one two three") + (erc-tests-common-display-message nil 'notice + (current-buffer) "four five six") (erc-fill-tests--insert-privmsg "bob" "Somebody stop me") (erc-fill-tests--compare "spacing-01-mono"))))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 99f15b89b03..2ec32db77cd 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -39,7 +39,7 @@ ;;; Code: (require 'ert-x) (require 'erc) - +(eval-when-compile (require 'erc-stamp)) (defmacro erc-tests-common-equal-with-props (a b) "Compare strings A and B for equality including text props. @@ -196,6 +196,25 @@ erc-tests-common-assert-get-inserted-msg-readonly-with (erc-readonly-mode +1) (funcall assert-fn test-fn))) +(defun erc-tests--common-display-message (orig &rest args) + (require 'erc-stamp) + (defvar erc-stamp--deferred-date-stamp) + (let (erc-stamp--deferred-date-stamp) + (prog1 (apply orig args) + (when-let ((inst erc-stamp--deferred-date-stamp) + (fn (erc-stamp--date-fn inst))) + (funcall fn))))) + +(defun erc-tests-common-display-message (&rest args) + (apply #'erc-tests--common-display-message #'erc-display-message args)) + +(defmacro erc-tests-common-with-date-aware-display-message (&rest body) + `(progn + (advice-add 'erc-display-message + :around #'erc-tests--common-display-message) + (unwind-protect (progn ,@body) + (advice-remove 'erc-display-message + #'erc-tests--common-display-message)))) ;;;; Buffer snapshots @@ -223,12 +242,19 @@ erc-tests-common-snapshot-compare (print-escape-nonascii t) (got (erc--remove-text-properties (buffer-substring (point-min) erc-insert-marker))) - (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))) + (repr (funcall (or trans-fn #'identity) (prin1-to-string got))) + (xstr (read (with-temp-buffer + (insert-file-contents-literally expect-file) + (buffer-string))))) (with-current-buffer (generate-new-buffer name) (with-silent-modifications (insert (setq got (read repr)))) (when buf-init-fn (funcall buf-init-fn)) (erc-mode)) + (unless noninteractive + (with-current-buffer (generate-new-buffer (format "%s-xpt" name)) + (insert xstr) + (erc-mode))) ;; LHS is a string, RHS is a symbol. (if (string= erc-tests-common-snapshot-save-p (ert-test-name (ert-running-test))) @@ -242,9 +268,7 @@ erc-tests-common-snapshot-compare ;; recursive (signals `max-lisp-eval-depth' exceeded). (named-let assert-equal ((latest (read repr)) - (expect (read (with-temp-buffer - (insert-file-contents-literally expect-file) - (buffer-string))))) + (expect xstr)) (pcase latest ((or "" 'nil) t) ((pred stringp) -- 2.44.0