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)

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 2df580e42119c809dcacc273bf6815734a4c5dec..df4565658b5add0e26d937935c221f40d545cea3 100644 (file)
--- 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 f6675637fefe59bbeda8565ad0e1ff4b80201376..5ffbe64ae40d46a746269ce7da515749904a6cd5 100644 (file)
--- 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")))