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 bf05fe93baeef8ec44a9ba6acf3f2e0d6f91a47c..68972020db3f7de26a346a6b96da59bfa86adfff 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -37,6 +37,7 @@
 (require 'dom)
 (require 'seq)
 (require 'svg)
 (require 'dom)
 (require 'seq)
 (require 'svg)

+(require 'image)

 
 (defgroup shr nil
   "Simple HTML Renderer"
 
 (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")
 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"))


@@ -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."
 (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
       (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))
       (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
           (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
 (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)))
     (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 "*"))
       (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))))))))
 
                             (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
 (defun shr-string-number (string)
   (if (null string)
       nil