gnus-html.el (gnus-html-rescale-image): Yet another try at getting the image sizing right.

2 files changed, 12 insertions, 9 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 4685373cf5f..735536971ea 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -3,6 +3,8 @@
         * gnus-html.el (gnus-html-wash-tags): Don't show images that are really
         small. They're probably tracking images.
         (gnus-html-wash-tags): Remove all <pre_int> place holders.
+        (gnus-html-rescale-image): Yet another try at getting the image sizing
+        right.
 
         * nntp.el (nntp-request-set-mark): Refuse to do marks if
         nntp-marks-file-name is nil.
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 6824fbf7d39..7e13a0bde97 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -274,14 +274,16 @@ fit these criteria."
            (window-height (truncate (* gnus-max-image-proportion
                                        (- (nth 3 edges) (nth 1 edges)))))
            scaled-image)
-      (or
-       (cond ((> height window-height)
-              (create-image file 'imagemagick nil
-                            :height window-height))
-             ((> width window-width)
-              (create-image file 'imagemagick nil
-                            :width window-width)))
-       image))))
+      (when (> height window-height)
+        (setq image (or (create-image file 'imagemagick nil
+                                      :height window-height)
+                        image))
+        (when (> (car (image-size image t)) window-width)
+          (setq image (or
+                       (create-image file 'imagemagick nil
+                                     :width window-width)
+                       image))))
+      image)))
 
 (defun gnus-html-prune-cache ()
   (let ((total-size 0)
@@ -301,7 +303,6 @@ fit these criteria."
           (decf total-size (cadr file))
           (delete-file (nth 2 file)))))))
 
-
 (defun gnus-html-image-url-blocked-p (url blocked-images)
 "Find out if URL is blocked by BLOCKED-IMAGES."
   (let ((ret (and blocked-images