From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ivan Shmakov Newsgroups: gmane.emacs.devel Subject: bug#19462: shr: use wrap-prefix when possible, instead of filling the text Date: Mon, 29 Dec 2014 07:55:41 +0000 Message-ID: <87egric2ki.fsf_-_@violet.siamics.net> References: <87ioh4nf8k.fsf@ferrier.me.uk> <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> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1419839784 18377 80.91.229.3 (29 Dec 2014 07:56:24 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 29 Dec 2014 07:56:24 +0000 (UTC) Cc: emacs-devel@gnu.org To: 19462@debbugs.gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Dec 29 08:56:19 2014 Return-path: Envelope-to: ged-emacs-devel@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 1Y5VBa-0000PP-MY for ged-emacs-devel@m.gmane.org; Mon, 29 Dec 2014 08:56:18 +0100 Original-Received: from localhost ([::1]:60513 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y5VBZ-0002zI-O1 for ged-emacs-devel@m.gmane.org; Mon, 29 Dec 2014 02:56:17 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55183) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y5VBR-0002z0-My for emacs-devel@gnu.org; Mon, 29 Dec 2014 02:56:13 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Y5VBN-0004Tx-E1 for emacs-devel@gnu.org; Mon, 29 Dec 2014 02:56:09 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:50691) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y5VBL-0004To-98; Mon, 29 Dec 2014 02:56:05 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Y5VBK-0003Hm-Lb; Mon, 29 Dec 2014 02:56:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Ivan Shmakov Original-Sender: "Debbugs-submit" Resent-CC: emacs-devel@gnu.org, bug-gnu-emacs@gnu.org Resent-Date: Mon, 29 Dec 2014 07:56:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 19462 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: submit@debbugs.gnu.org X-Debbugs-Original-Xcc: emacs-devel@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.141983975812617 (code B ref -1); Mon, 29 Dec 2014 07:56:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 29 Dec 2014 07:55:58 +0000 Original-Received: from localhost ([127.0.0.1]:60057 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Y5VBF-0003HQ-I9 for submit@debbugs.gnu.org; Mon, 29 Dec 2014 02:55:58 -0500 Original-Received: from fely.am-1.org ([78.47.74.50]:46752) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Y5VBA-0003HC-VM for submit@debbugs.gnu.org; Mon, 29 Dec 2014 02:55:54 -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:To:From; bh=j5Ah89uGzXGjGM6lD+/JEKl/Jb1hMCSeHD+Gqrne5Sc=; b=ZzTZeEGAuWrQcrLxHNaiOzDaivhDLVQ6ri7fwjBfxWkW+TlRq8bmialOxHkoHr7m8DAtiTU1G6/j8Du7Ha3zKaskQwWVpwDtzFdGDwGkHXxkNnC1AUOz45f8onnNdlrcay6Ho61mLIMh2aLZ+df4eooM0ua+lXjCniNHlHpmToA=; 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 1Y5VB7-0005UG-Nm for submit@debbugs.gnu.org; Mon, 29 Dec 2014 07:55:50 +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 1Y5VB0-0001Ld-Bx for submit@debbugs.gnu.org; Mon, 29 Dec 2014 14:55:42 +0700 In-Reply-To: <83sifzjflk.fsf@gnu.org> (Eli Zaretskii's message of "Mon, 29 Dec 2014 05:32:23 +0200") 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: emacs-devel@gnu.org List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:180799 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Package: emacs Severity: wishlist X-Debbugs-Cc: emacs-devel@gnu.org >>>>> Eli Zaretskii 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=E2=80=99m 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. --=20 FSF associate member #7257 http://boycottsystemd.org/ =E2=80=A6 3013 B6A0= 230E 334A --=-=-= Content-Type: text/diff; charset=utf-8 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable 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.") =20 +(defvar shr-force-fill nil + "If non-nil, fill text even in the cases Emacs can wrap it by itself.") + ;;; Internal variables. =20 (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))))) =20 @@ -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=C2=A0]" text) (not (bolp)) (not (eq (char-after (1- (point))) ? ))) - (insert " ")) + (insert-and-inherit " ")) (dolist (elem (split-string text "[ \f\t\n\r\v=C2=A0]+" 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 (<=3D (current-column) shr-internal-width) - (insert " ") + (if (or (not shr-internal-width) + (<=3D (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=C2=A0]\\'" text) @@ -663,7 +672,17 @@ =20 (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)))) =20 (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)) =20 @@ -1325,6 +1351,7 @@ (defun shr-tag-dd (dom) (shr-ensure-newline) (let ((shr-indentation (+ shr-indentation 4))) + (shr-setup-wrap) (shr-generic dom))) =20 (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))) =20 (defun shr-tag-br (dom) @@ -1386,7 +1414,8 @@ =20 (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")) =20 (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. --=-=-= Content-Type: text/emacs-lisp Content-Disposition: inline (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))) --=-=-=--