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

From: Jim Porter <[email-masked]>
Date: Sat, 12 Oct 2024 18:36:27 -0700

On 10/12/2024 5:00 AM, Eli Zaretskii wrote:
> I'd prefer if we had code that, when it detects an unsafe display
> property, would completely skip all of it.  With the above code, I
> fond it difficult to reason whether it sometimes considers newlines
> inside unsafe properties.

How about this implementation instead? I think it should do the same 
thing as my previous implementation, at least in all the cases we care 
about. I've also added some regression tests to verify that the code 
works the way we expect.

From 48d57c0f8e70e31bb9ed2c6b485d8d5cf2950d99 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 | 87 ++++++++++++++++++++++++++++++++++
 2 files changed, 131 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..5cc4a8ac8a7
--- /dev/null
+++ b/test/lisp/visual-wrap-tests.el
@@ -0,0 +1,87 @@
+;;; 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)))))))
+
+;; visual-wrap-tests.el ends here
-- 
2.25.1