From 8a16a295942aacc6ea53b332e4b71f6e976eb550 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 8 Apr 2024 14:21:43 -0700 Subject: [PATCH] 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-common.el (erc--solo): New utility function. * 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 and rejoin. (erc-stamp--insert-date-hook): Fix erroneous doc string. (erc-stamp--date): New struct type. (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--propertize-left-date-stamp): Don't hide messages because this function runs on `erc-insert-modify-hook'. Prefer doing so later, in `erc-insert-post-hook'. (erc-stamp--find-insertion-point): New helper function. (erc-stamp--insert-date-stamp-as-phony-message): Remove. (erc-stamp--lr-date-on-pre-modify): Remove function. Portions of body now appear in `erc-stamp--defer-date-insertion-on-post-modify'. (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 functions, although the first incorporates parts of the now defunct `erc-stamp--lr-date-on-pre-modify'. (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 through a nested call to `erc-display-message'. Instead, "pre-render" date stamp and stash it for retrieval by the function `erc-stamp--defer-date-insertion-on-post-modify'. (erc-stamp--setup): Kill variables `erc-stamp--deferred-date-stamp' and `erc-stamp--date-stamps'. (erc-stamp--reset-on-clear): Remove trimmed stamps from `erc-stamp--date-stamps'. * lisp/erc/erc.el (erc--msg-props): Document `erc--hide' in doc string. (erc--with-inserted-msg): Remove unused macro. (erc--insert-line-splice-function): New variable. (erc--with-spliced-insertion): New macro. (erc--insert-line-function): Expand doc string. (erc--remove-from-prop-value-list): Tweak doc string. (erc--insert-before-markers-transplanting-hidden): New function. (erc--hide-message): Remember managed `invisible' prop value. Do so by recording them in the `erc--hide' "msg prop". (erc--delete-inserted-message, erc--delete-inserted-message-naively): Rename former to latter to emphasize that it's largely impractical for general use. (erc--ranked-properties): Add `erc--hide'. * test/lisp/erc/erc-button-tests.el (erc-button-tests--erc-button-alist--function-as-form): Use `erc-display-message' helper. * 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/erc-scenarios-match.el (erc-scenarios-match--invisible-stamp): Add convenience commands to `extended-command-history' when running interactively. * test/lisp/erc/erc-tests.el (erc--insert-before-markers-transplanting-hidden): New test. (erc--delete-inserted-message, erc--delete-inserted-message-naively): Update test name as well as namesake function in body. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common-with-cleanup): Validate `erc-stamp--date-stamps' members after every scenario test. (erc-scenarios-common--assert-date-stamps): New function. * test/lisp/erc/resources/erc-tests-common.el: Require `erc-stamp' atop file when compiling. (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' made by date-stamp-related post-insertion hooks. (erc-tests-common-snapshot-compare): Insert expected output into its own buffer for easier review during interactive sessions. This change is unrelated to the rest of this commit. (Bug#60936) (cherry picked from commit 86184cba2180a09b31e92f7366f9dd38de5b976a) --- etc/ERC-NEWS | 18 +- lisp/erc/erc-common.el | 9 + lisp/erc/erc-fill.el | 2 - lisp/erc/erc-stamp.el | 211 +++++++++++------- lisp/erc/erc.el | 88 ++++++-- test/lisp/erc/erc-button-tests.el | 8 +- test/lisp/erc/erc-fill-tests.el | 48 ++-- test/lisp/erc/erc-scenarios-match.el | 3 +- test/lisp/erc/erc-tests.el | 51 ++++- .../erc/resources/erc-scenarios-common.el | 7 + test/lisp/erc/resources/erc-tests-common.el | 34 ++- 11 files changed, 330 insertions(+), 149 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-common.el b/lisp/erc/erc-common.el index 8388efe062c..4115e314b39 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -617,6 +617,15 @@ the resulting variables will end up with more useful doc strings." "Return position of CHAR in STRING or nil if not found." (inline-quote (string-search (string ,char) ,string))) +(define-inline erc--solo (list-or-atom) + "If LIST-OR-ATOM is a list of one element, return that element. +Otherwise, return LIST-OR-ATOM." + (inline-letevals (list-or-atom) + (inline-quote + (if (and (consp ,list-or-atom) (null (cdr ,list-or-atom))) + (car ,list-or-atom) + ,list-or-atom)))) + (defmacro erc--doarray (spec &rest body) "Map over ARRAY, running BODY with VAR bound to iteration element. Behave more or less like `seq-doseq', but tailor operations for diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c5d4e9c9e6f..b2c8c991c96 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -674,8 +674,6 @@ See `erc-fill-wrap-mode' for details." (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..d1ee1da994d 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -202,7 +202,8 @@ from entering them and instead jump over them." (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 @@ printed just after each line's text (no alignment)." (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 @@ stamps. An integer marks the `substring' TO parameter for 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 @@ value of t means the option's value doesn't require trimming.") 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,77 @@ Expect to be called by members of `erc-insert-modify-hook' and 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) + (let* ((aligned (erc-stamp--time-as-day ct)) + (erc-stamp--current-time aligned) + (erc--msg-props (map-into '((erc--msg . datestamp)) + 'hash-table)) + (erc-insert-post-hook + `(,(lambda () + (set-marker marker (point-min)) + (set-marker-insertion-type marker t) + (erc--hide-message 'timestamp)) + ,@erc-insert-post-hook)) + (erc-insert-timestamp-function + #'erc-stamp--propertize-left-date-stamp) + (pos (erc-stamp--find-insertion-point marker aligned)) + ;; + erc-timestamp-format erc-away-timestamp-format) + (erc--with-spliced-insertion pos + (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 +806,17 @@ in the latter (if any) as part of the `erc-timestamp' field. 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 +827,22 @@ left-sided stamps and date stamps inserted by this function." ;; "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 +956,8 @@ For `erc-hide-timestamps, modify `buffer-invisibility-spec'." (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 () @@ -992,7 +1026,12 @@ with the option `erc-echo-timestamps', see the companion option (move-marker erc-last-saved-position (1- (point-max)))) (defun erc-stamp--reset-on-clear (pos) - "Forget last-inserted stamps when POS is at insert marker." + "Forget last-inserted stamps when POS is at insert marker. +And discard stale references in `erc-stamp--date-stamps'." + (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 (= pos (1- erc-insert-marker)) (when erc-stamp--date-mode (add-hook 'erc-stamp--insert-date-hook diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4ed77655f19..84e3ac4bede 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -186,6 +186,10 @@ as of ERC 5.6: hooks that the current message should not affect stateful operations, such as recording a channel's most recent speaker + - `erc--hide': a symbol or list of symbols added as an `invisible' + prop value to the entire message, starting *before* the preceding + newline and ending before the trailing newline + This is an internal API, and the selection of related helper utilities is fluid and provisional. As of ERC 5.6, see the functions `erc--check-msg-prop' and `erc--get-inserted-msg-prop'.") @@ -3278,14 +3282,36 @@ if not found." (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) (get-text-property stack-pos prop))) -(defmacro erc--with-inserted-msg (&rest body) - "Simulate narrowing performed for send and insert hooks, and run BODY. -Expect callers to know that this doesn't wrap BODY in -`with-silent-modifications' or bind a temporary `erc--msg-props'." - `(when-let ((bounds (erc--get-inserted-msg-bounds))) - (save-restriction - (narrow-to-region (car bounds) (1+ (cdr bounds))) - ,@body))) +;; FIXME improve this nascent "message splicing" facility to include a +;; means for modules to adjust inserted messages on either side of the +;; splice position as well as to modify the spliced-in message itself +;; before and after each insertion-related hook runs. Also add a +;; counterpart to `erc--with-spliced-insertion' for deletions. +(defvar erc--insert-line-splice-function + #'erc--insert-before-markers-transplanting-hidden + "Function to handle in-place insertions away from prompt. +Modules that display \"stateful\" messages, where one message's content +depends on prior messages, should advise this locally as needed.") + +(defmacro erc--with-spliced-insertion (marker-or-pos &rest body) + "In BODY, ensure `erc-insert-line' inserts messages at MARKER-OR-POS. +If MARKER-OR-POS is a marker, let it advance normally (and permanently) +with each insertion. Allow modules to influence insertion by binding +`erc--insert-line-function' to `erc--insert-line-splice-function' around +BODY. Note that as of ERC 5.6, this macro cannot handle multiple +successive calls to `erc-insert-line' in BODY, such as when replaying +a history backlog." + (declare (indent 1)) + (let ((marker (make-symbol "marker"))) + `(progn + (cl-assert (= ?\n (char-before ,marker-or-pos))) + (cl-assert (null erc--insert-line-function)) + (let* ((,marker (and (not (markerp ,marker-or-pos)) + (copy-marker ,marker-or-pos))) + (erc--insert-marker (or ,marker ,marker-or-pos)) + (erc--insert-line-function erc--insert-line-splice-function)) + (prog1 (progn ,@body) + (when ,marker (set-marker ,marker nil))))))) (defun erc--traverse-inserted (beg end fn) "Visit messages between BEG and END and run FN in narrowed buffer. @@ -3325,7 +3351,11 @@ that this flag and the behavior it restores may disappear at any 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'.") @@ -3509,7 +3539,7 @@ also `erc-button-add-face'." end (next-single-property-change pos prop object to))))) (defun erc--remove-from-prop-value-list (from to prop val &optional object) - "Remove VAL from text prop value between FROM and TO. + "Remove VAL from text PROP value between FROM and TO. If current value is VAL itself, remove the property entirely. When VAL is a list, act as if this function were called repeatedly with VAL set to each of VAL's members." @@ -3573,19 +3603,45 @@ preceding newline to its last non-newline character.") (make-obsolete-variable 'erc-legacy-invisible-bounds-p "decremented interval now permanent" "30.1") +(defun erc--insert-before-markers-transplanting-hidden (string) + "Insert STRING before markers and migrate any `invisible' props. +Expect to be called with `point' at the start of an inserted message, +i.e., one with an `erc--msg' property. Check the message prop header +for invisibility props advertised via `erc--hide'. When found, remove +them from the previous newline, and add them to the newline suffixing +the inserted version of STRING." + (let* ((after (and (not erc-legacy-invisible-bounds-p) + (get-text-property (point) 'erc--hide))) + (before (and after (get-text-property (1- (point)) 'invisible))) + (a (and after (ensure-list after))) + (b (and before (ensure-list before))) + (new (and before (erc--solo (cl-intersection b a))))) + (when new + (erc--remove-from-prop-value-list (1- (point)) (point) 'invisible a)) + (prog1 (insert-before-markers string) + (when new + (erc--merge-prop (1- (point)) (point) 'invisible new))))) + (defun erc--hide-message (value) "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. Additionally, +record VALUE as part of the `erc--hide' property in the +\"msg-props\" header." (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. (erc--merge-prop (point-min) (point-max) 'invisible value) - (let ((beg (point-min)) + (let ((old-hide (erc--check-msg-prop 'erc--hide)) + (beg (point-min)) (end (point-max))) + (puthash 'erc--hide (if old-hide + `(,value . ,(ensure-list old-hide)) + value) + erc--msg-props) (save-restriction (widen) (when (or (<= beg 4) (= ?\n (char-before (- beg 2)))) @@ -3604,9 +3660,11 @@ Treat ARG in a manner similar to mode toggles defined by (when (or (not arg) (natnump arg)) (add-to-invisibility-spec prop)))) -(defun erc--delete-inserted-message (beg-or-point &optional end) +(defun erc--delete-inserted-message-naively (beg-or-point &optional end) "Remove message between BEG and END. -Expect BEG and END to match bounds as returned by the macro +Do this without updating messages on either side even if their +appearance was somehow influenced by the newly absent message. +Expect BEG and END to match bounds as returned by the function `erc--get-inserted-msg-bounds'. Ensure all markers residing at the start of the deleted message end up at the beginning of the subsequent message." @@ -3626,7 +3684,7 @@ subsequent message." -1)))))))) (defvar erc--ranked-properties - '(erc--msg erc--spkr erc--ts erc--cmd erc--ctcp erc--ephemeral)) + '(erc--msg erc--spkr erc--ts erc--cmd erc--hide erc--ctcp erc--ephemeral)) (defun erc--order-text-properties-from-hash (table) "Return a plist of text props from items in TABLE. 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 @@ (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 79cfc1190bc..f8bfc362085 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -48,7 +48,7 @@ :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-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-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.")) @@ -312,8 +314,10 @@ (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/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 22e34a8efe8..8600af800f1 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -71,7 +71,8 @@ ;; (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (unless noninteractive - (kill-new "erc-match-toggle-hidden-fools")) + (push "erc-match-toggle-hidden-fools" extended-command-history) + (push "erc-toggle-timestamps" extended-command-history)) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 22432a68034..cc681384e9c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1927,7 +1927,48 @@ (lambda (arg) (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) -(ert-deftest erc--delete-inserted-message () +(ert-deftest erc--insert-before-markers-transplanting-hidden () + (with-current-buffer (get-buffer-create "*erc-test*") + (erc-mode) + (erc-tests-common-prep-for-insertion) + + ;; Create a message that has a foreign invisibility property on + ;; its trailing newline that's not claimed by the next message. + (let ((erc-insert-post-hook + (lambda () + (put-text-property (point-min) (point-max) 'invisible 'b)))) + (erc-display-message nil 'notice (current-buffer) "before")) + (should (eq 'b (get-text-property (1- erc-insert-marker) 'invisible))) + + ;; Insert a message that's hidden with `erc--hide-message'. It + ;; advertises `invisible' value `a', applied on the trailing + ;; newline of the previous message. + (let ((erc-insert-post-hook (lambda () (erc--hide-message 'a)))) + (erc-display-message nil 'notice (current-buffer) "after")) + + (goto-char (point-min)) + (should (search-forward "*** before\n" nil t)) + (should (equal '(a b) (get-text-property (1- (point)) 'invisible))) + + ;; Splice in a new message. + (let ((erc--insert-line-function + #'erc--insert-before-markers-transplanting-hidden) + (erc--insert-marker (copy-marker (point)))) + (goto-char (point-max)) + (erc-display-message nil 'notice (current-buffer) "middle")) + + (goto-char (point-min)) + (should (search-forward "*** before\n" nil t)) + (should (eq 'b (get-text-property (1- (point)) 'invisible))) + (should (looking-at (rx "*** middle\n"))) + (should (eq 'a (get-text-property (pos-eol) 'invisible))) + (forward-line) + (should (looking-at (rx "*** after\n"))) + + (setq buffer-invisibility-spec nil) + (when noninteractive (kill-buffer)))) + +(ert-deftest erc--delete-inserted-message-naively () (erc-mode) (erc--initialize-markers (point) nil) ;; Put unique invisible properties on the line endings. @@ -1945,7 +1986,7 @@ (should (eq 'datestamp (get-text-property (point) 'erc--msg))) (should (eq (point) (field-beginning (1+ (point))))) - (erc--delete-inserted-message (point)) + (erc--delete-inserted-message-naively (point)) ;; Preceding line ending clobbered, replaced by trailing. (should (looking-back (rx "*** one\n"))) @@ -1961,7 +2002,7 @@ (p (point))) (set-marker-insertion-type m t) (goto-char (point-max)) - (erc--delete-inserted-message p) + (erc--delete-inserted-message-naively p) (should (= (marker-position n) p)) (should (= (marker-position m) p)) (goto-char p) @@ -1975,7 +2016,7 @@ (should (looking-at (rx "*** three\n"))) (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (let ((erc-legacy-invisible-bounds-p t)) - (erc--delete-inserted-message (point)))) + (erc--delete-inserted-message-naively (point)))) (should (looking-at (rx "*** four\n")))) (ert-info ("Deleting most recent message preserves markers") @@ -1985,7 +2026,7 @@ (should (equal "*** four\n" (buffer-substring p erc-insert-marker))) (set-marker-insertion-type m t) (goto-char (point-max)) - (erc--delete-inserted-message p) + (erc--delete-inserted-message-naively p) (should (= (marker-position m) p)) (should (= (marker-position n) p)) (goto-char p) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 9ad5ce49429..c7d5c9d6677 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -194,6 +194,7 @@ Dialog resource directories are located by expanding the variable (ert-info ("Running extra teardown") (funcall erc-scenarios-common-extra-teardown))) + (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) (when (and (boundp 'erc-autojoin-mode) (not (eq erc-autojoin-mode ,orig-autojoin-mode))) (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) @@ -325,6 +326,12 @@ See Info node `(emacs) Term Mode' for the various commands." erc-scenarios-common-interactive-debug-term-p)) (erc-scenarios-common-with-cleanup ,@body))) +(defun erc-scenarios-common--assert-date-stamps () + "Ensure all date stamps are accounted for." + (dolist (stamp erc-stamp--date-stamps) + (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp) + 'erc--msg))))) + (defun erc-scenarios-common-assert-initial-buf-name (id port) ;; Assert no limbo period when explicit ID given (should (string= (if id 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 @@ For simplicity, assume string evaluates to itself." (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 @@ string." (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 @@ string." ;; 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.39.5