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

[Ivan Shmakov <ivan@siamics.net>]

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

	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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/diff, Size: 4441 bytes --]

--- 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.