[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master a4bae965e06 07/12: Easily excise list-valued text prop members in
|
From: |
F. Jason Park |
|
Subject: |
master a4bae965e06 07/12: Easily excise list-valued text prop members in ERC |
|
Date: |
Fri, 13 Oct 2023 10:49:36 -0400 (EDT) |
branch: master
commit a4bae965e06c982871cf01bb0fc3afc43c915bc5
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
Easily excise list-valued text prop members in ERC
* lisp/erc/erc.el (erc--remove-from-prop-value-list): New function for
removing `invisible' and `face' prop members cleanly.
* test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list,
erc--remove-from-prop-value-list/many): New tests. (Bug#60936)
---
lisp/erc/erc.el | 24 +++++++
test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 193 insertions(+)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3a0337eae9a..c3312000ffd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3079,6 +3079,30 @@ value. See also `erc-button-add-face'."
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
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 0b88ad9cfa9..ed89fd01d93 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1475,6 +1475,175 @@
(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
- master updated (bd297132016 -> baf778c7caa), F. Jason Park, 2023/10/13
- master 328a985651a 01/12: Skip post-minibuffer restore in erc-scrolltobottom-all, F. Jason Park, 2023/10/13
- master 9120d7a32ea 02/12: Honor nil values in erc--restore-initialize-priors, F. Jason Park, 2023/10/13
- master d46c016fbd0 03/12: Sort and dedupe when loading modules in erc-open, F. Jason Park, 2023/10/13
- master a4bae965e06 07/12: Easily excise list-valued text prop members in ERC,
F. Jason Park <=
- master c68dc7786fc 08/12: Manage some text props for ERC insertion-hook members, F. Jason Park, 2023/10/13
- master f8af241192b 10/12: Treat previous/next-line specially in erc-fill-wrap, F. Jason Park, 2023/10/13
- master 5e2be1e0ba6 09/12: Swap hook positions of erc-fill and erc-match-message, F. Jason Park, 2023/10/13
- master 1950ddebacb 04/12: Allow spoofing process marker in erc-display-line-1, F. Jason Park, 2023/10/13
- master 9c2f99b7d73 05/12: Use erc-display-message instead of erc-make-notice, F. Jason Park, 2023/10/13
- master baf778c7caa 12/12: More defcustom fixes in ERC (Bug#66520), F. Jason Park, 2023/10/13
- master f97fdf5e50e 06/12: Deprecate option erc-remove-parsed-property, F. Jason Park, 2023/10/13
- master 52af0a5fb97 11/12: Add command to refill buffer in erc-fill-wrap-mode, F. Jason Park, 2023/10/13