:group 'shr
:type '(choice (const nil) regexp))
-(defcustom shr-use-fonts nil
+(defcustom shr-use-fonts t
"If non-nil, use proportional fonts for text."
:version "25.1"
:group 'shr
(defvar shr-ignore-cache nil)
(defvar shr-external-rendering-functions nil)
(defvar shr-target-id nil)
-(defvar shr-inhibit-decoration nil)
(defvar shr-table-separator-length 1)
(defvar shr-table-separator-pixel-width 0)
(defvar shr-table-id nil)
;; Public functions and commands.
(declare-function libxml-parse-html-region "xml.c"
- (start end &optional base-url))
+ (start end &optional base-url discard-comments))
(defun shr-render-buffer (buffer)
"Display the HTML rendering of the current buffer."
(goto-char begin)
(shr-insert-document dom))))
+(defun shr--have-one-fringe-p ()
+ "Return non-nil if we know at least one of the fringes has non-zero width."
+ (and (fboundp 'fringe-columns)
+ (or (not (zerop (fringe-columns 'right)))
+ (not (zerop (fringe-columns 'left))))))
+
;;;###autoload
(defun shr-insert-document (dom)
"Render the parsed document DOM into the current buffer.
(if (not shr-use-fonts)
shr-width
(* shr-width (frame-char-width))))
+ ;; We need to adjust the available
+ ;; width for when the user disables
+ ;; the fringes, which will cause the
+ ;; display engine usurp one column for
+ ;; the continuation glyph.
(if (not shr-use-fonts)
- (- (window-width) 2)
- (- (window-pixel-width)
- (* (frame-fringe-width) 2))))))
+ (- (window-body-width) 1
+ (if (and (null shr-width)
+ (not (shr--have-one-fringe-p)))
+ 0
+ 1))
+ (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ (if (and (null shr-width)
+ (not (shr--have-one-fringe-p)))
+ (* (frame-char-width) 2)
+ 0))))))
(shr-descend dom)
(shr-fill-lines start (point))
(shr-remove-trailing-whitespace start (point))
(with-temp-buffer
(let ((shr-indentation 0)
(shr-start nil)
- (shr-internal-width (- (window-pixel-width)
- (* (frame-fringe-width) 2))))
+ (shr-internal-width (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ ;; Adjust the window width for when
+ ;; the user disables the fringes,
+ ;; which causes the display engine
+ ;; to usurp one column for the
+ ;; continuation glyph.
+ (if (and (null shr-width)
+ (not (shr--have-one-fringe-p)))
+ (* (frame-char-width) 2)
+ 0))))
(shr-insert text)
(buffer-string)))))
(insert "\n"))
(cond
((eq shr-folding-mode 'none)
- (insert text))
+ (let ((start (point)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region start (point))
+ ;; Remove soft hyphens.
+ (goto-char (point-min))
+ (while (search-forward "" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max)))))
(t
(let ((font-start (point)))
(when (and (string-match "\\`[ \t\n\r ]" text)
(replace-match "" t t))
(while (re-search-forward "[ \t\n\r ]+" nil t)
(replace-match " " t t))
+ ;; Remove soft hyphens.
+ (goto-char (point-min))
+ (while (search-forward "" nil t)
+ (replace-match "" t t))
(goto-char (point-max)))
;; We may have removed everything we inserted if if was just
;; spaces.
;; There's no breakable point, so we give it up.
(let (found)
(goto-char bp)
- (unless shr-kinsoku-shorten
+ ;; Don't overflow the window edge, even if
+ ;; shr-kinsoku-shorten is nil.
+ (unless (or shr-kinsoku-shorten (null shr-width))
(while (setq found (re-search-forward
"\\(\\c>\\)\\| \\|\\c<\\|\\c|"
(line-end-position) 'move)))
;; Don't put kinsoku-bol characters at the beginning of a line,
;; or kinsoku-eol characters at the end of a line.
(cond
- (shr-kinsoku-shorten
+ ;; Don't overflow the window edge, even if shr-kinsoku-shorten
+ ;; is nil.
+ ((or shr-kinsoku-shorten (null shr-width))
(while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (shr-char-kinsoku-eol-p (preceding-char)))
+ (or (shr-char-kinsoku-eol-p (preceding-char))
+ (shr-char-kinsoku-bol-p (following-char))))
(backward-char 1))
(when (setq failed (<= (point) start))
;; There's no breakable point that doesn't violate kinsoku,
shr-base))
(when (zerop (length url))
(setq url nil))
+ ;; Strip leading whitespace
+ (and url (string-match "\\`\\s-+" url)
+ (setq url (substring url (match-end 0))))
(cond ((or (not url)
(not base)
(string-match "\\`[a-z]*:" url))
;; blank text at the start of the line, and the newline at the end, to
;; avoid ugliness.
(defun shr-add-font (start end type)
- (unless shr-inhibit-decoration
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (when (bolp)
- (skip-chars-forward " "))
- (add-face-text-property (point) (min (line-end-position) end) type t)
- (if (< (line-end-position) end)
- (forward-line 1)
- (goto-char end))))))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (when (bolp)
+ (skip-chars-forward " "))
+ (add-face-text-property (point) (min (line-end-position) end) type t)
+ (if (< (line-end-position) end)
+ (forward-line 1)
+ (goto-char end)))))
(defun shr-mouse-browse-url (ev)
"Browse the URL under the mouse cursor."
(search-forward "\r\n\r\n" nil t))
(shr-parse-image-data)))))
+(declare-function libxml-parse-xml-region "xml.c"
+ (start end &optional base-url discard-comments))
+
(defun shr-parse-image-data ()
(let ((data (buffer-substring (point) (point-max)))
(content-type
(shr-color-visible bg fg)))))))
(defun shr-colorize-region (start end fg &optional bg)
- (when (and (not shr-inhibit-decoration)
- (or fg bg))
+ (when (and (or fg bg) (>= (display-color-cells) 88))
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
(shr-ensure-newline)
(insert " "))
(put-text-property start (1+ start) 'shr-target-id shr-target-id))
- (when (and url
- (not shr-inhibit-decoration))
+ (when url
(shr-urlify (or shr-start start) (shr-expand-url url) title))))
(defun shr-tag-object (dom)
(defun shr-make-table-1 (dom widths &optional fill)
(let ((trs nil)
- (shr-inhibit-decoration (not fill))
(rowspans (make-vector (length widths) 0))
(colspan-remaining 0)
colspan-width colspan-count
(provide 'shr)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; shr.el ends here