Subject: Re: bug#73600: 31.0.50; Visual wrap prefix mode and image display

From: Jim Porter <[email-masked]>
Date: Sun, 13 Oct 2024 13:50:25 -0700

On 10/13/2024 11:51 AM, Eli Zaretskii wrote:
> That is probably correct, at least in some cases, but why should we
> rely on that for this purpose?  Isn't it more reliable and
> future-proof to skip the entire span of the outermost "replacing"
> display property, and never look at properties inside that text?  Does
> it really matter for visual-wrap-prefix-mode to look inside?

As I understand this bug, we just need to make sure that visual-wrap.el 
doesn't change the display property of any single/atomic span of text 
that xdisp.c will replace. Otherwise, xdisp.c will stop at every change 
to 'display' in turn, leading to duplicated images (or whatever we're 
displaying).

I think the most reliable/future-proof way to fix this would be work as 
much like xdisp.c as we can. From what I can tell, xdisp.c is using 
'next-single-char-property-change' for this: for 
replacing-display-props, 'handle_single_display_spec' calls 
'display_prop_end', which calls 'Fnext_single_char_property_change'.

That's what my patch is doing, though it's in Lisp, and it's erring on 
the side of caution with what display specs could be "unsafe".

> IOW, I prefer simplicity of the logic to sophisticated design based on
> what we actually see Emacs do in tricky cases, because time and again
> I learned the hard way that my mental models of what actually happens
> can be erroneous in the fine details.

I've attached a patch that isn't *exactly* what you suggested, but 
should add an extra layer of safety at the cost of possibly failing to 
add wrapping properties in when we should/could. In this version 
("be-extra-careful.patch"), whenever we find an unsafe display property 
at the end of a line, we just skip ahead until we find the first 
known-safe display property.

This is the best I could come up with without adding a lot of extra 
complexity to visual-wrap.el, which I think would have just made it more 
prone to mistakes. If you have any other ideas though, let me know.

I also attached the patch I prefer ("match-xdisp.patch"), which is just 
what I posted previously with some additional details in the comments. 
Would you feel better about this version if I could add regression tests 
that ensure xdisp.c does what we expect? In previous work on 
visual-wrap, I looked a bit at doing this, and I think it would probably 
work if we ran the tests in a GUI frame. That probably requires some 
additional scaffolding in the Makefiles, but if it helps improve our 
confidence in the display engine, I think it's worth my time to attempt it.

From 41d4b59dc4e6d075b8cce244ecf65ae5018637da Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Thu, 3 Oct 2024 17:24:18 -0700
Subject: [PATCH] Don't add visual-wrap-prefix properties to unsafe multi-line
 display specs

This makes sure we don't interfere with other display specs, e.g. for
images displayed in 'image-mode' (bug#73600).

* lisp/visual-wrap.el (visual-wrap--safe-display-specs): New variable.
(visual-wrap--display-property-safe-p): New function.
(visual-wrap--apply-to-line): Use 'pos-eol'; we don't want to respect
field boundaries here.
(visual-wrap-prefix-function): Check for unsafe display properties at
the end of the line and skip past them if present.

* test/lisp/visual-wrap-tests.el: New test file.
---
 lisp/visual-wrap.el            |  57 ++++++++++++++--
 test/lisp/visual-wrap-tests.el | 120 +++++++++++++++++++++++++++++++++
 2 files changed, 173 insertions(+), 4 deletions(-)
 create mode 100644 test/lisp/visual-wrap-tests.el

diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
index 76276c0f474..c3e28e6dd06 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -73,6 +73,36 @@ visual-wrap--face-extend-p
         (face-extend-p face nil t)
       (face-background face nil t)))))
 
+(defvar visual-wrap--safe-display-specs
+  '(height raise)
+  "A list of display specs that don't interfere with wrap prefixes.
+A \"safe\" display spec is one that won't interfere with the additional
+text properties that `visual-wrap-prefix-mode' uses.
+
+Specs that replace the text are unsafe, since they generally determine
+the range of text to replace via `eq'.  If `visual-wrap-prefix-mode'
+were to add text properties to some subset of this range, it would
+violate this assumption.")
+
+(defun visual-wrap--display-property-safe-p (display)
+  "Return non-nil if the display property DISPLAY is \"safe\".
+A \"safe\" display property is one where all the display specs are
+members of `visual-wrap--safe-display-specs' (which see)."
+  ;; The display property could be a single display spec; if so, wrap it
+  ;; in a list so we can iterate over it in our loop below.
+  (when (and (consp display) (not (consp (car display))))
+    (setq display (list display)))
+  ;; Loop over all the display specs to check if they're safe.  Assume
+  ;; any display property other than a vector or list (e.g. a string) is
+  ;; unsafe.
+  (when (or (vectorp display) (listp display))
+    (not (catch 'unsafe
+           (mapc (lambda (spec)
+                   (unless (memq (car-safe spec)
+                                 visual-wrap--safe-display-specs)
+                     (throw 'unsafe t)))
+                 display)))))
+
 (defun visual-wrap--prefix-face (fcp _beg end)
   ;; If the fill-context-prefix already specifies a face, just use that.
   (cond ((get-text-property 0 'face fcp))
@@ -128,11 +158,11 @@ visual-wrap--apply-to-line
         ;; the buffer.)
         (add-display-text-property
          position (min (+ position (length first-line-prefix))
-                       (line-end-position))
+                       (pos-eol))
          'min-width `((,next-line-prefix . width))))
       (setq next-line-prefix (visual-wrap--adjust-prefix next-line-prefix))
       (put-text-property
-       position (line-end-position) 'wrap-prefix
+       position (pos-eol) 'wrap-prefix
        (if (numberp next-line-prefix)
            `(space :align-to (,next-line-prefix . width))
          next-line-prefix)))))
@@ -206,8 +236,27 @@ visual-wrap-prefix-function
   (forward-line 0)
   (setq beg (point))
   (while (< (point) end)
-    (visual-wrap--apply-to-line (point))
-    (forward-line))
+    ;; Check if the display property at the end of this line is "safe".
+    (if (visual-wrap--display-property-safe-p
+         (get-char-property (pos-eol) 'display))
+        ;; 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))
+          (forward-line))
+      ;; Otherwise, skip ahead until the end of any unsafe display
+      ;; properties.  NOTE: We do this out of an abundance of caution to
+      ;; be as certain as possible that we're not interfering with the
+      ;; display engine.  If this results in cases where we fail to add
+      ;; wrapping properties when we should, then we should remove the
+      ;; `while' loop below.  Without that loop, this should be the same
+      ;; logic `handle_single_display_spec' in xdisp.c uses for
+      ;; determining what text to replace.  See bug#73600.
+      (goto-char (next-single-char-property-change (pos-eol) 'display))
+      (while (not (visual-wrap--display-property-safe-p
+                   (get-char-property (point) 'display)))
+        (goto-char (next-single-char-property-change (point) 'display)))
+      (unless (bolp) (forward-line 1))))
   `(jit-lock-bounds ,beg . ,end))
 
 ;;;###autoload
diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el
new file mode 100644
index 00000000000..04977afe207
--- /dev/null
+++ b/test/lisp/visual-wrap-tests.el
@@ -0,0 +1,120 @@
+;;; visual-wrap-tests.el --- Tests for `visual-wrap-prefix-mode'  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tets for `visual-wrap-prefix-mode'.
+
+;;; Code:
+
+(require 'visual-wrap)
+(require 'ert)
+
+;;; Tests:
+
+(ert-deftest visual-wrap-tests/simple ()
+  "Test adding wrapping properties to text without display properties."
+  (with-temp-buffer
+    (insert "greetings\n* hello\n* hi")
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("greetings\n* hello\n* hi"
+               10 12 ( wrap-prefix (space :align-to (2 . width))
+                       display (min-width ((2 . width))))
+               12 17 ( wrap-prefix (space :align-to (2 . width)))
+               18 20 ( wrap-prefix (space :align-to (2 . width))
+                       display (min-width ((2 . width))))
+               20 22 ( wrap-prefix (space :align-to (2 . width))))))))
+
+(ert-deftest visual-wrap-tests/safe-display ()
+  "Test adding wrapping properties to text with safe display properties."
+  (with-temp-buffer
+    (insert #("* hello" 2 7 (display (raise 1))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* hello"
+               0 2 ( wrap-prefix (space :align-to (2 . width))
+                     display (min-width ((2 . width))))
+               2 7 ( wrap-prefix (space :align-to (2 . width))
+                     display (raise 1)))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/within-line ()
+  "Test adding wrapping properties to text with unsafe display properties.
+When these properties don't extend across multiple lines,
+`visual-wrap-prefix-mode' can still add wrapping properties."
+  (with-temp-buffer
+    (insert #("* [img]" 2 7 (display (image :type bmp))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* [img]"
+               0 2 ( wrap-prefix (space :align-to (2 . width))
+                     display (min-width ((2 . width))))
+               2 7 ( wrap-prefix (space :align-to (2 . width))
+                     display (image :type bmp)))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/spanning-lines ()
+  "Test adding wrapping properties to text with unsafe display properties.
+When these properties do extend across multiple lines,
+`visual-wrap-prefix-mode' must avoid adding wrapping properties."
+  (with-temp-buffer
+    (insert #("* a\n* b" 0 7 (display (image :type bmp))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* a\n* b" 0 7 (display (image :type bmp)))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/multiple-1 ()
+  "Test adding wrapping properties to text with unsafe display properties.
+This tests a multi-line unsafe display prop immediately followed by a
+single-line unsafe display prop.  `visual-wrap-prefix-mode' should *not*
+add wrapping properties to either block."
+  (with-temp-buffer
+    (insert #("* a\n* b"
+              0 4 (display ((image :type bmp)))
+              4 7 (display ((image :type bmp) (height 1.5)))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             ;; NOTE: See the note in `visual-wrap-prefix-function'.  If
+             ;; applying the change mentioned there, then this case
+             ;; should add wrapping properties to the second block.
+             #("* a\n* b"
+              0 4 (display ((image :type bmp)))
+              4 7 (display ((image :type bmp) (height 1.5))))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/multiple-2 ()
+  "Test adding wrapping properties to text with unsafe display properties.
+This tests a multi-line unsafe display prop immediately followed by
+another multi-line unsafe display prop.  `visual-wrap-prefix-mode'
+should *not* add wrapping properties to either block."
+  (with-temp-buffer
+    (insert #("* a\n* b\n"
+              0 4 (display ((image :type bmp)))
+              4 8 (display ((image :type bmp) (height 1.5)))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* a\n* b\n"
+              0 4 (display ((image :type bmp)))
+              4 8 (display ((image :type bmp) (height 1.5))))))))
+
+;; visual-wrap-tests.el ends here
-- 
2.25.1

From 6d4597e27c99548105317d483121325d2c98bfda Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Thu, 3 Oct 2024 17:24:18 -0700
Subject: [PATCH] Don't add visual-wrap-prefix properties to unsafe multi-line
 display specs

This makes sure we don't interfere with other display specs, e.g. for
images displayed in 'image-mode' (bug#73600).

* lisp/visual-wrap.el (visual-wrap--safe-display-specs): New variable.
(visual-wrap--display-property-safe-p): New function.
(visual-wrap--apply-to-line): Use 'pos-eol'; we don't want to respect
field boundaries here.
(visual-wrap-prefix-function): Check for unsafe display properties at
the end of the line and skip past them if present.

* test/lisp/visual-wrap-tests.el: New test file.
---
 lisp/visual-wrap.el            |  50 ++++++++++++--
 test/lisp/visual-wrap-tests.el | 122 +++++++++++++++++++++++++++++++++
 2 files changed, 168 insertions(+), 4 deletions(-)
 create mode 100644 test/lisp/visual-wrap-tests.el

diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
index 76276c0f474..87dd0bccacd 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -73,6 +73,36 @@ visual-wrap--face-extend-p
         (face-extend-p face nil t)
       (face-background face nil t)))))
 
+(defvar visual-wrap--safe-display-specs
+  '(height raise)
+  "A list of display specs that don't interfere with wrap prefixes.
+A \"safe\" display spec is one that won't interfere with the additional
+text properties that `visual-wrap-prefix-mode' uses.
+
+Specs that replace the text are unsafe, since they generally determine
+the range of text to replace via `eq'.  If `visual-wrap-prefix-mode'
+were to add text properties to some subset of this range, it would
+violate this assumption.")
+
+(defun visual-wrap--display-property-safe-p (display)
+  "Return non-nil if the display property DISPLAY is \"safe\".
+A \"safe\" display property is one where all the display specs are
+members of `visual-wrap--safe-display-specs' (which see)."
+  ;; The display property could be a single display spec; if so, wrap it
+  ;; in a list so we can iterate over it in our loop below.
+  (when (and (consp display) (not (consp (car display))))
+    (setq display (list display)))
+  ;; Loop over all the display specs to check if they're safe.  Assume
+  ;; any display property other than a vector or list (e.g. a string) is
+  ;; unsafe.
+  (when (or (vectorp display) (listp display))
+    (not (catch 'unsafe
+           (mapc (lambda (spec)
+                   (unless (memq (car-safe spec)
+                                 visual-wrap--safe-display-specs)
+                     (throw 'unsafe t)))
+                 display)))))
+
 (defun visual-wrap--prefix-face (fcp _beg end)
   ;; If the fill-context-prefix already specifies a face, just use that.
   (cond ((get-text-property 0 'face fcp))
@@ -128,11 +158,11 @@ visual-wrap--apply-to-line
         ;; the buffer.)
         (add-display-text-property
          position (min (+ position (length first-line-prefix))
-                       (line-end-position))
+                       (pos-eol))
          'min-width `((,next-line-prefix . width))))
       (setq next-line-prefix (visual-wrap--adjust-prefix next-line-prefix))
       (put-text-property
-       position (line-end-position) 'wrap-prefix
+       position (pos-eol) 'wrap-prefix
        (if (numberp next-line-prefix)
            `(space :align-to (,next-line-prefix . width))
          next-line-prefix)))))
@@ -206,8 +236,20 @@ visual-wrap-prefix-function
   (forward-line 0)
   (setq beg (point))
   (while (< (point) end)
-    (visual-wrap--apply-to-line (point))
-    (forward-line))
+    ;; Check if the display property at the end of this line is "safe".
+    (if (visual-wrap--display-property-safe-p
+         (get-char-property (pos-eol) 'display))
+        ;; 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))
+          (forward-line))
+      ;; Otherwise, skip ahead to the beginning of the first line after
+      ;; the end of the display property.  This is the same logic
+      ;; `handle_single_display_spec' in xdisp.c uses for determining
+      ;; what text to replace.
+      (goto-char (next-single-char-property-change (pos-eol) 'display))
+      (unless (bolp) (forward-line 1))))
   `(jit-lock-bounds ,beg . ,end))
 
 ;;;###autoload
diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el
new file mode 100644
index 00000000000..b62c1e5a05a
--- /dev/null
+++ b/test/lisp/visual-wrap-tests.el
@@ -0,0 +1,122 @@
+;;; visual-wrap-tests.el --- Tests for `visual-wrap-prefix-mode'  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tets for `visual-wrap-prefix-mode'.
+
+;;; Code:
+
+(require 'visual-wrap)
+(require 'ert)
+
+;;; Tests:
+
+(ert-deftest visual-wrap-tests/simple ()
+  "Test adding wrapping properties to text without display properties."
+  (with-temp-buffer
+    (insert "greetings\n* hello\n* hi")
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("greetings\n* hello\n* hi"
+               10 12 ( wrap-prefix (space :align-to (2 . width))
+                       display (min-width ((2 . width))))
+               12 17 ( wrap-prefix (space :align-to (2 . width)))
+               18 20 ( wrap-prefix (space :align-to (2 . width))
+                       display (min-width ((2 . width))))
+               20 22 ( wrap-prefix (space :align-to (2 . width))))))))
+
+(ert-deftest visual-wrap-tests/safe-display ()
+  "Test adding wrapping properties to text with safe display properties."
+  (with-temp-buffer
+    (insert #("* hello" 2 7 (display (raise 1))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* hello"
+               0 2 ( wrap-prefix (space :align-to (2 . width))
+                     display (min-width ((2 . width))))
+               2 7 ( wrap-prefix (space :align-to (2 . width))
+                     display (raise 1)))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/within-line ()
+  "Test adding wrapping properties to text with unsafe display properties.
+When these properties don't extend across multiple lines,
+`visual-wrap-prefix-mode' can still add wrapping properties."
+  (with-temp-buffer
+    (insert #("* [img]" 2 7 (display (image :type bmp))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* [img]"
+               0 2 ( wrap-prefix (space :align-to (2 . width))
+                     display (min-width ((2 . width))))
+               2 7 ( wrap-prefix (space :align-to (2 . width))
+                     display (image :type bmp)))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/spanning-lines ()
+  "Test adding wrapping properties to text with unsafe display properties.
+When these properties do extend across multiple lines,
+`visual-wrap-prefix-mode' must avoid adding wrapping properties."
+  (with-temp-buffer
+    (insert #("* a\n* b" 0 7 (display (image :type bmp))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* a\n* b" 0 7 (display (image :type bmp)))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/multiple-1 ()
+  "Test adding wrapping properties to text with unsafe display properties.
+This tests a multi-line unsafe display prop immediately followed by a
+single-line unsafe display prop.  `visual-wrap-prefix-mode' should *not*
+add wrapping properties to the first block, but do add them to the
+second."
+  (with-temp-buffer
+    (insert #("* a\n* b"
+              0 4 (display ((image :type bmp)))
+              4 7 (display ((image :type bmp) (height 1.5)))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* a\n* b"
+               0 4 ( display ((image :type bmp)))
+               4 6 ( wrap-prefix (space :align-to (2 . width))
+                     display ((min-width ((2 . width)))
+                              (image :type bmp) (height 1.5)))
+               6 7 ( wrap-prefix (space :align-to (2 . width))
+                     display ((image :type bmp) (height 1.5))))))))
+
+(ert-deftest visual-wrap-tests/unsafe-display/multiple-2 ()
+  "Test adding wrapping properties to text with unsafe display properties.
+This tests a multi-line unsafe display prop immediately followed by
+another multi-line unsafe display prop.  `visual-wrap-prefix-mode'
+should *not* add wrapping properties to either block."
+  (with-temp-buffer
+    (insert #("* a\n* b\n"
+              0 4 (display ((image :type bmp)))
+              4 8 (display ((image :type bmp) (height 1.5)))))
+    (visual-wrap-prefix-function (point-min) (point-max))
+    (should (equal-including-properties
+             (buffer-string)
+             #("* a\n* b\n"
+              0 4 (display ((image :type bmp)))
+              4 8 (display ((image :type bmp) (height 1.5))))))))
+
+;; visual-wrap-tests.el ends here
-- 
2.25.1