bug#19462: shr: use wrap-prefix when possible, instead of filling the text

[Ivan Shmakov]

Package:  emacs
Severity: wishlist
X-Debbugs-Cc: emacs-devel@gnu.org

>>>>> Eli Zaretskii <eliz@gnu.org> writes:
>>>>> From: Lars Ingebrigtsen  Date: Mon, 29 Dec 2014 00:04:38 +0100

 >> (Yes, Emacs can display proportional fonts and fonts of different
 >> sizes, but until you can fold (etc) proportional text (and text with
 >> a mixture of font sizes) in a pretty manner, that's more of a toy
 >> than anything else.)

 > What's non-pretty with how we do this now?  What features are
 > missing?

        The only feature that I’m aware to be missing is the actual
        support for Emacs native text wrapping (as in: the word-wrap
        variable and wrap-prefix text property) in SHR.

        Please thus consider the patch MIMEd.

        * lisp/net/shr.el (shr-force-fill): New variable to disable this
        feature if needed.
        (shr-internal-width): Defer initialization until...
        (shr-insert-document): ... here; set to nil if neither
        shr-force-fill nor shr-width are non-nil.
        (shr-fold-text, shr-tag-table-1): Likewise.
        (shr-insert): Use insert-and-inherit; do not fill if
        shr-internal-width is nil.
        (shr-setup-wrap): New function.
        (shr-indent, shr-tag-blockquote, shr-tag-dd, shr-tag-li):
        Call shr-setup-wrap.
        (shr-tag-hr): Use a constant if shr-internal-width is nil.

        A test case is also MIMEd.  The buffer it produces shows the
        text being dynamically filled as the window width changes
        (as in: C-x 3, for instance.)

        The table rendering is not changed in any way.

-- 
FSF associate member #7257  http://boycottsystemd.org/  … 3013 B6A0 230E 334A

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 26bb292..e634a5a 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -128,13 +128,16 @@
 (defvar shr-inhibit-images nil
   "If non-nil, inhibit loading images.")
 
+(defvar shr-force-fill nil
+  "If non-nil, fill text even in the cases Emacs can wrap it by itself.")
+
 ;;; Internal variables.
 
 (defvar shr-folding-mode nil)
 (defvar shr-state nil)
 (defvar shr-start nil)
 (defvar shr-indentation 0)
-(defvar shr-internal-width (or shr-width (1- (window-width))))
+(defvar shr-internal-width nil)                ; set in shr-insert-document
 (defvar shr-list-mode nil)
 (defvar shr-content-cache nil)
 (defvar shr-kinsoku-shorten nil)
@@ -206,7 +209,8 @@ defun shr-insert-document (dom)
        (shr-base nil)
        (shr-depth 0)
        (shr-warning nil)
-       (shr-internal-width (or shr-width (1- (window-width)))))
+       (shr-internal-width
+        (or shr-width (and shr-force-fill (1- (window-width))))))
     (shr-descend dom)
     (shr-remove-trailing-whitespace start (point))
     (when shr-warning
@@ -420,7 +424,8 @@ defun shr-fold-text (text)
       (let ((shr-indentation 0)
            (shr-state nil)
            (shr-start nil)
-           (shr-internal-width (window-width)))
+           (shr-internal-width (and shr-force-fill
+                                    (1- (window-width)))))
        (shr-insert text)
        (buffer-string)))))
 
@@ -454,12 +459,14 @@ defun shr-insert (text)
     (setq shr-state nil))
   (cond
    ((eq shr-folding-mode 'none)
-    (insert text))
+    (insert-and-inherit text))
    (t
+    ;; We generally use insert-and-inherit below so to inherit the
+    ;; wrap-prefix property, if any.  See shr-setup-wrap.
     (when (and (string-match "\\`[ \t\n ]" text)
               (not (bolp))
               (not (eq (char-after (1- (point))) ? )))
-      (insert " "))
+      (insert-and-inherit " "))
     (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
       (when (and (bolp)
                 (> shr-indentation 0))
@@ -482,17 +489,18 @@ defun shr-insert (text)
       ;; starts.
       (unless shr-start
        (setq shr-start (point)))
-      (insert elem)
+      (insert-and-inherit elem)
       (setq shr-state nil)
       (let (found)
-       (while (and (> (current-column) shr-internal-width)
+       (while (and shr-internal-width  ; Use Emacs native wrapping if nil.
+                   (> (current-column) shr-internal-width)
                    (> shr-internal-width 0)
                    (progn
                      (setq found (shr-find-fill-point))
                      (not (eolp))))
          (when (eq (preceding-char) ? )
            (delete-char -1))
-         (insert "\n")
+         (insert-and-inherit "\n")
          (unless found
            ;; No space is needed at the beginning of a line.
            (when (eq (following-char) ? )
@@ -500,11 +508,12 @@ defun shr-insert (text)
          (when (> shr-indentation 0)
            (shr-indent))
          (end-of-line))
-       (if (<= (current-column) shr-internal-width)
-           (insert " ")
+       (if (or (not shr-internal-width)
+               (<= (current-column) shr-internal-width))
+           (insert-and-inherit " ")
          ;; In case we couldn't get a valid break point (because of a
          ;; word that's longer than `shr-internal-width'), just break anyway.
-         (insert "\n")
+         (insert-and-inherit "\n")
          (when (> shr-indentation 0)
            (shr-indent)))))
     (unless (string-match "[ \t\r\n ]\\'" text)
@@ -663,7 +672,17 @@
 
 (defun shr-indent ()
   (when (> shr-indentation 0)
-    (insert (make-string shr-indentation ? ))))
+    (insert (make-string shr-indentation ? ))
+    (shr-setup-wrap)))
+
+(defun shr-setup-wrap ()
+  (when (> shr-indentation 0)
+    ;; The wrap-prefix property is sticky; abuse that here.  We use
+    ;; this after at least shr-indent (or within it), so we may safely
+    ;; assume that there is at least one character before the point.
+    (put-text-property (+ -1 (point)) (point)
+                      'wrap-prefix
+                      `(space :align-to ,shr-indentation))))
 
 (defun shr-fontize-dom (dom &rest types)
   (let (shr-start)
@@ -1309,6 +1334,7 @@ defun shr-tag-blockquote (dom)
   (shr-ensure-paragraph)
   (shr-indent)
   (let ((shr-indentation (+ shr-indentation 4)))
+    (shr-setup-wrap)
     (shr-generic dom))
   (shr-ensure-paragraph))
 
@@ -1325,6 +1351,7 @@
 (defun shr-tag-dd (dom)
   (shr-ensure-newline)
   (let ((shr-indentation (+ shr-indentation 4)))
+    (shr-setup-wrap)
     (shr-generic dom)))
 
 (defun shr-tag-ul (dom)
@@ -1350,6 +1377,7 @@ defun shr-tag-li (dom)
            shr-bullet))
         (shr-indentation (+ shr-indentation (length bullet))))
     (insert bullet)
+    (shr-setup-wrap)
     (shr-generic dom)))
 
 (defun shr-tag-br (dom)
@@ -1386,7 +1414,8 @@
 
 (defun shr-tag-hr (_dom)
   (shr-ensure-newline)
-  (insert (make-string shr-internal-width shr-hr-line) "\n"))
+  (insert (make-string (or shr-internal-width 31) ; FIXME: magic
+                      shr-hr-line) "\n"))
 
 (defun shr-tag-title (dom)
   (shr-heading dom 'bold 'underline))
@@ -1414,6 +1443,7 @@
 (defun shr-tag-table-1 (dom)
   (setq dom (or (dom-child-by-tag dom 'tbody) dom))
   (let* ((shr-inhibit-images t)
+        (shr-internal-width (or shr-internal-width (1- (window-width))))
         (shr-table-depth (1+ shr-table-depth))
         (shr-kinsoku-shorten t)
         ;; Find all suggested widths.

(with-current-buffer (generate-new-buffer "*shr*")
  (setq-local shr-width nil)
  (setq-local word-wrap t)
  (setq-local truncate-partial-width-windows nil)
  (shr-insert-document
   '(base
     ((href . "https://example.com/";))
     (html
      nil
      (head nil (title nil "Lorem ipsum"))
      (body
       nil
       (hr nil)
       (ol nil
           (li ((lang . "la"))
               "Lorem ipsum dolor sit amet, consectetur adipisicing"
               " elit, sed do eiusmod tempor incididunt ut labore et"
               " dolore magna aliqua.  Ut enim ad minim veniam, quis"
               " nostrud exercitation ullamco laboris nisi ut"
               " aliquip ex ea commodo consequat.  Duis aute irure"
               " dolor in reprehenderit in voluptate velit esse"
               " cillum dolore eu fugiat nulla pariatur.  Excepteur"
               " sint occaecat cupidatat non proident, sunt in culpa"
               " qui officia deserunt mollit anim id est laborum."))))))
  (pop-to-buffer (current-buffer)))