diff options
Diffstat (limited to 'lisp/net/shr.el')
| -rw-r--r-- | lisp/net/shr.el | 108 |
1 files changed, 71 insertions, 37 deletions
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9c3740fccc9..85d81b6bbcc 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -183,8 +183,37 @@ temporarily blinks with this face." "Face for <abbr> elements." :version "27.1") -(defvar shr-inhibit-images nil - "If non-nil, inhibit loading images.") +(defface shr-h1 + '((t :height 1.3 :weight bold)) + "Face for <h1> elements." + :version "28.1") + +(defface shr-h2 + '((t :weight bold)) + "Face for <h2> elements." + :version "28.1") + +(defface shr-h3 + '((t :slant italic)) + "Face for <h3> elements." + :version "28.1") + +(defface shr-h4 nil + "Face for <h4> elements." + :version "28.1") + +(defface shr-h5 nil + "Face for <h5> elements." + :version "28.1") + +(defface shr-h6 nil + "Face for <h6> elements." + :version "28.1") + +(defcustom shr-inhibit-images nil + "If non-nil, inhibit loading images." + :version "28.1" + :type 'boolean) (defvar shr-external-rendering-functions nil "Alist of tag/function pairs used to alter how shr renders certain tags. @@ -220,20 +249,20 @@ and other things: (defvar shr-map (let ((map (make-sparse-keymap))) - (define-key map "a" 'shr-show-alt-text) - (define-key map "i" 'shr-browse-image) - (define-key map "z" 'shr-zoom-image) - (define-key map [?\t] 'shr-next-link) - (define-key map [?\M-\t] 'shr-previous-link) + (define-key map "a" #'shr-show-alt-text) + (define-key map "i" #'shr-browse-image) + (define-key map "z" #'shr-zoom-image) + (define-key map [?\t] #'shr-next-link) + (define-key map [?\M-\t] #'shr-previous-link) (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] 'shr-browse-url) - (define-key map [C-down-mouse-1] 'shr-mouse-browse-url-new-window) - (define-key map "I" 'shr-insert-image) - (define-key map "w" 'shr-maybe-probe-and-copy-url) - (define-key map "u" 'shr-maybe-probe-and-copy-url) - (define-key map "v" 'shr-browse-url) - (define-key map "O" 'shr-save-contents) - (define-key map "\r" 'shr-browse-url) + (define-key map [mouse-2] #'shr-browse-url) + (define-key map [C-down-mouse-1] #'shr-mouse-browse-url-new-window) + (define-key map "I" #'shr-insert-image) + (define-key map "w" #'shr-maybe-probe-and-copy-url) + (define-key map "u" #'shr-maybe-probe-and-copy-url) + (define-key map "v" #'shr-browse-url) + (define-key map "O" #'shr-save-contents) + (define-key map "\r" #'shr-browse-url) map)) (defvar shr-image-map @@ -313,6 +342,12 @@ DOM should be a parse tree as generated by (* (frame-char-width) 2)) 1)))) (max-specpdl-size max-specpdl-size) + ;; `bidi-display-reordering' is supposed to be only used for + ;; debugging purposes, but Shr's naïve filling algorithm + ;; cannot cope with the complexity of RTL text in an LTR + ;; paragraph, when a long line has been continued, and for + ;; most scripts the character metrics don't change when they + ;; are reordered, so... this is the best we could do :-( bidi-display-reordering) ;; Adjust for max width specification. (when (and shr-max-width @@ -434,6 +469,7 @@ Value is a pair of positions (START . END) if there is a non-nil (defun shr-show-alt-text () "Show the ALT text of the image under point." + (declare (completion (lambda (_ b) (command-completion-button-p 'shr b)))) (interactive) (let ((text (get-text-property (point) 'shr-alt))) (if (not text) @@ -1248,20 +1284,20 @@ Return a string with image data." CONTENT-FUNCTION is a function to retrieve an image for a cid url that is an argument. The function to be returned takes three arguments URL, START, and END. Note that START and END should be markers." - `(lambda (url start end) - (when url - (if (string-match "\\`cid:" url) - ,(when content-function - `(let ((image (funcall ,content-function - (substring url (match-end 0))))) - (when image - (goto-char start) - (funcall shr-put-image-function - image (buffer-substring start end)) - (delete-region (point) end)))) - (url-retrieve url #'shr-image-fetched - (list (current-buffer) start end) - t t))))) + (lambda (url start end) + (when url + (if (string-match "\\`cid:" url) + (when content-function + (let ((image (funcall content-function + (substring url (match-end 0))))) + (when image + (goto-char start) + (funcall shr-put-image-function + image (buffer-substring start end)) + (delete-region (point) end)))) + (url-retrieve url #'shr-image-fetched + (list (current-buffer) start end) + t t))))) (defun shr-heading (dom &rest types) (shr-ensure-paragraph) @@ -1930,24 +1966,22 @@ BASE is the URL of the HTML being rendered." (shr-generic dom)) (defun shr-tag-h1 (dom) - (shr-heading dom (if shr-use-fonts - '(variable-pitch (:height 1.3 :weight bold)) - 'bold))) + (shr-heading dom 'shr-h1)) (defun shr-tag-h2 (dom) - (shr-heading dom 'bold)) + (shr-heading dom 'shr-h2)) (defun shr-tag-h3 (dom) - (shr-heading dom 'italic)) + (shr-heading dom 'shr-h3)) (defun shr-tag-h4 (dom) - (shr-heading dom)) + (shr-heading dom 'shr-h4)) (defun shr-tag-h5 (dom) - (shr-heading dom)) + (shr-heading dom 'shr-h5)) (defun shr-tag-h6 (dom) - (shr-heading dom)) + (shr-heading dom 'shr-h6)) (defun shr-tag-hr (_dom) (shr-ensure-newline) |