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

From: Jim Porter <[email-masked]>
Date: Sun, 13 Oct 2024 10:38:09 -0700

On 10/12/2024 10:36 PM, Eli Zaretskii wrote:
> Yes, this is what I had in mind, thanks.  But does
> next-single-char-property-change really fit the bill?  What if you
> have several overlapping 'display' properties, and in particular one
> property "enclosed" in another?  Did you test such a scenario?

I had tested those manually and they worked (according to my 
understanding of display properties, anyway). I've added some test cases 
to that effect in the latest patch.

Just to make sure we're on the same page: my (admittedly limited) 
understanding of xdisp.c is that, for replacing-display-properties, 
Emacs determines the range of buffer text to replace by using 'eq' on 
the 'display' property. So if you have an 'image' spec from positions 1 
to 10, but add a 'height' spec from positions 3 to 4, Emacs will now 
render the image three times: one each for the ranges [1, 3), [3, 4), 
and [4, 10).

This means that when 'visual-wrap-prefix-mode' sees the start of a 
replacing-display-property[1], we know we shouldn't interfere with the 
'eq'-ness of that run of text, so we move past it to the first position 
that's not 'eq' to the start. If you like, we treat the 
text-to-be-replaced as atomic, since (I think) that's roughly what 
xdisp.c does too.

[1] Technically, the visual-wrap code avoids adding properties to some 
non-replacing properties too, but since "do nothing" should always be 
safe, that shouldn't be a problem. (It could result in some text not 
having a wrap-prefix when we'd like it too, but we can always add new 
"safe" display specs if someone notices an issue; I wanted to err on the 
side of caution with what we consider safe.)

From 33ddaae3aacd5b5eb1c823f3461019b53ca02c2e 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            |  48 +++++++++++--
 test/lisp/visual-wrap-tests.el | 124 +++++++++++++++++++++++++++++++++
 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..26333089189 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,18 @@ 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 unsafe display property changes.
+      (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..7cae3761b6a
--- /dev/null
+++ b/test/lisp/visual-wrap-tests.el
@@ -0,0 +1,124 @@
+;;; 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))
+    (message "%S" (buffer-string))
+    (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))
+    (message "%S" (buffer-string))
+    (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