Add resize for large images in mm.

Signed-off-by: Julien Danjou <julien@danjou.info>

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 32e071e..0d7255f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,19 @@
+2010-10-03  Julien Danjou  <julien@danjou.info>
+
+       * mm-view.el (gnus-window-inside-pixel-edges): Add autoload for
+       gnus-window-inside-pixel-edges.
+
+       * gnus-ems.el (gnus-window-inside-pixel-edges): Move from gnus-html to
+       gnus-ems.
+
+       * mm-view.el (mm-inline-image-emacs): Support image resizing.
+
+       * gnus-util.el (gnus-rescale-image): Add generic gnus-rescale-image
+       function.
+
+       * mm-decode.el (mm-inline-large-images): Enhance defcustom and add
+       resize choice.
+
 2010-10-03  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-sum.el (gnus-summary-select-article-buffer): Really select the

diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el
index b4a2fe9..e1e37eb 100644 (file)
--- a/lisp/gnus-ems.el
+++ b/lisp/gnus-ems.el
@@ -307,6 +307,12 @@
                end nil))))))
 
 (eval-and-compile
+  ;; XEmacs does not have window-inside-pixel-edges
+  (defalias 'gnus-window-inside-pixel-edges
+    (if (fboundp 'window-inside-pixel-edges)
+        'window-inside-pixel-edges
+      'window-pixel-edges))
+
   (if (fboundp 'set-process-plist)
       (progn
        (defalias 'gnus-set-process-plist 'set-process-plist)

diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index a6a243a..bcbf1bd 100644 (file)
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -105,12 +105,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
                                          (match-string 0 encoded-text)))
                                 t t encoded-text)
                  s (1+ s)))
-         encoded-text))))
-  ;; XEmacs does not have window-inside-pixel-edges
-  (defalias 'gnus-window-inside-pixel-edges
-    (if (fboundp 'window-inside-pixel-edges)
-        'window-inside-pixel-edges
-      'window-pixel-edges)))
+         encoded-text)))))
 
 (defun gnus-html-encode-url (url)
   "Encode URL."

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index e140c75..26d6e2c 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1932,6 +1932,26 @@ is allowed once again.  (Immediately, if `inhibit-quit' is nil.)"
             (get-char-table ,character ,display-table)))
     `(aref ,display-table ,character)))
 
+(defun gnus-rescale-image (image size)
+  "Rescale IMAGE to SIZE if possible.
+SIZE is in format (WIDTH . HEIGHT). Return a new image.
+Sizes are in pixels."
+  (if (or (not (fboundp 'imagemagick-types))
+         (not (get-buffer-window (current-buffer))))
+      image
+    (let ((new-width (car size))
+          (new-height (cdr size)))
+      (when (> (cdr (image-size image t)) new-height)
+        (setq image (or (create-image (plist-get (cdr image) :data) 'imagemagick t
+                                      :height new-height)
+                        image)))
+      (when (> (car (image-size image t)) new-width)
+        (setq image (or
+                   (create-image (plist-get (cdr image) :data) 'imagemagick t
+                                 :width new-width)
+                   image)))
+      image)))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 72bf61b..ab96e34 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -369,8 +369,12 @@ enables you to choose manually one of two types those mails include."
   :group 'mime-display)
 
 (defcustom mm-inline-large-images nil
-  "If non-nil, then all images fit in the buffer."
-  :type 'boolean
+  "If t, then all images fit in the buffer.
+If 'resize, try to resize the images so they fit."
+  :type '(radio
+          (const :tag "Inline large images as they are." t)
+          (const :tag "Resize large images." resize)
+          (const :tag "Do not inline large images." nil))
   :group 'mime-display)
 
 (defcustom mm-file-name-rewrite-functions

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 566908c..82be361 100644 (file)
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -32,6 +32,7 @@
 (require 'smime)
 
 (autoload 'gnus-completing-read "gnus-util")
+(autoload 'gnus-window-inside-pixel-edges "gnus-ems")
 (autoload 'gnus-article-prepare-display "gnus-art")
 (autoload 'vcard-parse-string "vcard")
 (autoload 'vcard-format-string "vcard")
@@ -76,6 +77,13 @@
   :version "22.1"
   :group 'mime-display)
 
+(defcustom mm-inline-large-images-proportion 0.9
+  "Maximum proportion of large image resized when
+`mm-inline-large-images' is set to resize."
+  :type 'float
+  :version "24.1"
+  :group 'mime-display)
+
 ;;; Internal variables.
 
 ;;;
@@ -85,7 +93,18 @@
 (defun mm-inline-image-emacs (handle)
   (let ((b (point-marker))
        (inhibit-read-only t))
-    (put-image (mm-get-image handle) b)
+    (put-image
+     (let ((image (mm-get-image handle)))
+       (if (eq mm-inline-large-images 'resize)
+           (gnus-rescale-image image
+                               (let ((edges (gnus-window-inside-pixel-edges
+                                             (get-buffer-window (current-buffer)))))
+                                 (cons (truncate (* mm-inline-large-images-proportion
+                                                    (- (nth 2 edges) (nth 0 edges))))
+                                       (truncate (* mm-inline-large-images-proportion
+                                                    (- (nth 3 edges) (nth 1 edges)))))))
+         image))
+     b)
     (insert "\n\n")
     (mm-handle-set-undisplayer
      handle

diff --git a/texi/ChangeLog b/texi/ChangeLog
index 0c79511..d49a8e9 100644 (file)
--- a/texi/ChangeLog
+++ b/texi/ChangeLog
@@ -1,3 +1,9 @@
+2010-10-03  Julien Danjou  <julien@danjou.info>
+
+       * emacs-mime.texi (Display Customization): Update
+       mm-inline-large-images documentation and add documentation for
+       mm-inline-large-images-proportion.
+
 2010-10-02  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus.texi (Splitting Mail): Fix @xref syntax.

diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi
index 676fd38..ee60af9 100644 (file)
--- a/texi/emacs-mime.texi
+++ b/texi/emacs-mime.texi
@@ -374,12 +374,18 @@ message as follows:
 @vindex mm-inline-large-images
 When displaying inline images that are larger than the window, Emacs
 does not enable scrolling, which means that you cannot see the whole
-image.  To prevent this, the library tries to determine the image size
+image. To prevent this, the library tries to determine the image size
 before displaying it inline, and if it doesn't fit the window, the
 library will display it externally (e.g. with @samp{ImageMagick} or
-@samp{xv}).  Setting this variable to @code{t} disables this check and
+@samp{xv}). Setting this variable to @code{t} disables this check and
 makes the library display all inline images as inline, regardless of
-their size.
+their size. If you set this variable to @code{resize}, the image will
+be displayed resized to fit in the window, if Emacs has the ability to
+resize images.
+
+@item mm-inline-large-images-proportion
+@vindex mm-inline-images-max-proportion
+The proportion used when resizing large images.
 
 @item mm-inline-override-types
 @vindex mm-inline-override-types