master a876c4d7a17: Improve SHR/EWW support for 'visual-wrap-prefix-mode'

[Jim Porter]

branch: master
commit a876c4d7a17df152e3e78800c76ddf158f632ee5
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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).  Use 'string-pixel-width' instead of 'string-width'.
    
    * lisp/net/shr.el (shr-indent): Set 'shr-prefix-length' here to help
    keep track of the prefixes of nestedly-indented elements.  Set the
    specified space width in terms of the default width of the current face.
    * 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'.
    
    * etc/NEWS: Announce this change (bug#72485).
---
 etc/NEWS            | 11 +++++++++++
 lisp/net/eww.el     |  5 ++++-
 lisp/net/shr.el     | 28 +++++++++++++++++++++++-----
 lisp/visual-wrap.el | 16 +++++++---------
 4 files changed, 45 insertions(+), 15 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 8cd21f5fb74..de1d92764f0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -144,6 +144,17 @@ Advanced" node in the EWW manual.
 By customizing 'shr-image-zoom-levels', you can change the list of zoom
 levels that SHR cycles through when calling 'shr-zoom-image'.
 
+** EWW
+
+---
+*** EWW now enables 'visual-wrap-prefix-mode' when 'shr-fill-text' is nil.
+By default, 'shr-fill-text' is t, and EWW fills the text according to
+the width of the window.  If you customize 'shr-fill-text' to nil, EWW
+will now automatically turn on 'visual-wrap-prefix-mode' in addition to
+'visual-line-mode', so that long lines are wrapped at word boundaries
+near window edge and the continuation lines are indented using prefixes
+computed from surrounding context.
+
 ** Go-ts mode
 
 +++
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 @@ The renaming scheme is performed in accordance with
              (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 @@ within text input fields."
   ;; 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..b9ac9f0c8c0 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -938,6 +938,11 @@ When `shr-fill-text' is nil, only indent."
         (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,24 @@ When `shr-fill-text' is nil, only indent."
 
 (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
+         (1- (point)) (point) 'display
+         ;; Set the specified space width in terms of the default width
+         ;; of the current face, like (N . width).  That way, the
+         ;; indentation is calculated correctly when using
+         ;; `text-scale-adjust'.
+         `(space :width (,(if-let ((font (font-at (1- (point))))
+                                   (info (query-font font)))
+                              (/ (float shr-indentation) (aref info 7))
+                            shr-indentation)
+                         . width))))
+      (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 16d330c2a93..902a9e41c5e 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -126,10 +126,10 @@ extra indent = 2
         ;; of the line though!  (`fill-match-adaptive-prefix' could
         ;; potentially return a prefix longer than the current line in
         ;; the buffer.)
-        (put-text-property
+        (add-display-text-property
          position (min (+ position (length first-line-prefix))
                        (line-end-position))
-         'display `(min-width ((,next-line-prefix . width)))))
+         '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
@@ -147,12 +147,6 @@ PREFIX was empty."
   (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
@@ -175,7 +169,11 @@ PREFIX was empty."
         (max (string-width prefix)
              (ceiling (string-pixel-width prefix (current-buffer))
                       (aref info 7)))
-      (string-width prefix)))))
+      ;; We couldn't get the font, so we're in a terminal and
+      ;; `string-pixel-width' is really returning the number of columns.
+      ;; (This is different from `string-width', since that doesn't
+      ;; respect specified spaces.)
+      (string-pixel-width prefix)))))
 
 (defun visual-wrap-fill-context-prefix (beg end)
   "Compute visual wrap prefix from text between BEG and END.