X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/169043d6625acab49a9a12fb046321d96036cb7d..90fb0b2d13d0f44ecb9606587681cb4d8a6f0225:/lisp/net/shr.el

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index bf05fe93ba..68972020db 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -37,6 +37,7 @@
 (require 'dom)
 (require 'seq)
 (require 'svg)
+(require 'image)
 
 (defgroup shr nil
   "Simple HTML Renderer"
@@ -296,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")
-  (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"))
@@ -1008,22 +1011,25 @@ element is the data blob and the second element is the content-type."
 (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 (not (and (fboundp 'imagemagick-types)
-                (get-buffer-window (current-buffer))))
+  (if (or (not (fboundp 'imagemagick-types))
+          (not (get-buffer-window (current-buffer))))
       (create-image data nil t :ascent 100)
     (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))))))
+                                    (- (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)
+      (if (and width height
+               (< (* width scaling) max-width)
+               (< (* height scaling) max-height))
           (create-image
            data 'imagemagick t
            :ascent 100
@@ -1445,13 +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
-		 (> (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))
           (width (shr-string-number (dom-attr dom 'width)))
           (height (shr-string-number (dom-attr dom 'height)))
-	  (url (shr-expand-url (or url (dom-attr dom 'src)))))
+	  (url (shr-expand-url (or url (shr--preferred-image dom)))))
       (let ((start (point-marker)))
 	(when (zerop (length alt))
 	  (setq alt "*"))
@@ -1511,6 +1518,43 @@ The preference is a float determined from `shr-prefer-media-type'."
 			     (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