Subject: bug#76018: 31.0.50; wrap-prefix properties from visual-wrap-prefix-mode proliferate

From: Jim Porter <[email-masked]>
Date: Wed, 28 May 2025 10:19:15 -0700

On 5/28/2025 7:46 AM, Stefan Monnier via Bug reports for GNU Emacs, the 
Swiss army knife of text editors wrote:
> Using the `rear-nonsticky` or `front-sticky` properties is a PITA with
> lots of odd corner cases, so I'd much rather we try to use the
> standard approach of removing all our properties at start.

Ok, I removed that. That means we don't need to add 
'append-text-property' just yet, though it would probably be a useful 
function to add one day.

I also wrote some tests for 'remove-display-text-property'. In the 
process of doing so, I found a nasty bug in the existing implementation 
(fixed in the first patch).

From 6e362ad378431c339f2bab7e417530fb49d40220 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Wed, 28 May 2025 09:55:58 -0700
Subject: [PATCH 1/3] Don't delete in-place when replacing a display property

When calling 'add-display-property' on a region of text that already
contains the specified display PROP, we delete the old property from the
list of values.  If this list came directly from the property value, we
need to be careful not to delete it in-place, since other regions of
text could be using the same list object.  Instead, if deleting a
property from a list, use 'remove'.

* lisp/emacs-lisp/subr-x.el (add-display-text-property): Don't delete
in-place for list values.

* test/lisp/emacs-lisp/subr-x-tests.el
(subr-x-test-add-display-text-property): Update test.
---
 lisp/emacs-lisp/subr-x.el            | 15 +++++++++++----
 test/lisp/emacs-lisp/subr-x-tests.el | 25 +++++++++++++++++--------
 2 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index eaa8119ead7..5f1f2805b69 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -438,22 +438,29 @@ add-display-text-property
           (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)))
+                  (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)))
+            ;; 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..5ceefd8d11c 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -696,18 +696,27 @@ subr-x-test-add-display-text-property
     (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
     (should (equal-including-properties
              (let ((str (copy-sequence "some useless string")))
-- 
2.25.1

From 36f52dce299e18e20535af5387d388ceb51ef711 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Wed, 28 May 2025 09:44:34 -0700
Subject: [PATCH 2/3] Clean up text properties in 'visual-wrap-prefix-mode'

Before refontifying a region, remove any text properties we care about
so that we don't end up with stray properties.  Additionally, make sure
to remove all the properties when deactivating the mode.

* lisp/emacs-lisp/subr-x.el (add-remove--display-text-property): New
function, extracted from...
(add-display-text-property): ... here.
(remove-display-text-property): New function.

* lisp/visual-wrap.el (visual-wrap--remove-properties): New function...
(visual-wrap-prefix-function, visual-wrap-prefix-mode): ... call it.

* test/lisp/emacs-lisp/subr-x-tests.el
(subr-x-test-remove-display-text-property): New test.

* test/lisp/visual-wrap-tests.el
(visual-wrap-tests/wrap-prefix-stickiness, visual-wrap-tests/cleanup):
New tests.

* doc/lispref/display.texi (Display Property): Document
'remove-display-text-property'.

* etc/NEWS: Announce 'remove-display-text-property' (bug#76018).
---
 doc/lispref/display.texi             | 32 ++++++++++++++
 etc/NEWS                             |  6 +++
 lisp/emacs-lisp/subr-x.el            | 65 +++++++++++++++++++---------
 lisp/visual-wrap.el                  | 11 ++++-
 test/lisp/emacs-lisp/subr-x-tests.el | 38 ++++++++++++++++
 test/lisp/visual-wrap-tests.el       | 40 ++++++++++++++++-
 6 files changed, 168 insertions(+), 24 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 3b48cb93405..77a53948b5e 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -5299,6 +5299,38 @@ Display Property
 If @code{nil}, this defaults to the current buffer.
 @end defun
 
+@defun remove-display-text-property start end prop &optional object
+Remove @code{display} property @var{prop} from the text from @var{start}
+to @var{end}.
+
+If any text in the region has any other @code{display} properties, those
+properties are retained.  For instance:
+
+@lisp
+(add-display-text-property 1 8 'raise 0.5)
+(add-display-text-property 4 8 'height 2.0)
+(remove-display-text-property 2 6 'raise)
+@end lisp
+
+After doing this, the text will have the following @code{display}
+properties:
+
+@itemize @bullet
+@item
+The region from 1 to 2, only @code{raise}
+
+@item
+The region from 2 to 4, no properties
+
+@item
+The region from 4 to 6, only @code{height}
+
+@item
+The region from 6 to 8, both @code{raise} and @code{height}
+
+@end itemize
+@end defun
+
 @cindex display property, unsafe evaluation
 @cindex security, and display specifications
   Some of the display specifications allow inclusion of Lisp forms,
diff --git a/etc/NEWS b/etc/NEWS
index 33b042720b5..c24ce45c228 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2339,6 +2339,12 @@ This 'display' property was previously supported only as text property.
 Now overlays can also have this property, with the same effect for the
 text "covered" by the overlay.
 
++++
+** New function 'remove-display-text-property'.
+This function removes a display property from the specified region of
+text, preserving any other display properties already set for that
+region.
+
 +++
 ** New macro 'cond*'.
 The new macro 'cond*' is an alternative to 'cond' and 'pcase'.
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 5f1f2805b69..a8cd256650b 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -416,29 +416,25 @@ string-glyph-split
         (setq start (1+ start))))
     (nreverse result)))
 
-;;;###autoload
-(defun add-display-text-property (start end prop value
-                                        &optional object)
-  "Add display property PROP with VALUE to the text from START to END.
-If any text in the region has a non-nil `display' property, those
-properties are retained.
-
-If OBJECT is non-nil, it should be a string or a buffer.  If nil,
-this defaults to the current buffer."
+(defun add-remove--display-text-property (start end prop value
+                                                &optional object remove)
   (let ((sub-start start)
         (sub-end 0)
+        (limit (if (stringp object)
+                   (min (length object) end)
+                 (min end (point-max))))
         disp)
     (while (< sub-end end)
       (setq sub-end (next-single-property-change sub-start 'display object
-                                                 (if (stringp object)
-                                                     (min (length object) end)
-                                                   (min end (point-max)))))
+                                                 limit))
       (if (not (setq disp (get-text-property sub-start 'display object)))
           ;; No old properties in this range.
-          (put-text-property sub-start sub-end 'display (list prop value)
-                             object)
+          (unless remove
+            (put-text-property sub-start sub-end 'display (list prop value)
+                               object))
         ;; We have old properties.
-        (let (type)
+        (let ((changed nil)
+              type)
           ;; Make disp into a list.
           (setq disp
                 (cond
@@ -458,14 +454,41 @@ add-display-text-property
             ;; regions of text.
             (setq disp (if (eq type 'list)
                            (remove old disp)
-                         (delete old disp))))
-          (setq disp (cons (list prop value) disp))
-          (when (eq type 'vector)
-            (setq disp (seq-into disp 'vector)))
-          ;; Finally update the range.
-          (put-text-property sub-start sub-end 'display disp object)))
+                         (delete old disp))
+                  changed t))
+          (unless remove
+            (setq disp (cons (list prop value) disp)
+                  changed t))
+          (when changed
+            (if (not disp)
+                (remove-text-properties sub-start sub-end '(display nil) object)
+              (when (eq type 'vector)
+                (setq disp (seq-into disp 'vector)))
+              ;; Finally update the range.
+              (put-text-property sub-start sub-end 'display disp object)))))
       (setq sub-start sub-end))))
 
+;;;###autoload
+(defun add-display-text-property (start end prop value
+                                        &optional object)
+  "Add display property PROP with VALUE to the text from START to END.
+If any text in the region has a non-nil `display' property, those
+properties are retained.
+
+If OBJECT is non-nil, it should be a string or a buffer.  If nil,
+this defaults to the current buffer."
+  (add-remove--display-text-property start end prop value object))
+
+;;;###autoload
+(defun remove-display-text-property (start end prop &optional object)
+  "Remove display property PROP from the text from START to END.
+If any text in the region has other `display' specs, those specs are
+retained.
+
+If OBJECT is non-nil, it should be a string or a buffer.  If nil,
+this defaults to the current buffer."
+  (add-remove--display-text-property start end prop nil object 'remove))
+
 ;;;###autoload
 (defun read-process-name (prompt)
   "Query the user for a process and return the process object."
diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
index b921e1f0549..9da19a6ff2a 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -226,6 +226,14 @@ visual-wrap-fill-context-prefix
         (propertize prefix 'face face)
       prefix)))
 
+(defun visual-wrap--remove-properties (start end)
+  "Remove visual wrapping text properties from START to END."
+  ;; Remove `min-width' from any prefixes we detected.
+  (remove-display-text-property start end 'min-width)
+  ;; Remove `wrap-prefix' related properties from any lines with
+  ;; prefixes we detected.
+  (remove-text-properties start end '(wrap-prefix nil)))
+
 (defun visual-wrap-prefix-function (beg end)
   "Indent the region between BEG and END with visual filling."
   ;; Any change at the beginning of a line might change its wrap
@@ -238,6 +246,7 @@ visual-wrap-prefix-function
   (goto-char beg)
   (forward-line 0)
   (setq beg (point))
+  (visual-wrap--remove-properties beg end)
   (while (< (point) end)
     ;; Check if the display property at the end of this line is "safe".
     (if (visual-wrap--display-property-safe-p
@@ -283,7 +292,7 @@ visual-wrap-prefix-mode
     (with-silent-modifications
       (save-restriction
         (widen)
-        (remove-text-properties (point-min) (point-max) '(wrap-prefix nil))))))
+        (visual-wrap--remove-properties (point-min) (point-max))))))
 
 ;;;###autoload
 (define-globalized-minor-mode global-visual-wrap-prefix-mode
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 5ceefd8d11c..eaf8e1e412e 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -728,6 +728,44 @@ subr-x-test-add-display-text-property
                4 8 (display ((raise 0.5) (height 2.0)))
                8 12 (display (raise 0.5)))))))
 
+(ert-deftest subr-x-test-remove-display-text-property ()
+  (with-temp-buffer
+    (insert "Foo bar zot gazonk")
+    (add-display-text-property 4 12 'height 2.0)
+    (add-display-text-property 2 8 'raise 0.5)
+    (remove-display-text-property 6 10 'height)
+    (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 ((raise 0.5)))
+               9 11 (display (height 2.0))))))
+  (with-temp-buffer
+    (insert "Foo bar zot gazonk")
+    (put-text-property 4 12 'display [(height 2.0)])
+    (add-display-text-property 2 8 'raise 0.5)
+    (remove-display-text-property 6 10 'height)
+    (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 [(raise 0.5)])
+               9 11 (display [(height 2.0)])))))
+  (with-temp-buffer
+    (should (equal-including-properties
+             (let ((str (copy-sequence "Foo bar zot gazonk")))
+               (add-display-text-property 3 11 'height 2.0 str)
+               (add-display-text-property 1 7 'raise 0.5 str)
+               (remove-display-text-property 5 9 'height str)
+               str)
+             #("Foo bar zot gazonk"
+               1 3 (display (raise 0.5))
+               3 5 (display ((raise 0.5) (height 2.0)))
+               5 7 (display ((raise 0.5)))
+               9 11 (display (height 2.0)))))))
+
 (ert-deftest subr-x-named-let ()
   (let ((funs ()))
     (named-let loop
diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el
index 04977afe207..d057ebef074 100644
--- a/test/lisp/visual-wrap-tests.el
+++ b/test/lisp/visual-wrap-tests.el
@@ -1,6 +1,6 @@
 ;;; visual-wrap-tests.el --- Tests for `visual-wrap-prefix-mode'  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2024 Free Software Foundation, Inc.
+;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -19,7 +19,7 @@
 
 ;;; Commentary:
 
-;; Tets for `visual-wrap-prefix-mode'.
+;; Tests for `visual-wrap-prefix-mode'.
 
 ;;; Code:
 
@@ -117,4 +117,40 @@ visual-wrap-tests/unsafe-display/multiple-2
               0 4 (display ((image :type bmp)))
               4 8 (display ((image :type bmp) (height 1.5))))))))
 
+(ert-deftest visual-wrap-tests/wrap-prefix-stickiness ()
+  "Test that `wrap-prefix' doesn't persist across multiple lines when typing.
+See bug#76018."
+  (with-temp-buffer
+    (insert "* this zoo contains goats")
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* this zoo contains goats"
+               0  2 ( wrap-prefix (space :align-to (2 . width))
+                      display (min-width ((2 . width))))
+               2 25 ( wrap-prefix (space :align-to (2 . width))))))
+    (let ((start (point)))
+      (insert-and-inherit "\n\nit also contains pandas")
+      (visual-wrap-prefix-function start (point-max)))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* this zoo contains goats\n\nit also contains pandas"
+               0  2 ( wrap-prefix (space :align-to (2 . width))
+                      display (min-width ((2 . width))))
+               2 25 ( wrap-prefix (space :align-to (2 . width))))))))
+
+(ert-deftest visual-wrap-tests/cleanup ()
+  "Test that deactivating `visual-wrap-prefix-mode' cleans up text properties."
+  (with-temp-buffer
+    (insert "* hello\n* hi")
+    (visual-wrap-prefix-function (point-min) (point-max))
+    ;; Make sure we've added the visual-wrapping properties.
+    (should (equal (text-properties-at (point-min))
+                   '( wrap-prefix (space :align-to (2 . width))
+                      display (min-width ((2 . width))))))
+    (visual-wrap-prefix-mode -1)
+    (should (equal-including-properties
+             (buffer-string)
+             "* hello\n* hi"))))
+
 ;; visual-wrap-tests.el ends here
-- 
2.25.1

From 37672f04590ac38a9ad4ca86429f7220f856d904 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Wed, 28 May 2025 10:16:02 -0700
Subject: [PATCH 3/3] ; Remove superfluous POSITION argument from
 'visual-wrap--apply-to-line'

* lisp/visual-wrap.el (visual-wrap--apply-to-line): Remove POSITION and
just use point instead.  Update caller.
---
 lisp/visual-wrap.el | 46 ++++++++++++++++++++++-----------------------
 1 file changed, 22 insertions(+), 24 deletions(-)

diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
index 9da19a6ff2a..c09e83823f7 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -143,29 +143,27 @@ visual-wrap--adjust-prefix
        (t
         "")))))
 
-(defun visual-wrap--apply-to-line (position)
-  "Apply visual-wrapping properties to the logical line starting at POSITION."
-  (save-excursion
-    (goto-char position)
-    (when-let* ((first-line-prefix (fill-match-adaptive-prefix))
-                (next-line-prefix (visual-wrap--content-prefix
-                                   first-line-prefix position)))
-      (when (numberp next-line-prefix)
-        ;; Set a minimum width for the prefix so it lines up correctly
-        ;; with subsequent lines.  Make sure not to do this past the end
-        ;; of the line though!  (`fill-match-adaptive-prefix' could
-        ;; potentially return a prefix longer than the current line in
-        ;; the buffer.)
-        (add-display-text-property
-         position (min (+ position (length first-line-prefix))
-                       (pos-eol))
-         'min-width `((,next-line-prefix . width))))
-      (setq next-line-prefix (visual-wrap--adjust-prefix next-line-prefix))
-      (put-text-property
-       position (pos-eol) 'wrap-prefix
-       (if (numberp next-line-prefix)
-           `(space :align-to (,next-line-prefix . width))
-         next-line-prefix)))))
+(defun visual-wrap--apply-to-line ()
+  "Apply visual-wrapping properties to the logical line starting at point."
+  (when-let* ((first-line-prefix (fill-match-adaptive-prefix))
+              (next-line-prefix (visual-wrap--content-prefix
+                                 first-line-prefix (point))))
+    (when (numberp next-line-prefix)
+      ;; Set a minimum width for the prefix so it lines up correctly
+      ;; with subsequent lines.  Make sure not to do this past the end
+      ;; of the line though!  (`fill-match-adaptive-prefix' could
+      ;; potentially return a prefix longer than the current line in the
+      ;; buffer.)
+      (add-display-text-property
+       (point) (min (+ (point) (length first-line-prefix))
+                     (pos-eol))
+       'min-width `((,next-line-prefix . width))))
+    (setq next-line-prefix (visual-wrap--adjust-prefix next-line-prefix))
+    (put-text-property
+     (point) (pos-eol) 'wrap-prefix
+     (if (numberp next-line-prefix)
+         `(space :align-to (,next-line-prefix . width))
+       next-line-prefix))))
 
 (defun visual-wrap--content-prefix (prefix position)
   "Get the next-line prefix for the specified first-line PREFIX.
@@ -254,7 +252,7 @@ visual-wrap-prefix-function
         ;; If so, we can apply our visual wrapping properties to this
         ;; line and continue to the next line.
         (progn
-          (visual-wrap--apply-to-line (point))
+          (visual-wrap--apply-to-line)
           (forward-line))
       ;; Otherwise, skip ahead until the end of any unsafe display
       ;; properties.  NOTE: We do this out of an abundance of caution to
-- 
2.25.1