From 4b16614f2e3ec9f9a376de54efa8f9ffe8dea7af Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 21 Sep 2023 23:54:31 -0700 Subject: [PATCH 2/3] [5.6] Fix date-stamp invisibility in erc-fill-wrap * etc/ERC-NEWS: Mention that `erc-timestamp-format-left' now officially requires a trailing newline to work correctly. * lisp/erc/erc-fill.el (erc-fill--wrap-measure): New helper function, factored out from common code shared by `erc-fill-wrap' and `erc-fill--wrap-stamp-insert-prefixed-date'. (erc-fill--wrap-stamp-insert-prefixed-date): Refactor for more general use and decrement `invisible' bounds, when applicable. (erc-fill-wrap): Use helper `erc-fill--wrap-measure'. * lisp/erc/erc-stamp.el (erc-stamp--custom-trailing-newline-p, erc-stamp--custom-validate-date-stamp): New Custom type validation functions to avoid difficult-to-read closures appearing in `setopt' warnings. (erc-timestamp-format-left): Mention that value should contain a trailing newline, and drop `nil' from Custom :type spec because users who don't want date stamps should use `erc-timestamp-format-right' instead. (erc-stamp--inherited-props): Add doc string. (erc-stamp--decrement-date-invisibility-bounds): New function to implement expected `invisible' interval adjustments needed by the flag `erc-legacy-invisible-bounds-p' when nil. (erc-stamp--checked-date-string-p): New internal flag variable to track whether users whose `erc-timestamp-format-left' value lacks a trailing newline have been warned in the current session. (erc-insert-timestamp-left-and-right): Mention intervals of relevant text props in doc string. Add text property `erc-stamp-type' to inserted date stamps to help folks distinguish between them and other left-sided stamps. Shadow `erc-stamp--invisible-property' when calling `erc-format-timestamp' in order to prevent date stamps from inheriting other `invisible' props. These stamps are special in that they have no business being hidden along with the current message. Also, appeal to `erc-stamp--decrement-date-invisibility-bounds' in offset the invisibility interval when `erc-legacy-invisible-bounds-p' is nil. * lisp/erc/erc.el (erc-insert-modify-hook): Mention reserved depth ranges for built-in members in doc string. (erc--remove-from-prop-value-list): New function for removing `invisible' and `face' prop members cleanly. (erc--hide-message): Don't bother offsetting start of first message in a buffer. (erc--own-property-names): Add `erc-stamp-type'. (erc--persistent-message-properties): New variable. (erc-restore-text-properties): Extend role to cover persistent as well as ephemeral props that only exist during message insertion for the benefit of hooks. (erc--get-eq-comparable-cmd): Use `if-let' instead of `if-let*'. * test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp): Ensure `erc-stamp' is loaded. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--stamp-right-fools-invisible): Remove misplaced ERT tag from function. (erc-scenarios-match--fill-wrap-stamp-dedented-p): New assertion utility function. (erc-scenarios-match--stamp-both-invisible-fill-wrap) New test. (erc-scenarios-match--stamp-both-invisible-fill-static): Expect `erc-command' at beginning of inserted message's filled line, even if it starts with whitespace. This is a consequence of the change above to `erc-restore-text-properties'. Also, add new function parameter `assert-ds', a callback to run when visiting the second date stamp, which is followed by a hidden message. In the test of the same name, expect the date stamp's invisibility interval to begin at the newline after the previous message and to not contain any existing invisibility props, namely, those belonging to the subsequent hidden "fools" message. (erc-scenarios-match--stamp-both-invisible-fill-static--nooffset): Expect the date stamp's invisibility interval to match its field's instead of starting and ending sooner. * test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list, erc--remove-from-prop-value-list/many): New tests. (Bug#60936) --- etc/ERC-NEWS | 12 +- lisp/erc/erc-fill.el | 45 +++---- lisp/erc/erc-stamp.el | 117 ++++++++++++++++--- lisp/erc/erc.el | 61 ++++++++-- test/lisp/erc/erc-scenarios-log.el | 1 + test/lisp/erc/erc-scenarios-match.el | 163 ++++++++++++++++++++++++-- test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++ 7 files changed, 507 insertions(+), 61 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 05e933930e2..6743e49cfec 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -149,13 +149,17 @@ minor-mode maps, and new third-party modules should do the same. ** Option 'erc-timestamp-format-right' deprecated. Having to account for this option prevented other ERC modules from -easily determining what right-hand stamps would look like before +easily determining what right-sided stamps would look like before insertion, which is knowledge needed for certain UI decisions. The way ERC has chosen to address this is imperfect and boils down to asking users who've customized this option to switch to -'erc-timestamp-format' instead. If you're affected by this and feel -that some other solution, like automatic migration, is justified, -please make that known on the bug list. +'erc-timestamp-format' instead. Somewhat relatedly, the companion +option 'erc-timestamp-format-left', which determines the look of date +stamps, must now end in a newline. Although this has long been the +case in practice, it's now been made official. As always, if you're +affected by these changes and feel that other solutions, like +automatic migration, are justified, please make that known on the bug +list. ** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly. It's no secret that the 'buttons' module treats potential nicknames diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index f4835f71278..d323682476d 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -484,25 +484,34 @@ erc-fill--wrap-continued-message-p ((erc-nick-equal-p props nick)))) (set-marker erc-fill--wrap-last-msg (point-min)))) -(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args) - "Apply `line-prefix' property to args." - (let* ((ts-left (car args)) - (start) +(defun erc-fill--wrap-measure (beg end) + "Return display spec width for inserted region between BEG and END. +Ignore any `invisible' props that may be present when figuring." + (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size)) + ;; `buffer-text-pixel-size' can move point! + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let (buffer-invisibility-spec) + (list (car (buffer-text-pixel-size)))))) + (- end beg))) + +(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _) + "Apply `line-prefix' property to args. +Expect a multiline \"date\" stamp ending in a newline, similar to +the default value of `erc-timestamp-format-left'. Omit the +`line-prefix' from any trailing newlines." + (let* ((beg) ;; Insert " " to simulate gap between and msg beg. (end (save-excursion (skip-chars-backward "\n") - (setq start (pos-bol)) + (setq beg (pos-bol)) (insert " ") (point))) - (width (if (and erc-fill-wrap-use-pixels - (fboundp 'buffer-text-pixel-size)) - (save-restriction (narrow-to-region start end) - (list (car (buffer-text-pixel-size)))) - (length (string-trim-left ts-left))))) + (width (erc-fill--wrap-measure beg end))) (delete-region (1- end) end) - ;; Use `point-min' instead of `start' to cover leading newilnes. - (put-text-property (point-min) (point) 'line-prefix - `(space :width (- erc-fill--wrap-value ,width)))) - args) + ;; Use `point-min' instead of `beg' to cover leading newilnes. + (put-text-property (point-min) (1- end) 'line-prefix + `(space :width (- erc-fill--wrap-value ,width))))) ;; An escape hatch for third-party code expecting speakers of ACTION ;; messages to be exempt from `line-prefix'. This could be converted @@ -536,12 +545,8 @@ erc-fill-wrap (put-text-property (point-min) (point) 'display "") 0) - ((and erc-fill-wrap-use-pixels - (fboundp 'buffer-text-pixel-size)) - (save-restriction - (narrow-to-region (point-min) (point)) - (list (car (buffer-text-pixel-size))))) - (t (- (point) (point-min)))))))) + (t + (erc-fill--wrap-measure (point-min) (point)))))))) (erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n" '(line-prefix wrap-prefix) nil `((space :width (- erc-fill--wrap-value ,len)) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 0f3163bf68d..68dd1f287cf 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -55,21 +55,35 @@ erc-timestamp-format :type '(choice (const nil) (string))) -;; FIXME remove surrounding whitespace from default value and have -;; `erc-insert-timestamp-left-and-right' add it before insertion. +(defun erc-stamp--custom-trailing-newline-p (_ value) + "Return non-nil if VALUE ends in a newline." + (string-suffix-p "\n" value)) -(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" - "If set to a string, messages will be timestamped. -This string is processed using `format-time-string'. -Good examples are \"%T\" and \"%H:%M\". - -This timestamp is used for timestamps on the left side of the -screen when `erc-insert-timestamp-function' is set to -`erc-insert-timestamp-left-and-right'. +(defun erc-stamp--custom-validate-date-stamp (widget) + "Fail unless WIDGET's value ends in a newline." + (unless (string-suffix-p "\n" (widget-value widget)) + (widget-put widget :error "Value lacks a trailing newline") + widget)) -If nil, timestamping is turned off." - :type '(choice (const nil) - (string))) +(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" + "Format recognized by `format-time-string' for date stamps. +Only considered when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. Used for displaying date +stamps on their own line, between messages. As of ERC 5.6, this +module appends a trailing newline on insertion if needed. Any +extra newlines, leading or trailing, become empty lines. For +example, the default value results in an empty line after the +previous message, followed by the timestamp on its own line, +followed immediately by the next message on the next line. ERC +expects to display these stamps less frequently, so the +formatting specifiers should reflect that. To omit these stamps +entirely, use a different `erc-insert-timestamp-function', such +as `erc-timestamp-format-right'." + :type '(string :validate erc-stamp--custom-validate-date-stamp + :match erc-stamp--custom-trailing-newline-p) + :set (lambda (sym val) + (set-default sym + (if (string-suffix-p "\n" val) val (concat val "\n"))))) (defcustom erc-timestamp-format-right nil "If set to a string, messages will be timestamped. @@ -374,7 +388,15 @@ erc-stamp-prefix-log-filter (zerop (forward-line)))) "") -(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) +;; These are currently extended manually, but we could also bind +;; `text-property-default-nonsticky' and call `insert-and-inherit' +;; instead of `insert', but we'd have to pair the props with differing +;; boolean values for left and right stamps. Also, since this hook +;; runs last, we can't expect overriding sticky props to be absent, +;; even though, as of 5.6, `front-sticky' is only added by the +;; `readonly' module after hooks run. +(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix) + "Extant properties at the start of a message inherited by the stamp.") (declare-function erc--remove-text-properties "erc" (string)) @@ -604,14 +626,69 @@ erc-stamp--insert-date-function A local module might use this to modify text properties, `insert-before-markers' or renarrow the region after insertion.") +(defun erc-stamp--decrement-date-invisibility-bounds () + "Extend `invisible' prop to previous newline before date stamp. +And apply original prop value from message body to any trailing +newlines after date." + (let ((beg (point-min))) + (save-restriction + (widen) + (when (and (> beg 4) (= (char-before beg) ?\n)) + (when-let ((this (get-text-property (point) 'invisible)) + (prev (get-text-property (1- beg) 'invisible)) + ((not (equal this prev)))) + (put-text-property (1- beg) beg 'invisible + (seq-difference (ensure-list prev) + (ensure-list this)))) + (put-text-property (1- beg) beg 'invisible 'timestamp))) + (cl-assert (= ?\n (char-before (point)))) + ;; Only decrement bounds by one. Additional newlines in the + ;; timestamp must be hidden. + (if-let ((existing (remq 'timestamp + (ensure-list erc-stamp--invisible-property)))) + (put-text-property (1- (point)) (point) 'invisible + (if (cdr existing) existing (car existing))) + (erc--remove-from-prop-value-list + (1- (point)) (point) 'invisible 'timestamp)))) + +(defvar-local erc-stamp--checked-date-string-p nil + "Non-nil if date string has been validated for current buffer.") + (defun erc-insert-timestamp-left-and-right (string) "Insert a stamp on either side when it changes. When the deprecated option `erc-timestamp-format-right' is nil, use STRING, which originates from `erc-timestamp-format', for the right-hand stamp. Use `erc-timestamp-format-left' for the -left-hand stamp and expect it to change less frequently." +left-hand stamp and expect it to change less frequently. Include +line endings found in `erc-timestamp-format-left' (or affixed by +ERC) as part of the `erc-timestamp' field, which extends to the +start of the message proper. Do this so other code knows the +stamp is part of the subsequent IRC message even though it may +appear on its own line. However, allow the stamp's `invisible' +property to span a different interval, in order to satisfy newer +folding requirements related to `erc-legacy-invisible-bounds-p'. +Additionally, ensure every date stamp formatted with the option +`erc-timestamp-format-left' has the property `erc-stamp-type' set +to the symbol `date-left' so that modules can easily distinguish +between other left-sided stamps and date stamps inserted by this +function." + (unless erc-stamp--checked-date-string-p + (setq erc-stamp--checked-date-string-p t) + (unless (string-suffix-p "\n" erc-timestamp-format-left) + (setq erc-timestamp-format-left + (concat erc-timestamp-format-left "\n")) + (unless erc--target + (erc-button--display-error-notice-with-keys + (current-buffer) + "ERC only supports values of `%s' that end in a ?\\n." + " Changing value for current session to: %s." + " Update your config accordingly to silence this message." + 'erc-timestamp-format-left + (let ((print-escape-newlines t)) + (prin1-to-string erc-timestamp-format-left)))))) (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + (ts-left (let ((erc-stamp--invisible-property 'timestamp)) + (erc-format-timestamp ct erc-timestamp-format-left))) (ts-right (with-suppressed-warnings ((obsolete erc-timestamp-format-right)) (if erc-timestamp-format-right @@ -620,8 +697,14 @@ erc-insert-timestamp-left-and-right ;; insert left timestamp (unless (string-equal ts-left erc-timestamp-last-inserted-left) (goto-char (point-min)) - (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) + (add-text-properties 0 (length ts-left) + '(field erc-timestamp erc-stamp-type date-left) + ts-left) (funcall erc-stamp--insert-date-function ts-left) + (unless (with-suppressed-warnings + ((obsolete erc-legacy-invisible-bounds-p)) + erc-legacy-invisible-bounds-p) + (erc-stamp--decrement-date-invisibility-bounds)) (setq erc-timestamp-last-inserted-left ts-left)) ;; insert right timestamp (let ((erc-timestamp-only-if-changed-flag t) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ec4fae548c7..db2e20c800e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1128,9 +1128,13 @@ erc-insert-modify-hook "Insertion hook for functions that will change the text's appearance. This hook is called just after `erc-insert-pre-hook' when the value of `erc-insert-this' is t. -While this hook is run, narrowing is in effect and `current-buffer' is -the buffer where the text got inserted. One possible value to add here -is `erc-fill'." + +ERC runs this hook with the buffer narrowed to the bounds of the +inserted message plus a trailing newline. Built-in modules place +their hook members at depths between 20 and 80, with those from +the stamp module always running last. Use the functions +`erc-find-parsed-property' and `erc-get-parsed-vector' to locate +and extract the `erc-response' object for the inserted message." :group 'erc-hooks :type 'hook) @@ -3037,6 +3041,30 @@ erc--merge-prop old (get-text-property pos prop object) 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. +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." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (when old + (if (setq new (and (consp old) (if (consp val) + (seq-difference old val) + (remq val old)))) + (put-text-property pos end prop + (if (cdr new) new (car new)) object) + (when (pcase val + ((pred consp) (or (consp old) (memq old val))) + (_ (if (consp old) (memq val old) (eq old val)))) + (remove-text-properties pos end (list prop nil) object)))) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + (defvar erc-legacy-invisible-bounds-p nil "Whether to hide trailing rather than preceding newlines. Beginning in ERC 5.6, invisibility extends from a message's @@ -3046,7 +3074,11 @@ erc-legacy-invisible-bounds-p (defun erc--hide-message (value) "Apply `invisible' text-property with VALUE to current message. -Expect to run in a narrowed buffer during message insertion." +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." (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. @@ -3055,6 +3087,8 @@ erc--hide-message (end (point-max))) (save-restriction (widen) + (when (or (<= beg 4) (= ?\n (char-before (- beg 2)))) + (cl-incf beg)) (erc--merge-prop (1- beg) (1- end) 'invisible value))))) (defun erc-display-message-highlight (type string) @@ -4770,6 +4804,7 @@ erc--own-property-names rear-nonsticky erc-prompt field front-sticky read-only ;; stamp cursor-intangible cursor-sensor-functions isearch-open-invisible + erc-stamp-type ;; match invisible intangible ;; button @@ -8071,13 +8106,21 @@ erc-find-parsed-property "Find the next occurrence of the `erc-parsed' text property." (text-property-not-all (point-min) (point-max) 'erc-parsed nil)) +(defvar erc--persistent-message-properties '(erc-command)) + (defun erc-restore-text-properties () - "Restore the property `erc-parsed' for the region." - (when-let* ((parsed-posn (erc-find-parsed-property)) - (found (erc-get-parsed-vector parsed-posn))) + "Ensure the `erc-parsed' property covers the narrowed buffer. +Do this for other properties added by `erc-display-message' and +for those named in `erc--persistent-message-properties'." + (when-let ((parsed-posn (erc-find-parsed-property)) + (found (erc-get-parsed-vector parsed-posn))) (put-text-property (point-min) (point-max) 'erc-parsed found) (when-let ((tags (get-text-property parsed-posn 'tags))) - (put-text-property (point-min) (point-max) 'tags tags)))) + (put-text-property (point-min) (point-max) 'tags tags)) + (let ((to (max (point-min) (1- (point-max))))) + (dolist (prop erc--persistent-message-properties) + (when-let ((val (get-text-property parsed-posn prop))) + (put-text-property (point-min) to prop val)))))) (defun erc-get-parsed-vector (point) "Return the whole parsed vector on POINT." @@ -8102,7 +8145,7 @@ erc--get-eq-comparable-cmd See also `erc-message-type'." ;; IRC numerics are three-digit numbers, possibly with leading 0s. ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o)) - (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n)) + (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n)) ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index fd030d90c2f..f7e7d61c92e 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook (ert-deftest erc-scenarios-log--clear-stamp () :tags '(:expensive-test) + (require 'erc-stamp) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/assoc/bouncer-history") (dumb-server (erc-d-run "localhost" t 'foonet)) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index cd899fddb98..bc06d58c3e9 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -167,7 +167,6 @@ erc-scenarios-match--find-eol ;; In most cases, `erc-hide-fools' makes line endings invisible. (defun erc-scenarios-match--stamp-right-fools-invisible () - :tags '(:expensive-test) (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) (erc-scenarios-match--invisible-stamp @@ -271,7 +270,123 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(defun erc-scenarios-match--stamp-both-invisible-fill-static () +(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point) + (pcase (get-text-property point 'line-prefix) + (`(space :width (- erc-fill--wrap-value (,n))) + (if (display-graphic-p) (< 100 n 200) (< 10 n 30))) + (`(space :width (- erc-fill--wrap-value ,n)) + (< 10 n 30)))) + +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-wrap () + + ;; Rewind the clock to known date artificially. + (let ((erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-wrap) + (bob-utterance-counter 0)) + + (erc-scenarios-match--invisible-stamp + + (lambda () + (ert-info ("Baseline check") + ;; False date printed initially before anyone speaks. + (when (zerop bob-utterance-counter) + (save-excursion + (goto-char (point-min)) + (search-forward "[Wed Apr 29 1992]") + ;; First stamp in a buffer is not invisible from previous + ;; newline (before stamp's own leading newline). + (should (= 4 (match-beginning 0))) + (should (get-text-property 3 'invisible)) + (should-not (get-text-property 2 'invisible)) + (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4)) + (search-forward "[23:59]")))) + + (ert-info ("Line endings in Bob's messages are invisible") + ;; The message proper has the `invisible' property `match-fools'. + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) + (let* ((mbeg (or (and (get-text-property (pos-bol) 'erc-command) + (pos-bol)) + (next-single-property-change (pos-bol) + 'erc-command))) + (mend (text-property-not-all + mbeg (point-max) 'erc-command + (get-text-property mbeg 'erc-command)))) + + (if (/= 1 bob-utterance-counter) + (should-not (field-at-pos mend)) + ;; For Bob's stamped message, check newline after stamp. + (should (eq (field-at-pos mend) 'erc-timestamp)) + (setq mend (field-end mend))) + + ;; The `erc-timestamp' property spans entire messages, + ;; including stamps and filled text, which makes for + ;; convenient traversal when `erc-stamp-mode' is enabled. + (should (get-text-property (pos-bol) 'erc-timestamp)) + (should (= (next-single-property-change (pos-bol) 'erc-timestamp) + mend)) + + ;; Line ending has the `invisible' property `match-fools'. + (should (= (char-after mend) ?\n)) + (should (eq (get-text-property mbeg 'invisible) 'match-fools)) + (should-not (get-text-property mend 'invisible)))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (should (eq 'match-fools (get-text-property (point) 'invisible))) + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + (ert-info ("Stamp's NL `invisible' as fool, not timestamp") + (let ((end (match-end 0))) + (should (eq (char-after end) ?\n)) + (should (eq 'timestamp + (get-text-property (1- end) 'invisible))) + (should (eq 'match-fools + (get-text-property end 'invisible))))) + (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point))) + ;; Date stamp has a combined `invisible' property value + ;; that starts at the previous message's trailing newline + ;; and extends until the start of the message proper. + (should (equal ?\n (char-before (point)))) + (should (equal ?\n (char-before (1- (point))))) + (let ((val (get-text-property (- (point) 2) 'invisible))) + (should (equal val 'timestamp)) + (should (= (text-property-not-all (- (point) 2) (point-max) + 'invisible val) + (pos-eol)))))) + + (ert-info ("Current message's RHS stamp is hidden") + ;; Right stamp has `match-fools' property. + (save-excursion + (should-not (field-at-pos (point))) + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))) + + ;; Stamp invisibility starts where message's ends. + (let ((msgend (next-single-property-change (pos-bol) 'invisible))) + ;; Stamp has a combined `invisible' property value. + (should (equal (get-text-property msgend 'invisible) + '(timestamp match-fools))) + + ;; Combined `invisible' property spans entire timestamp. + (should (= (next-single-property-change msgend 'invisible) + (pos-eol)))))) + + (cl-incf bob-utterance-counter)) + + ;; Alice. + (lambda () + ;; Set clock ahead a week or so. + (setq erc-stamp--current-time 704962800) + + ;; This message has no time stamp and is completely visible. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (should-not (next-single-property-change (pos-bol) 'invisible)))))) + +(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds) (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) @@ -295,7 +410,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static (ert-info ("Line endings in Bob's messages are invisible") ;; The message proper has the `invisible' property `match-fools'. (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) - (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) + (let* ((mbeg (and (get-text-property (pos-bol) 'erc-command) + (pos-bol))) (mend (next-single-property-change mbeg 'erc-command))) (if (/= 1 bob-utterance-counter) @@ -327,12 +443,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static (forward-line -1) (goto-char (pos-bol)) (should (looking-at (rx "[Mon May 4 1992]"))) - ;; Date stamp has a combined `invisible' property value - ;; that extends until the start of the message proper. - (should (equal (get-text-property (point) 'invisible) - '(timestamp match-fools))) - (should (= (next-single-property-change (point) 'invisible) - (1+ (pos-eol)))))) + (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n + (funcall assert-ds))) ; "assert date stamp" (ert-info ("Folding preserved despite invisibility") ;; Message has a trailing time stamp, but it's been folded @@ -365,13 +477,42 @@ erc-scenarios-match--stamp-both-invisible-fill-static (ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () :tags '(:expensive-test) - (erc-scenarios-match--stamp-both-invisible-fill-static)) + (erc-scenarios-match--stamp-both-invisible-fill-static + + (lambda () + ;; Date stamp has an `invisible' property that starts from the + ;; newline delimiting the current and previous messages and + ;; extends until the stamp's final newline. It is not combined + ;; with the old value, `match-fools'. + (let ((delim-pos (- (point) 2))) + (should (equal 'timestamp (get-text-property delim-pos 'invisible))) + ;; Stamp-only invisibility ends before its last newline. + (should (= (text-property-not-all delim-pos (point-max) + 'invisible 'timestamp) + (match-end 0))))))) ; pos-eol (ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset () :tags '(:expensive-test) (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) - (erc-scenarios-match--stamp-both-invisible-fill-static)))) + (erc-scenarios-match--stamp-both-invisible-fill-static + + (lambda () + ;; Date stamp has an `invisible' property that covers its + ;; format string exactly. It is not combined with the old + ;; value, `match-fools'. + (let ((delim-prev (- (point) 2))) + (should-not (get-text-property delim-prev 'invisible)) + (should (eq 'erc-timestamp (field-at-pos (point)))) + (should (= (next-single-property-change delim-prev 'invisible) + (field-beginning (point)))) + (should (equal 'timestamp + (get-text-property (1- (point)) 'invisible))) + ;; Stamp-only invisibility includes last newline. + (should (= (text-property-not-all (1- (point)) (point-max) + 'invisible 'timestamp) + (field-end (point)))))))))) ;;; erc-scenarios-match.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 05d45b2d027..3fb96ae64d3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1385,6 +1385,175 @@ erc--merge-prop (when noninteractive (kill-buffer)))) +(ert-deftest erc--remove-from-prop-value-list () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Non-list match. + (insert "abc\n") + (put-text-property 1 2 'erc-test 'a) + (put-text-property 2 3 'erc-test 'b) + (put-text-property 3 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 1 2 (erc-test b) + 2 3 (erc-test c)))) + + (erc--remove-from-prop-value-list 1 4 'erc-test 'b) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'a) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "abc")) + + ;; List match. + (goto-char (point-min)) + (insert "def\n") + (put-text-property 1 2 'erc-test '(d x)) + (put-text-property 2 3 'erc-test '(e y)) + (put-text-property 3 4 'erc-test '(f z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x)) + 1 2 (erc-test (e y)) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x)) + 1 2 (erc-test e) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'd) + (erc--remove-from-prop-value-list 1 4 'erc-test 'f) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test x) + 1 2 (erc-test e) + 2 3 (erc-test z)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'e) + (erc--remove-from-prop-value-list 1 4 'erc-test 'z) + (erc--remove-from-prop-value-list 1 4 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "def")) + + ;; List match. + (goto-char (point-min)) + (insert "ghi\n") + (put-text-property 1 2 'erc-test '(g x)) + (put-text-property 2 3 'erc-test '(h x)) + (put-text-property 3 4 'erc-test '(i y)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test (g x)) + 1 2 (erc-test (h x)) + 2 3 (erc-test (i y))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test g) + 1 2 (erc-test h) + 2 3 (erc-test (i y))))) + (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed + (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 1 2 (erc-test h) + 2 3 (erc-test y)))) + + ;; Pathological (,c) case (hopefully not created by ERC) + (goto-char (point-min)) + (insert "jkl\n") + (put-text-property 1 2 'erc-test '(j x)) + (put-text-property 2 3 'erc-test '(k)) + (put-text-property 3 4 'erc-test '(k)) + (erc--remove-from-prop-value-list 1 4 'erc-test 'k) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x))))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc--remove-from-prop-value-list/many () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Non-list match. + (insert "abc\n") + (put-text-property 1 2 'erc-test 'a) + (put-text-property 2 3 'erc-test 'b) + (put-text-property 3 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 1 2 (erc-test b) + 2 3 (erc-test c)))) + + (erc--remove-from-prop-value-list 1 4 'erc-test '(a b)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'a) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(c)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "abc")) + + ;; List match. + (goto-char (point-min)) + (insert "def\n") + (put-text-property 1 2 'erc-test '(d x y)) + (put-text-property 2 3 'erc-test '(e y)) + (put-text-property 3 4 'erc-test '(f z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x y)) + 1 2 (erc-test (e y)) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test x) + 1 2 (erc-test e) + 2 3 (erc-test z)))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "def")) + + ;; Narrowed beg. + (goto-char (point-min)) + (insert "ghi\n") + (put-text-property 1 2 'erc-test '(g x)) + (put-text-property 2 3 'erc-test '(h x)) + (put-text-property 3 4 'erc-test '(i x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test (g x)) + 1 2 (erc-test (h x)) + 2 3 (erc-test (i x))))) + (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 1 2 (erc-test h) + 2 3 (erc-test (i x))))) + + ;; Narrowed middle. + (goto-char (point-min)) + (insert "jkl\n") + (put-text-property 1 2 'erc-test '(j x)) + (put-text-property 2 3 'erc-test '(k)) + (put-text-property 3 4 'erc-test '(l y z)) + (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" + 0 1 (erc-test (j x)) + 1 2 (erc-test (k)) + 2 3 (erc-test l)))) + + (when noninteractive + (kill-buffer)))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space -- 2.41.0