From d8870a3dede52045518dc24a53143295df899943 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 27 Sep 2023 06:33:06 -0700 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Prefer ticks/hz pairs for some ERC timestamps on 29+ [5.6] Fix date-stamp invisibility in erc-fill-wrap [5.6] Add command to refill buffer with erc-fill-wrap-mode etc/ERC-NEWS | 12 +- lisp/erc/erc-compat.el | 15 +++ lisp/erc/erc-fill.el | 96 +++++++++++---- lisp/erc/erc-stamp.el | 119 ++++++++++++++++--- 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 +++++++++++++++++++++++++++ 8 files changed, 574 insertions(+), 62 deletions(-) Interdiff: 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-compat.el b/lisp/erc/erc-compat.el index 4dae578de67..4c376cfbc22 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -444,11 +444,20 @@ erc-compat--29-browse-url-irc (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) existing)))))) +;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because +;; `time-less-p' and friends do +;; +;; message("obsolete timestamp with cdr ...", ...) +;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...) +;; lisp_time_struct(...) +;; time_cmp(...) +;; +;; which spams *Messages* (and stderr when running the test suite). (defmacro erc-compat--current-lisp-time () - "Return `current-time' as a frequency pair." + "Return `current-time' as a (TICKS . HZ) pair on 29+." (if (>= emacs-major-version 29) '(let (current-time-list) (current-time)) - '(time-convert nil t))) + '(current-time))) (provide 'erc-compat) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 78b29b51cf7..b419fb57bd4 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -488,20 +488,19 @@ erc-fill--wrap-measure "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)) - (save-restriction - (narrow-to-region beg end) - (let (buffer-invisibility-spec) - (list (car (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 multi-line \"date\" stamp, similar to that provided by -the default value of `erc-timestamp-format-left'. Add -`erc-stamp-type' property with the symbol `date-left' as its -value. Possibly adjust invisibility interval to begin at the -previous newline and extend until the end of the last line of the -stamp, not including its line ending." +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") @@ -510,18 +509,8 @@ erc-fill--wrap-stamp-insert-prefixed-date (point))) (width (erc-fill--wrap-measure beg end))) (delete-region (1- end) end) - ;; Offset existing invisibility bounds by decrementing. See - ;; `erc-legacy-invisible-bounds-p'. - (when-let ((invisible (get-text-property (point) 'invisible)) - (min (point-min))) - (save-restriction - (widen) - (remove-text-properties (max 1 (1- min)) (1+ (point)) '(invisible nil)) - (narrow-to-region min (1+ (point))) - (erc--hide-message invisible))) - (put-text-property (point-min) (point) 'erc-stamp-type 'date-left) ;; Use `point-min' instead of `beg' to cover leading newilnes. - (put-text-property (point-min) (point) 'line-prefix + (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 diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 4e16906c550..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,21 +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. Include -line endings present in `erc-timestamp-format-left' 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'." +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 @@ -627,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 e4b0cd0ddbe..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 @@ -8078,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." @@ -8109,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 bf74806207d..bc06d58c3e9 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -328,20 +328,25 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap ;; Line ending has the `invisible' property `match-fools'. (should (= (char-after mend) ?\n)) - (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) - (if erc-legacy-invisible-bounds-p - (should (eq (get-text-property mend 'invisible) 'match-fools)) - (should (eq (get-text-property mbeg 'invisible) 'match-fools)) - (should-not (get-text-property mend 'invisible)))))) + (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 @@ -349,7 +354,7 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap (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 match-fools))) + (should (equal val 'timestamp)) (should (= (text-property-not-all (- (point) 2) (point-max) 'invisible val) (pos-eol)))))) @@ -381,7 +386,7 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap (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 () +(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds) (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) @@ -405,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) @@ -437,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 @@ -475,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