Fix shr.el/image build problem

[gnu-emacs] / lisp / net / shr.el

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 2c8ff79763f3cc36219d49f864cb0bac17f1c53c..68972020db3f7de26a346a6b96da59bfa86adfff 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -36,6 +36,8 @@
 (require 'subr-x)
 (require 'dom)
 (require 'seq)
 (require 'subr-x)
 (require 'dom)
 (require 'seq)

+(require 'svg)
+(require 'image)

 
 (defgroup shr nil
   "Simple HTML Renderer"
 
 (defgroup shr nil
   "Simple HTML Renderer"


@@ -64,6 +66,12 @@ fit these criteria."
   :group 'shr
   :type 'boolean)
 
   :group 'shr
   :type 'boolean)
 

+(defcustom shr-use-colors t
+  "If non-nil, respect color specifications in the HTML."
+  :version "25.2"
+  :group 'shr
+  :type 'boolean)
+

 (defcustom shr-table-horizontal-line nil
   "Character used to draw horizontal table lines.
 If nil, don't draw horizontal table lines."
 (defcustom shr-table-horizontal-line nil
   "Character used to draw horizontal table lines.
 If nil, don't draw horizontal table lines."


@@ -136,6 +144,14 @@ cid: URL as the argument.")
 (defvar shr-inhibit-images nil
   "If non-nil, inhibit loading images.")
 
 (defvar shr-inhibit-images nil
   "If non-nil, inhibit loading images.")
 

+(defvar shr-external-rendering-functions nil
+  "Alist of tag/function pairs used to alter how shr renders certain tags.
+For instance, eww uses this to alter rendering of title, forms
+and other things:
+((title . eww-tag-title)
+ (form . eww-tag-form)
+ ...)")
+

 ;;; Internal variables.
 
 (defvar shr-folding-mode nil)
 ;;; Internal variables.
 
 (defvar shr-folding-mode nil)


@@ -151,7 +167,6 @@ cid: URL as the argument.")
 (defvar shr-depth 0)
 (defvar shr-warning nil)
 (defvar shr-ignore-cache nil)
 (defvar shr-depth 0)
 (defvar shr-warning nil)
 (defvar shr-ignore-cache nil)

-(defvar shr-external-rendering-functions nil)

 (defvar shr-target-id nil)
 (defvar shr-table-separator-length 1)
 (defvar shr-table-separator-pixel-width 0)
 (defvar shr-target-id nil)
 (defvar shr-table-separator-length 1)
 (defvar shr-table-separator-pixel-width 0)


@@ -172,10 +187,16 @@ cid: URL as the argument.")
     (define-key map "w" 'shr-copy-url)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
     (define-key map "w" 'shr-copy-url)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)

-    (define-key map "o" 'shr-save-contents)
+    (define-key map "O" 'shr-save-contents)

     (define-key map "\r" 'shr-browse-url)
     map))
 
     (define-key map "\r" 'shr-browse-url)
     map))
 

+(defvar shr-image-map
+  (let ((map (copy-keymap shr-map)))
+    (when (boundp 'image-map)
+      (set-keymap-parent map image-map))
+    map))
+

 ;; Public functions and commands.
 (declare-function libxml-parse-html-region "xml.c"
                  (start end &optional base-url discard-comments))
 ;; Public functions and commands.
 (declare-function libxml-parse-html-region "xml.c"
                  (start end &optional base-url discard-comments))


@@ -254,22 +275,19 @@ DOM should be a parse tree as generated by
     (set-window-hscroll nil 0)
     (shr-descend dom)
     (shr-fill-lines start (point))
     (set-window-hscroll nil 0)
     (shr-descend dom)
     (shr-fill-lines start (point))

-    (shr-remove-trailing-whitespace start (point))
+    (shr--remove-blank-lines-at-the-end start (point))

     (when shr-warning
       (message "%s" shr-warning))))
 
     (when shr-warning
       (message "%s" shr-warning))))
 

-(defun shr-remove-trailing-whitespace (start end)
-  (let ((width (window-width)))
-    (save-restriction
+(defun shr--remove-blank-lines-at-the-end (start end)
+  (save-restriction
+    (save-excursion

       (narrow-to-region start end)
       (narrow-to-region start end)

-      (goto-char start)
-      (while (not (eobp))
-       (end-of-line)
-       (when (> (shr-previous-newline-padding-width (current-column)) width)
-         (dolist (overlay (overlays-at (point)))
-           (when (overlay-get overlay 'before-string)
-             (overlay-put overlay 'before-string nil))))
-       (forward-line 1)))))
+      (goto-char end)
+      (when (and (re-search-backward "[^ \n]" nil t)
+                 (not (eobp)))
+        (forward-line 1)
+        (delete-region (point) (point-max))))))

 
 (defun shr-copy-url (&optional image-url)
   "Copy the URL under point to the kill ring.
 
 (defun shr-copy-url (&optional image-url)
   "Copy the URL under point to the kill ring.


@@ -279,8 +297,10 @@ image under point instead.
 If called twice, then try to fetch the URL and see whether it
 redirects somewhere else."
   (interactive "P")
 If called twice, then try to fetch the URL and see whether it
 redirects somewhere else."
   (interactive "P")

-  (let ((url (or (get-text-property (point) 'shr-url)
-                (get-text-property (point) 'image-url))))
+  (let ((url (if image-url
+                 (get-text-property (point) 'image-url)
+               (or (get-text-property (point) 'shr-url)
+                   (get-text-property (point) 'image-url)))))

     (cond
      ((not url)
       (message "No URL under point"))
     (cond
      ((not url)
       (message "No URL under point"))


@@ -435,11 +455,10 @@ size, and full-buffer size."
 
 (defun shr-descend (dom)
   (let ((function
 
 (defun shr-descend (dom)
   (let ((function

-        (or
-         ;; Allow other packages to override (or provide) rendering
-         ;; of elements.
-         (cdr (assq (dom-tag dom) shr-external-rendering-functions))
-         (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray)))
+         (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))
+        ;; Allow other packages to override (or provide) rendering
+        ;; of elements.
+        (external (cdr (assq (dom-tag dom) shr-external-rendering-functions)))

        (style (dom-attr dom 'style))
        (shr-stylesheet shr-stylesheet)
        (shr-depth (1+ shr-depth))
        (style (dom-attr dom 'style))
        (shr-stylesheet shr-stylesheet)
        (shr-depth (1+ shr-depth))


@@ -454,9 +473,12 @@ size, and full-buffer size."
          (setq style nil)))
       ;; If we have a display:none, then just ignore this part of the DOM.
       (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
          (setq style nil)))
       ;; If we have a display:none, then just ignore this part of the DOM.
       (unless (equal (cdr (assq 'display shr-stylesheet)) "none")

-       (if (fboundp function)
-           (funcall function dom)
-         (shr-generic dom))
+        (cond (external
+               (funcall external dom))
+              ((fboundp function)
+               (funcall function dom))
+              (t
+               (shr-generic dom)))

        (when (and shr-target-id
                   (equal (dom-attr dom 'id) shr-target-id))
          ;; If the element was empty, we don't have anything to put the
        (when (and shr-target-id
                   (equal (dom-attr dom 'id) shr-target-id))
          ;; If the element was empty, we don't have anything to put the


@@ -535,6 +557,16 @@ size, and full-buffer size."
       (insert string)
       (shr-pixel-column))))
 
       (insert string)
       (shr-pixel-column))))
 

+(defsubst shr--translate-insertion-chars ()
+  ;; Remove soft hyphens.
+  (goto-char (point-min))
+  (while (search-forward "­" nil t)
+    (replace-match "" t t))
+  ;; Translate non-breaking spaces into real spaces.
+  (goto-char (point-min))
+  (while (search-forward " " nil t)
+    (replace-match " " t t)))
+

 (defun shr-insert (text)
   (when (and (not (bolp))
             (get-text-property (1- (point)) 'image-url))
 (defun shr-insert (text)
   (when (and (not (bolp))
             (get-text-property (1- (point)) 'image-url))


@@ -545,14 +577,11 @@ size, and full-buffer size."
       (insert text)
       (save-restriction
        (narrow-to-region 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))
+        (shr--translate-insertion-chars)

        (goto-char (point-max)))))
    (t
     (let ((font-start (point)))
        (goto-char (point-max)))))
    (t
     (let ((font-start (point)))

-      (when (and (string-match "\\`[ \t\n\r ]" text)
+      (when (and (string-match "\\`[ \t\n\r]" text)

                 (not (bolp))
                 (not (eq (char-after (1- (point))) ? )))
        (insert " "))
                 (not (bolp))
                 (not (eq (char-after (1- (point))) ? )))
        (insert " "))


@@ -562,14 +591,11 @@ size, and full-buffer size."
        (save-restriction
          (narrow-to-region start (point))
          (goto-char start)
        (save-restriction
          (narrow-to-region start (point))
          (goto-char start)

-         (when (looking-at "[ \t\n\r ]+")
+         (when (looking-at "[ \t\n\r]+")

            (replace-match "" t t))
            (replace-match "" t t))

-         (while (re-search-forward "[ \t\n\r ]+" nil t)
+         (while (re-search-forward "[ \t\n\r]+" nil t)

            (replace-match " " t t))
            (replace-match " " t t))

-         ;; Remove soft hyphens.
-         (goto-char (point-min))
-         (while (search-forward "­" nil t)
-           (replace-match "" t t))
+          (shr--translate-insertion-chars)

          (goto-char (point-max)))
        ;; We may have removed everything we inserted if if was just
        ;; spaces.
          (goto-char (point-max)))
        ;; We may have removed everything we inserted if if was just
        ;; spaces.


@@ -952,10 +978,14 @@ element is the data blob and the second element is the content-type."
                      (create-image data 'svg t :ascent 100))
                     ((eq size 'full)
                      (ignore-errors
                      (create-image data 'svg t :ascent 100))
                     ((eq size 'full)
                      (ignore-errors

-                       (shr-rescale-image data content-type)))
+                       (shr-rescale-image data content-type
+                                           (plist-get flags :width)
+                                           (plist-get flags :height))))

                     (t
                      (ignore-errors
                     (t
                      (ignore-errors

-                       (shr-rescale-image data content-type))))))
+                       (shr-rescale-image data content-type
+                                           (plist-get flags :width)
+                                           (plist-get flags :height)))))))

         (when image
          ;; When inserting big-ish pictures, put them at the
          ;; beginning of the line.
         (when image
          ;; When inserting big-ish pictures, put them at the
          ;; beginning of the line.


@@ -978,21 +1008,40 @@ element is the data blob and the second element is the content-type."
        image)
     (insert (or alt ""))))
 
        image)
     (insert (or alt ""))))
 

-(defun shr-rescale-image (data &optional content-type)
-  "Rescale DATA, if too big, to fit the current buffer."
-  (if (not (and (fboundp 'imagemagick-types)
-                (get-buffer-window (current-buffer))))
+(defun shr-rescale-image (data content-type width height)
+  "Rescale DATA, if too big, to fit the current buffer.
+WIDTH and HEIGHT are the sizes given in the HTML data, if any."
+  (if (or (not (fboundp 'imagemagick-types))
+          (not (get-buffer-window (current-buffer))))

       (create-image data nil t :ascent 100)
       (create-image data nil t :ascent 100)

-    (let ((edges (window-inside-pixel-edges
-                 (get-buffer-window (current-buffer)))))
-      (create-image
-       data 'imagemagick t
-       :ascent 100
-       :max-width (truncate (* shr-max-image-proportion
-                              (- (nth 2 edges) (nth 0 edges))))
-       :max-height (truncate (* shr-max-image-proportion
-                               (- (nth 3 edges) (nth 1 edges))))
-       :format content-type))))
+    (let* ((edges (window-inside-pixel-edges
+                   (get-buffer-window (current-buffer))))
+           (max-width (truncate (* shr-max-image-proportion
+                                   (- (nth 2 edges) (nth 0 edges)))))
+           (max-height (truncate (* shr-max-image-proportion
+                                    (- (nth 3 edges) (nth 1 edges)))))
+           (scaling (image-compute-scaling-factor image-scaling-factor)))
+      (when (or (and width
+                     (> width max-width))
+                (and height
+                     (> height max-height)))
+        (setq width nil
+              height nil))
+      (if (and width height
+               (< (* width scaling) max-width)
+               (< (* height scaling) max-height))
+          (create-image
+           data 'imagemagick t
+           :ascent 100
+           :width width
+           :height height
+           :format content-type)
+        (create-image
+         data 'imagemagick t
+         :ascent 100
+         :max-width max-width
+         :max-height max-height
+         :format content-type)))))

 
 ;; url-cache-extract autoloads url-cache.
 (declare-function url-cache-create-filename "url-cache" (url))
 
 ;; url-cache-extract autoloads url-cache.
 (declare-function url-cache-create-filename "url-cache" (url))


@@ -1071,8 +1120,15 @@ START, and END.  Note that START and END should be markers."
                                   url)))
                      (if title (format "%s (%s)" iri title) iri))
         'follow-link t
                                   url)))
                      (if title (format "%s (%s)" iri title) iri))
         'follow-link t

-        'mouse-face 'highlight
-        'keymap shr-map)))
+        'mouse-face 'highlight))
+  ;; Don't overwrite any keymaps that are already in the buffer (i.e.,
+  ;; image keymaps).
+  (while (and start
+              (< start (point)))
+    (let ((next (next-single-property-change start 'keymap nil (point))))
+      (if (get-text-property start 'keymap)
+          (setq start next)
+        (put-text-property start (or next (point)) 'keymap shr-map)))))

 
 (defun shr-encode-url (url)
   "Encode URL."
 
 (defun shr-encode-url (url)
   "Encode URL."


@@ -1104,7 +1160,9 @@ ones, in case fg and bg are nil."
                (shr-color-visible bg fg)))))))
 
 (defun shr-colorize-region (start end fg &optional bg)
                (shr-color-visible bg fg)))))))
 
 (defun shr-colorize-region (start end fg &optional bg)

-  (when (and (or fg bg) (>= (display-color-cells) 88))
+  (when (and shr-use-colors
+             (or fg bg)
+             (>= (display-color-cells) 88))

     (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
        (when fg
     (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
        (when fg


@@ -1117,18 +1175,6 @@ ones, in case fg and bg are nil."
                                  t)))
       new-colors)))
 
                                  t)))
       new-colors)))
 

-(defun shr-previous-newline-padding-width (width)
-  (let ((overlays (overlays-at (point)))
-       (previous-width 0))
-    (if (null overlays)
-       width
-      (dolist (overlay overlays)
-       (setq previous-width
-             (+ previous-width
-                (length (plist-get (overlay-properties overlay)
-                                   'before-string)))))
-      (+ width previous-width))))
-

 ;;; Tag-specific rendering rules.
 
 (defun shr-tag-html (dom)
 ;;; Tag-specific rendering rules.
 
 (defun shr-tag-html (dom)


@@ -1137,7 +1183,9 @@ ones, in case fg and bg are nil."
      ((equal dir "ltr")
       (setq bidi-paragraph-direction 'left-to-right))
      ((equal dir "rtl")
      ((equal dir "ltr")
       (setq bidi-paragraph-direction 'left-to-right))
      ((equal dir "rtl")

-      (setq bidi-paragraph-direction 'right-to-left))))
+      (setq bidi-paragraph-direction 'right-to-left))
+     ((equal dir "auto")
+      (setq bidi-paragraph-direction nil))))

   (shr-generic dom))
 
 (defun shr-tag-body (dom)
   (shr-generic dom))
 
 (defun shr-tag-body (dom)


@@ -1223,9 +1271,6 @@ ones, in case fg and bg are nil."
 (defun shr-tag-s (dom)
   (shr-fontize-dom dom 'shr-strike-through))
 
 (defun shr-tag-s (dom)
   (shr-fontize-dom dom 'shr-strike-through))
 

-(defun shr-tag-del (dom)
-  (shr-fontize-dom dom 'shr-strike-through))
-

 (defun shr-tag-b (dom)
   (shr-fontize-dom dom 'bold))
 
 (defun shr-tag-b (dom)
   (shr-fontize-dom dom 'bold))
 


@@ -1245,6 +1290,24 @@ ones, in case fg and bg are nil."
   (let ((shr-current-font 'default))
     (shr-generic dom)))
 
   (let ((shr-current-font 'default))
     (shr-generic dom)))
 

+(defun shr-tag-ins (cont)
+  (let* ((start (point))
+         (color "green")
+         (shr-stylesheet (nconc (list (cons 'color color))
+                               shr-stylesheet)))
+    (shr-generic cont)
+    (shr-colorize-region start (point) color
+                         (cdr (assq 'background-color shr-stylesheet)))))
+
+(defun shr-tag-del (cont)
+  (let* ((start (point))
+         (color "red")
+         (shr-stylesheet (nconc (list (cons 'color color))
+                               shr-stylesheet)))
+    (shr-fontize-dom cont 'shr-strike-through)
+    (shr-colorize-region start (point) color
+                         (cdr (assq 'background-color shr-stylesheet)))))
+

 (defun shr-parse-style (style)
   (when style
     (save-match-data
 (defun shr-parse-style (style)
   (when style
     (save-match-data


@@ -1388,11 +1451,14 @@ The preference is a float determined from `shr-prefer-media-type'."
 (defun shr-tag-img (dom &optional url)
   (when (or url
            (and dom
 (defun shr-tag-img (dom &optional url)
   (when (or url
            (and dom

-                (> (length (dom-attr dom 'src)) 0)))
+                (or (> (length (dom-attr dom 'src)) 0)
+                     (> (length (dom-attr dom 'srcset)) 0))))

     (when (> (current-column) 0)
       (insert "\n"))
     (let ((alt (dom-attr dom 'alt))
     (when (> (current-column) 0)
       (insert "\n"))
     (let ((alt (dom-attr dom 'alt))

-         (url (shr-expand-url (or url (dom-attr dom 'src)))))
+          (width (shr-string-number (dom-attr dom 'width)))
+          (height (shr-string-number (dom-attr dom 'height)))
+         (url (shr-expand-url (or url (shr--preferred-image dom)))))

       (let ((start (point-marker)))
        (when (zerop (length alt))
          (setq alt "*"))
       (let ((start (point-marker)))
        (when (zerop (length alt))
          (setq alt "*"))


@@ -1405,7 +1471,8 @@ The preference is a float determined from `shr-prefer-media-type'."
               (string-match "\\`data:" url))
          (let ((image (shr-image-from-data (substring url (match-end 0)))))
            (if image
               (string-match "\\`data:" url))
          (let ((image (shr-image-from-data (substring url (match-end 0)))))
            (if image

-               (funcall shr-put-image-function image alt)
+               (funcall shr-put-image-function image alt
+                         (list :width width :height height))

              (insert alt))))
         ((and (not shr-inhibit-images)
               (string-match "\\`cid:" url))
              (insert alt))))
         ((and (not shr-inhibit-images)
               (string-match "\\`cid:" url))


@@ -1414,7 +1481,8 @@ The preference is a float determined from `shr-prefer-media-type'."
            (if (or (not shr-content-function)
                    (not (setq image (funcall shr-content-function url))))
                (insert alt)
            (if (or (not shr-content-function)
                    (not (setq image (funcall shr-content-function url))))
                (insert alt)

-             (funcall shr-put-image-function image alt))))
+             (funcall shr-put-image-function image alt
+                       (list :width width :height height)))))

         ((or shr-inhibit-images
              (and shr-blocked-images
                   (string-match shr-blocked-images url)))
         ((or shr-inhibit-images
              (and shr-blocked-images
                   (string-match shr-blocked-images url)))


@@ -1422,20 +1490,26 @@ The preference is a float determined from `shr-prefer-media-type'."
           (shr-insert alt))
         ((and (not shr-ignore-cache)
               (url-is-cached (shr-encode-url url)))
           (shr-insert alt))
         ((and (not shr-ignore-cache)
               (url-is-cached (shr-encode-url url)))

-         (funcall shr-put-image-function (shr-get-image-data url) alt))
+         (funcall shr-put-image-function (shr-get-image-data url) alt
+                   (list :width width :height height)))

         (t
         (t

-         (insert alt " ")

          (when (and shr-ignore-cache
                     (url-is-cached (shr-encode-url url)))
            (let ((file (url-cache-create-filename (shr-encode-url url))))
              (when (file-exists-p file)
                (delete-file file))))
          (when (and shr-ignore-cache
                     (url-is-cached (shr-encode-url url)))
            (let ((file (url-cache-create-filename (shr-encode-url url))))
              (when (file-exists-p file)
                (delete-file file))))

+          (when (image-type-available-p 'svg)
+            (insert-image
+             (shr-make-placeholder-image dom)
+             (or alt "")))
+          (insert " ")

          (url-queue-retrieve
           (shr-encode-url url) 'shr-image-fetched
          (url-queue-retrieve
           (shr-encode-url url) 'shr-image-fetched

-          (list (current-buffer) start (set-marker (make-marker) (1- (point))))
+          (list (current-buffer) start (set-marker (make-marker) (point))
+                 (list :width width :height height))

           t t)))
        (when (zerop shr-table-depth) ;; We are not in a table.
           t t)))
        (when (zerop shr-table-depth) ;; We are not in a table.

-         (put-text-property start (point) 'keymap shr-map)
+         (put-text-property start (point) 'keymap shr-image-map)

          (put-text-property start (point) 'shr-alt alt)
          (put-text-property start (point) 'image-url url)
          (put-text-property start (point) 'image-displayer
          (put-text-property start (point) 'shr-alt alt)
          (put-text-property start (point) 'image-url url)
          (put-text-property start (point) 'image-displayer


@@ -1444,6 +1518,87 @@ The preference is a float determined from `shr-prefer-media-type'."
                             (shr-fill-text
                              (or (dom-attr dom 'title) alt))))))))
 
                             (shr-fill-text
                              (or (dom-attr dom 'title) alt))))))))
 

+(defun shr--preferred-image (dom)
+  (let ((srcset (dom-attr dom 'srcset))
+        (frame-width (frame-pixel-width))
+        (width (string-to-number (or (dom-attr dom 'width) "100")))
+        candidate)
+    (when (> (length srcset) 0)
+      ;; srcset consist of a series of URL/size specifications
+      ;; separated by the ", " string.
+      (setq srcset
+            (sort (mapcar
+                   (lambda (elem)
+                     (let ((spec (split-string elem " ")))
+                       (cond
+                        ((= (length spec) 1)
+                         ;; Make sure it's well formed.
+                         (list (car spec) 0))
+                        ((string-match "\\([0-9]+\\)x\\'" (cadr spec))
+                         ;; If we have an "x" form, then use the width
+                         ;; spec to compute the real width.
+                         (list (car spec)
+                               (* width (string-to-number
+                                         (match-string 1 (cadr spec))))))
+                        (t
+                         (list (car spec)
+                               (string-to-number (cadr spec)))))))
+                   (split-string srcset ", "))
+                  (lambda (e1 e2)
+                    (> (cadr e1) (cadr e2)))))
+      ;; Choose the smallest picture that's bigger than the current
+      ;; frame.
+      (setq candidate (caar srcset))
+      (while (and srcset
+                  (> (cadr (car srcset)) frame-width))
+        (setq candidate (caar srcset))
+        (pop srcset)))
+    (or candidate (dom-attr dom 'src))))
+
+(defun shr-string-number (string)
+  (if (null string)
+      nil
+    (setq string (replace-regexp-in-string "[^0-9]" "" string))
+    (if (zerop (length string))
+        nil
+      (string-to-number string))))
+
+(defun shr-make-placeholder-image (dom)
+  (let* ((edges (and
+                 (get-buffer-window (current-buffer))
+                 (window-inside-pixel-edges
+                  (get-buffer-window (current-buffer)))))
+         (scaling (image-compute-scaling-factor image-scaling-factor))
+         (width (truncate
+                 (* (or (shr-string-number (dom-attr dom 'width)) 100)
+                    scaling)))
+         (height (truncate
+                  (* (or (shr-string-number (dom-attr dom 'height)) 100)
+                     scaling)))
+         (max-width
+          (and edges
+               (truncate (* shr-max-image-proportion
+                            (- (nth 2 edges) (nth 0 edges))))))
+         (max-height (and edges
+                          (truncate (* shr-max-image-proportion
+                                       (- (nth 3 edges) (nth 1 edges))))))
+         svg image)
+    (when (and max-width
+               (> width max-width))
+      (setq height (truncate (* (/ (float max-width) width) height))
+            width max-width))
+    (when (and max-height
+               (> height max-height))
+      (setq width (truncate (* (/ (float max-height) height) width))
+            height max-height))
+    (setq svg (svg-create width height))
+    (svg-gradient svg "background" 'linear '((0 . "#b0b0b0") (100 . "#808080")))
+    (svg-rectangle svg 0 0 width height :gradient "background"
+                   :stroke-width 2 :stroke-color "black")
+    (let ((image (svg-image svg)))
+      (setf (image-property image :ascent) 100)
+      image)))
+

 (defun shr-tag-pre (dom)
   (let ((shr-folding-mode 'none)
        (shr-current-font 'default))
 (defun shr-tag-pre (dom)
   (let ((shr-folding-mode 'none)
        (shr-current-font 'default))


@@ -1510,7 +1665,9 @@ The preference is a float determined from `shr-prefer-media-type'."
        (put-text-property start (1+ start)
                           'shr-continuation-indentation shr-indentation)
        (put-text-property start (1+ start) 'shr-prefix-length (length bullet))
        (put-text-property start (1+ start)
                           'shr-continuation-indentation shr-indentation)
        (put-text-property start (1+ start) 'shr-prefix-length (length bullet))

-       (shr-generic dom)))))
+       (shr-generic dom))))
+  (unless (bolp)
+    (insert "\n")))

 
 (defun shr-mark-fill (start)
   ;; We may not have inserted any text to fill.
 
 (defun shr-mark-fill (start)
   ;; We may not have inserted any text to fill.


@@ -1573,6 +1730,24 @@ The preference is a float determined from `shr-prefer-media-type'."
       (shr-colorize-region start (point) color
                           (cdr (assq 'background-color shr-stylesheet))))))
 
       (shr-colorize-region start (point) color
                           (cdr (assq 'background-color shr-stylesheet))))))
 

+(defun shr-tag-bdo (dom)
+  (let* ((direction (dom-attr dom 'dir))
+         (char (cond
+                ((equal direction "ltr")
+                 ?\N{LEFT-TO-RIGHT OVERRIDE})
+                ((equal direction "rtl")
+                 ?\N{RIGHT-TO-LEFT OVERRIDE}))))
+    (when char
+      (insert ?\N{FIRST STRONG ISOLATE} char))
+    (shr-generic dom)
+    (when char
+      (insert ?\N{POP DIRECTIONAL FORMATTING} ?\N{POP DIRECTIONAL ISOLATE}))))
+
+(defun shr-tag-bdi (dom)
+  (insert ?\N{FIRST STRONG ISOLATE})
+  (shr-generic dom)
+  (insert ?\N{POP DIRECTIONAL ISOLATE}))
+

 ;;; Table rendering algorithm.
 
 ;; Table rendering is the only complicated thing here.  We do this by
 ;;; Table rendering algorithm.
 
 ;; Table rendering is the only complicated thing here.  We do this by