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

[Ivan Shmakov <ivan@siamics.net>]

[-- Attachment #1: Type: text/plain, Size: 1583 bytes --]

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

[-- Attachment #2: Type: text/diff, Size: 5260 bytes --]

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.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Type: text/emacs-lisp, Size: 961 bytes --]

(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)))