From 5e1de09af5398bd0a60683ebf53bef3f87440a91 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 4 Aug 2024 19:37:00 -0700
Subject: [PATCH] Improve SHR/EWW support for 'visual-wrap-prefix-mode'

* lisp/visual-wrap.el (visual-wrap--apply-to-line): Use
'add-display-text-property' so we don't clobber other display
properties.
(visual-wrap--content-prefix): Remove special-case for spaces-only
indent prefix; this was an attempt to be helpful for variable-pitch
fonts, but in practice just interferes with matters.  This case now
falls back to the one immediately following it (return the string of
spaces).)

* lisp/net/shr.el (shr-indent): Set 'shr-prefix-length' here to help
keep track of the prefixes of nestedly-indented elements.
* lisp/net/shr.el (shr-adaptive-fill-function): Use 'shr-prefix-length'
as set above to return a fill prefix.

* lisp/net/eww.el (eww-render): Enable 'visual-wrap-prefix-mode'
alongside of 'visual-line-mode'.
(eww-mode): Set 'adaptive-fill-function' to
'shr-adaptive-fill-function'.
---
 lisp/net/eww.el     |  5 ++++-
 lisp/net/shr.el     | 19 ++++++++++++++-----
 lisp/visual-wrap.el | 12 +++---------
 3 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index b2e1c5a72e5..b5d2f20781a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -709,7 +709,8 @@ eww-render
 	      (and last-coding-system-used
 		   (set-buffer-file-coding-system last-coding-system-used))
               (unless shr-fill-text
-                (visual-line-mode))
+                (visual-line-mode)
+                (visual-wrap-prefix-mode))
 	      (run-hooks 'eww-after-render-hook)
               ;; Enable undo again so that undo works in text input
               ;; boxes.
@@ -1336,6 +1337,8 @@ eww-mode
   ;; desktop support
   (setq-local desktop-save-buffer #'eww-desktop-misc-data)
   (setq truncate-lines t)
+  ;; visual-wrap-prefix-mode support
+  (setq-local adaptive-fill-function #'shr-adaptive-fill-function)
   ;; thingatpt support
   (setq-local thing-at-point-provider-alist
               (cons '(url . eww--url-at-point)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index d3c48b34428..a0f9cd252d2 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -938,6 +938,11 @@ shr-fill-line
         (when (looking-at " $")
 	  (delete-region (point) (line-end-position)))))))
 
+(defun shr-adaptive-fill-function ()
+  "Return a fill prefix for the paragraph at point."
+  (when-let ((prefix (get-text-property (point) 'shr-prefix-length)))
+    (buffer-substring (point) (+ (point) prefix))))
+
 (defun shr-parse-base (url)
   ;; Always chop off anchors.
   (when (string-match "#.*" url)
@@ -1041,11 +1046,15 @@ shr-ensure-paragraph
 
 (defun shr-indent ()
   (when (> shr-indentation 0)
-    (if (not shr-use-fonts)
-        (insert-char ?\s shr-indentation)
-      (insert ?\s)
-      (put-text-property (1- (point)) (point)
-                         'display `(space :width (,shr-indentation))))))
+    (let ((start (point))
+          (prefix (or (get-text-property (point) 'shr-prefix-length) 0)))
+      (if (not shr-use-fonts)
+          (insert-char ?\s shr-indentation)
+        (insert ?\s)
+        (put-text-property start (point)
+                           'display `(space :width (,shr-indentation))))
+      (put-text-property start (+ (point) prefix)
+                         'shr-prefix-length (+ prefix (- (point) start))))))
 
 (defun shr-fontize-dom (dom &rest types)
   (let ((start (point)))
diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
index cac3bc767b8..51c0213a037 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -121,9 +121,9 @@ visual-wrap--apply-to-line
                (next-line-prefix (visual-wrap--content-prefix
                                   first-line-prefix position)))
       (when (numberp next-line-prefix)
-        (put-text-property
-         position (+ position (length first-line-prefix)) 'display
-         `(min-width ((,next-line-prefix . width)))))
+        (add-display-text-property
+         position (+ position (length first-line-prefix)) '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
@@ -141,12 +141,6 @@ visual-wrap--content-prefix
   (cond
    ((string= prefix "")
     nil)
-   ((string-match (rx bos (+ blank) eos) prefix)
-    ;; If the first-line prefix is all spaces, return its width in
-    ;; characters.  This way, we can set the prefix for all lines to use
-    ;; the canonical-width of the font, which helps for variable-pitch
-    ;; fonts where space characters are usually quite narrow.
-    (string-width prefix))
    ((or (and adaptive-fill-first-line-regexp
              (string-match adaptive-fill-first-line-regexp prefix))
         (and comment-start-skip
-- 
2.25.1