From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ivan Shmakov Newsgroups: gmane.emacs.bugs Subject: bug#19462: shr: use wrap-prefix when possible, instead of filling the text Date: Mon, 29 Dec 2014 09:55:15 +0000 Message-ID: <8761cubx18.fsf__29650.3523168669$1419846982$gmane$org@violet.siamics.net> References: <83y4pzptpx.fsf@gnu.org> <871tnr1gqo.fsf@ferrier.me.uk> <83bnmvowdb.fsf@gnu.org> <83ppbanqhe.fsf@gnu.org> <87vbl2xigp.fsf@ferrier.me.uk> <83ioh2nlow.fsf@gnu.org> <87sig6xech.fsf@ferrier.me.uk> <83fvc5ni0u.fsf@gnu.org> <87k31fwwyv.fsf@ferrier.me.uk> <87bnmq9ibf.fsf@ferrier.me.uk> <87lhlrx5fc.fsf@building.gnus.org> <878uhrcr5l.fsf@building.gnus.org> <83sifzjflk.fsf@gnu.org> <87egric2ki.fsf_-_@violet.siamics.net> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1419846982 25710 80.91.229.3 (29 Dec 2014 09:56:22 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 29 Dec 2014 09:56:22 +0000 (UTC) Cc: emacs-devel@gnu.org To: 19462@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Dec 29 10:56:16 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Y5X3f-000756-Ig for geb-bug-gnu-emacs@m.gmane.org; Mon, 29 Dec 2014 10:56:15 +0100 Original-Received: from localhost ([::1]:32784 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y5X3f-0001bd-2E for geb-bug-gnu-emacs@m.gmane.org; Mon, 29 Dec 2014 04:56:15 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45149) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y5X3X-0001Zm-Du for bug-gnu-emacs@gnu.org; Mon, 29 Dec 2014 04:56:12 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Y5X3S-00071r-R1 for bug-gnu-emacs@gnu.org; Mon, 29 Dec 2014 04:56:07 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:50839) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y5X3S-00071k-Nn for bug-gnu-emacs@gnu.org; Mon, 29 Dec 2014 04:56:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Y5X3S-0007ls-Dl for bug-gnu-emacs@gnu.org; Mon, 29 Dec 2014 04:56:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Ivan Shmakov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 29 Dec 2014 09:56:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 19462 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 19462-submit@debbugs.gnu.org id=B19462.141984693029824 (code B ref 19462); Mon, 29 Dec 2014 09:56:02 +0000 Original-Received: (at 19462) by debbugs.gnu.org; 29 Dec 2014 09:55:30 +0000 Original-Received: from localhost ([127.0.0.1]:60205 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Y5X2v-0007kx-4w for submit@debbugs.gnu.org; Mon, 29 Dec 2014 04:55:30 -0500 Original-Received: from fely.am-1.org ([78.47.74.50]:46768) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Y5X2s-0007kk-DL for 19462@debbugs.gnu.org; Mon, 29 Dec 2014 04:55:27 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=siamics.net; s=a2013295; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:Sender:References:Subject:Cc:To:From; bh=zG9atMrNG0NoT/IzWuHEhh//1TwfmKM46bxZ4Vh07OM=; b=Auq1kN/8guut2t6XmEX88neDJO9eViyvYxvOQULPh1nilvYarG8M28rOzwuUKtRB5DU2jPdDWYenXBleH8+vb9WOCNLipmLqqAJkBtjR1sigilscBaMU1k42A4Lj5fEDK+c/q1eCKNX9qDe5blFJABpMsW4IA8jLAQTeVftbBJU=; Original-Received: from [2a02:2560:6d4:26ca::1:1d] (helo=violet.siamics.net) by fely.am-1.org with esmtps (TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128) (Exim 4.80) (envelope-from ) id 1Y5X2p-0006sr-4n; Mon, 29 Dec 2014 09:55:23 +0000 Original-Received: from localhost ([::1] helo=violet.siamics.net) by violet.siamics.net with esmtps (TLS1.2:RSA_AES_128_CBC_SHA1:128) (Exim 4.80) (envelope-from ) id 1Y5X2h-0001Zm-Ro; Mon, 29 Dec 2014 16:55:15 +0700 In-Reply-To: <87egric2ki.fsf_-_@violet.siamics.net> (Ivan Shmakov's message of "Mon, 29 Dec 2014 07:55:41 +0000") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:97797 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable As it seems, the initial version of the patch didn=E2=80=99t 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 
 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.

--=20
FSF associate member #7257  http://boycottsystemd.org/  =E2=80=A6 3013 B6A0=
 230E 334A

--=-=-=
Content-Type: text/diff
Content-Disposition: inline

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

--=-=-=--