Package: emacs;
Reported by: Ivan Shmakov <ivan <at> siamics.net>
Date: Mon, 29 Dec 2014 07:56:02 UTC
Severity: wishlist
Tags: patch
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Ivan Shmakov <ivan <at> siamics.net> To: 19462 <at> debbugs.gnu.org Cc: emacs-devel <at> gnu.org Subject: bug#19462: shr: use wrap-prefix when possible, instead of filling the text Date: Mon, 29 Dec 2014 07:55:41 +0000
[Message part 1 (text/plain, inline)]
Package: emacs Severity: wishlist X-Debbugs-Cc: emacs-devel <at> gnu.org >>>>> Eli Zaretskii <eliz <at> 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
[Message part 2 (text/diff, inline)]
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.
[Message part 3 (text/emacs-lisp, 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)))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.