From d1953a07330c46a18925e2d2fb901741b0641298 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 28 May 2025 09:55:58 -0700 Subject: [PATCH] Don't delete in-place when replacing a display property When calling 'add-display-text-property' on a region of text that already contains PROP, we first delete the old display specification from the region. If the region's 'display' property is a list of display specifications, we need to avoid destructively modifying the list; other regions of text could be using the same list object. (For a 'display' property that's a vector or a single display spec, this doesn't matter since we first make a new list in the code.) In addition, be more careful when working with a display property like ((margin ...) ...). This is a single display specification, not a list of display specs. * lisp/emacs-lisp/subr-x.el (add-display-text-property): Don't delete in-place for list values. Handle (margin ...) display specification type correctly. * test/lisp/emacs-lisp/subr-x-tests.el (subr-x-test-add-display-text-property): Update test. (cherry picked from commit 4a3c8e6e1df44b187b7286747e363232e8b4e0ea) --- lisp/emacs-lisp/subr-x.el | 22 ++++++++++++----- test/lisp/emacs-lisp/subr-x-tests.el | 37 ++++++++++++++++++++++------ 2 files changed, 45 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 2df580e4211..df4565658b5 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -432,22 +432,32 @@ this defaults to the current buffer." (put-text-property sub-start sub-end 'display (list prop value) object) ;; We have old properties. - (let ((vector nil)) + (let (type) ;; Make disp into a list. (setq disp (cond ((vectorp disp) - (setq vector t) + (setq type 'vector) (seq-into disp 'list)) - ((not (consp (car disp))) + ((or (not (consp (car-safe disp))) + ;; If disp looks like ((margin ...) ...), that's + ;; still a single display specification. + (eq (caar disp) 'margin)) + (setq type 'scalar) (list disp)) (t + (setq type 'list) disp))) ;; Remove any old instances. - (when-let ((old (assoc prop disp))) - (setq disp (delete old disp))) + (when-let* ((old (assoc prop disp))) + ;; If the property value was a list, don't modify the + ;; original value in place; it could be used by other + ;; regions of text. + (setq disp (if (eq type 'list) + (remove old disp) + (delete old disp)))) (setq disp (cons (list prop value) disp)) - (when vector + (when (eq type 'vector) (setq disp (seq-into disp 'vector))) ;; Finally update the range. (put-text-property sub-start sub-end 'display disp object))) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index f6675637fef..5ffbe64ae40 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -696,18 +696,39 @@ (insert "Foo bar zot gazonk") (add-display-text-property 4 8 'height 2.0) (add-display-text-property 2 12 'raise 0.5) - (should (equal (get-text-property 2 'display) '(raise 0.5))) - (should (equal (get-text-property 5 'display) - '((raise 0.5) (height 2.0)))) - (should (equal (get-text-property 9 'display) '(raise 0.5)))) + (add-display-text-property 6 10 'height 1.0) + (should (equal-including-properties + (buffer-string) + #("Foo bar zot gazonk" + 1 3 (display (raise 0.5)) + 3 5 (display ((raise 0.5) (height 2.0))) + 5 9 (display ((height 1.0) (raise 0.5))) + 9 11 (display (raise 0.5)))))) (with-temp-buffer (insert "Foo bar zot gazonk") (put-text-property 4 8 'display [(height 2.0)]) (add-display-text-property 2 12 'raise 0.5) - (should (equal (get-text-property 2 'display) '(raise 0.5))) - (should (equal (get-text-property 5 'display) - [(raise 0.5) (height 2.0)])) - (should (equal (get-text-property 9 'display) '(raise 0.5)))) + (add-display-text-property 6 10 'height 1.0) + (should (equal-including-properties + (buffer-string) + #("Foo bar zot gazonk" + 1 3 (display (raise 0.5)) + 3 5 (display [(raise 0.5) (height 2.0)]) + 5 7 (display [(height 1.0) (raise 0.5)]) + 7 9 (display ((height 1.0) (raise 0.5))) + 9 11 (display (raise 0.5)))))) + (with-temp-buffer + (insert "Foo bar zot gazonk") + (add-display-text-property 4 8 '(margin nil) "Hi") + (add-display-text-property 2 12 'raise 0.5) + (add-display-text-property 6 10 '(margin nil) "Bye") + (should (equal-including-properties + (buffer-string) + #("Foo bar zot gazonk" + 1 3 (display (raise 0.5)) + 3 5 (display ((raise 0.5) ((margin nil) "Hi"))) + 5 9 (display (((margin nil) "Bye") (raise 0.5))) + 9 11 (display (raise 0.5)))))) (with-temp-buffer (should (equal-including-properties (let ((str (copy-sequence "some useless string"))) -- 2.39.5