X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6eab3936c71951e304f13b69ad2e835ddaf9f2f4..1106f317ab064264adbc07001bdc6940ad07f4d4:/lisp/net/shr.el diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9d88d1ff44..58deaea6f5 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -57,7 +57,7 @@ fit these criteria." :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 @@ -152,7 +152,6 @@ cid: URL as the argument.") (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) @@ -178,7 +177,7 @@ cid: URL as the argument.") ;; 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." @@ -223,10 +222,29 @@ DOM should be a parse tree as generated by (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) + (or (zerop + (fringe-columns 'right)) + (zerop + (fringe-columns 'left)))) + 0 + 1)) + (- (window-body-width nil t) + (* 2 (frame-char-width)) + (if (and (null shr-width) + (or (zerop + (fringe-columns 'right)) + (zerop + (fringe-columns 'left)))) + (* (frame-char-width) 2) + 0)))))) (shr-descend dom) (shr-fill-lines start (point)) (shr-remove-trailing-whitespace start (point)) @@ -440,8 +458,18 @@ size, and full-buffer size." (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) + (or (zerop (fringe-columns 'right)) + (zerop (fringe-columns 'left)))) + (* (frame-char-width) 2) + 0)))) (shr-insert text) (buffer-string))))) @@ -621,7 +649,9 @@ size, and full-buffer size." ;; 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))) @@ -633,9 +663,12 @@ size, and full-buffer size." ;; 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, @@ -709,6 +742,9 @@ size, and full-buffer size." 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)) @@ -780,16 +816,15 @@ size, and full-buffer size." ;; 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." @@ -948,6 +983,9 @@ Return a string with image data." (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 @@ -1038,8 +1076,7 @@ ones, in case fg and bg are nil." (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 @@ -1209,8 +1246,7 @@ ones, in case fg and bg are nil." (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) @@ -1802,7 +1838,6 @@ The preference is a float determined from `shr-prefer-media-type'." (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 @@ -2049,8 +2084,4 @@ The preference is a float determined from `shr-prefer-media-type'." (provide 'shr) -;; Local Variables: -;; coding: utf-8 -;; End: - ;;; shr.el ends here