gnus-html.el: Rescale images in article buffers for Emacs versions that support this...

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 884441db4b87cf9a666ef26e9f27f16e7f427460..711e7194d395003dff3143811401822774e8da32 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -7,6 +7,9 @@
 2010-09-01  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region.
+       (gnus-max-image-proportion): New variable.
+       (gnus-html-rescale-image): New function.
+       (gnus-html-put-image): Rescale images.
 
 2010-09-01  Stefan Monnier  <monnier@iro.umontreal.ca>
 

diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 2e44c3f5607b808987f70b760a26f6192881fb4c..a89a3f57ff16f3270783ac074cb1791990504519 100644 (file)
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -56,6 +56,16 @@
   :group 'gnus-art
   :type 'regexp)
 
+(defcustom gnus-max-image-proportion 0.7
+  "How big pictures displayed are in relation to the window they're in.
+A value of 0.7 means that they are allowed to take up 70% of the
+width and height of the window.  If they are larger than this,
+and Emacs supports it, then the images will be rescaled down to
+fit these criteria."
+  :version "24.1"
+  :group 'gnus-art
+  :type 'float)
+
 ;;;###autoload
 (defun gnus-article-html (handle)
   (let ((article-buffer (current-buffer)))
@@ -219,13 +229,33 @@
                           (= (car (image-size image t)) 30)
                           (= (cdr (image-size image t)) 30))))
            (progn
-             (gnus-put-image image)
+             (gnus-put-image (gnus-html-rescale-image image))
              t)
          (when (fboundp 'find-image)
            (gnus-put-image (find-image
                             '((:type xpm :file "lock-broken.xpm")))))
          nil)))))
 
+(defun gnus-html-rescale-image (image)
+  (if (not (fboundp 'imagemagick-types))
+      image
+    (let* ((width (car (image-size image t)))
+          (height (cdr (image-size image t)))
+          (edges (window-pixel-edges))
+          (window-width (truncate (* gnus-max-image-proportion
+                                     (- (nth 2 edges) (nth 0 edges)))))
+          (window-height (truncate (* gnus-max-image-proportion
+                                      (- (nth 3 edges) (nth 1 edges)))))
+          scaled-image)
+      (when (> width window-width)
+       (setq window-height (truncate (* window-height
+                                        (/ (* 1.0 window-width) width)))))
+      (if (> height window-height)
+         (or (create-image file 'imagemagick nil
+                           :height window-height)
+             image)
+       image))))
+
 (defun gnus-html-prune-cache ()
   (let ((total-size 0)
        files)