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

[Ivan Shmakov]

        As it seems, the initial version of the patch didn’t play well
        with other essential shr.el features (as in: hyperlinks.)

        Please thus consider the revised 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): Do not fill if shr-internal-width is nil.
        (shr-setup-wrap-1, shr-setup-wrap): New function.
        (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.

        The other so far unresolved issue with this approach is that the
        tables and <pre /> elements may actually require truncate-lines.
        Unfortunately, I know of no way to allow for word-wrapped and
        truncated lines to exist in the same buffer; I guess we may need
        either a truncate-lines or word-wrap property (or both) to
        override the buffer-local variables in this case.

        Similarly to wrap-prefix, we may also use line-prefix in place
        of shr-indent.  But that may not be a good idea if quoting
        text/html messages in text/plain replies, for instance.

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

--- 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)))))
 
@@ -485,7 +490,8 @@ defun shr-insert (text)
       (insert 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))
@@ -500,7 +506,8 @@ defun shr-insert (text)
          (when (> shr-indentation 0)
            (shr-indent))
          (end-of-line))
-       (if (<= (current-column) shr-internal-width)
+       (if (or (not shr-internal-width)
+               (<= (current-column) shr-internal-width))
            (insert " ")
          ;; In case we couldn't get a valid break point (because of a
          ;; word that's longer than `shr-internal-width'), just break anyway.
@@ -665,6 +672,23 @@
   (when (> shr-indentation 0)
     (insert (make-string shr-indentation ? ))))
 
+(defun shr-setup-wrap-1 (from to pval)
+  (put-text-property from to 'wrap-prefix pval))
+
+(defun shr-setup-wrap (from to)
+  (let ((prev from)
+       (pos  (next-property-change from nil to))
+       (pval (and (> shr-indentation 0)
+                  `(space :align-to ,shr-indentation))))
+    (while (and pos (> pos prev))
+      (unless (get-text-property prev 'wrap-prefix)
+       (shr-setup-wrap-1 prev pos pval))
+      (setq prev pos
+           pos  (next-property-change pos nil to)))
+    (unless (or (<= to prev)
+               (get-text-property prev 'wrap-prefix))
+       (shr-setup-wrap-1 prev to pval))))
+
 (defun shr-fontize-dom (dom &rest types)
   (let (shr-start)
     (shr-generic dom)
@@ -1308,8 +1338,10 @@
 (defun shr-tag-blockquote (dom)
   (shr-ensure-paragraph)
   (shr-indent)
-  (let ((shr-indentation (+ shr-indentation 4)))
-    (shr-generic dom))
+  (let ((from (point))
+       (shr-indentation (+ shr-indentation 4)))
+    (shr-generic dom)
+    (shr-setup-wrap from (point)))
   (shr-ensure-paragraph))
 
 (defun shr-tag-dl (dom)
@@ -1324,8 +1356,10 @@
 
 (defun shr-tag-dd (dom)
   (shr-ensure-newline)
-  (let ((shr-indentation (+ shr-indentation 4)))
-    (shr-generic dom)))
+  (let ((from (point))
+       (shr-indentation (+ shr-indentation 4)))
+    (shr-generic dom)
+    (shr-setup-wrap from (point))))
 
 (defun shr-tag-ul (dom)
   (shr-ensure-paragraph)
@@ -1348,9 +1382,11 @@ defun shr-tag-li (dom)
                  (format "%d " shr-list-mode)
                (setq shr-list-mode (1+ shr-list-mode)))
            shr-bullet))
+        (from (point))
         (shr-indentation (+ shr-indentation (length bullet))))
     (insert bullet)
-    (shr-generic dom)))
+    (shr-generic dom)
+    (shr-setup-wrap from (point))))
 
 (defun shr-tag-br (dom)
   (when (and (not (bobp))
@@ -1386,7 +1422,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 +1451,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.