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.