Merge branch 'master' of https://git.gnus.org/gnus
authorLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Sun, 3 Oct 2010 21:28:53 +0000 (23:28 +0200)
committerLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Sun, 3 Oct 2010 21:28:53 +0000 (23:28 +0200)
lisp/ChangeLog
lisp/gnus-ems.el
lisp/gnus-html.el
lisp/gnus-util.el
lisp/mm-decode.el
lisp/mm-view.el
texi/ChangeLog
texi/emacs-mime.texi

index 02c295b..08c8235 100644 (file)
@@ -1,3 +1,21 @@
+2010-10-03  Julien Danjou  <julien@danjou.info>
+
+       * gnus-html.el (gnus-html-put-image): Use gnus-rescale-image.
+
+       * 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>
 
        * shr.el (shr-tag-p): Don't insert newlines on empty tags at the
index b4a2fe9..e1e37eb 100644 (file)
                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)
index a6a243a..732fcdd 100644 (file)
@@ -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."
@@ -436,7 +431,17 @@ Return a string with image data."
                                  (= (car size) 30)
                                  (= (cdr size) 30))))
                   ;; Good image, add it!
-                  (let ((image (gnus-html-rescale-image image data size)))
+                  (let ((image (gnus-html-rescale-image
+                                image
+                                ;; (width . height)
+                                (cons
+                                 ;; Aimed width
+                                 (truncate
+                                  (* gnus-max-image-proportion
+                                     (- (nth 2 edges) (nth 0 edges))))
+                                 ;; Aimed height
+                                 (truncate (* gnus-max-image-proportion
+                                              (- (nth 3 edges) (nth 1 edges))))))))
                     (delete-region start end)
                     (gnus-put-image image alt-text 'external)
                     (gnus-put-text-property start (point) 'help-echo alt-text)
@@ -459,31 +464,6 @@ Return a string with image data."
                   (gnus-add-image 'internal image))
                 nil))))))))
 
-(defun gnus-html-rescale-image (image data size)
-  (if (or (not (fboundp 'imagemagick-types))
-         (not (get-buffer-window (current-buffer))))
-      image
-    (let* ((width (car size))
-          (height (cdr size))
-          (edges (gnus-window-inside-pixel-edges
-                  (get-buffer-window (current-buffer))))
-          (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 (> height window-height)
-       (setq image (or (create-image data 'imagemagick t
-                                     :height window-height)
-                       image))
-       (setq size (image-size image t)))
-      (when (> (car size) window-width)
-       (setq image (or
-                    (create-image data 'imagemagick t
-                                  :width window-width)
-                    image)))
-      image)))
-
 (defun gnus-html-image-url-blocked-p (url blocked-images)
   "Find out if URL is blocked by BLOCKED-IMAGES."
   (let ((ret (and blocked-images
index e140c75..26d6e2c 100644 (file)
@@ -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
index 72bf61b..ab96e34 100644 (file)
@@ -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
index 566908c..82be361 100644 (file)
@@ -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")
   :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.
 
 ;;;
 (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
index 0c79511..d49a8e9 100644 (file)
@@ -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.
index 676fd38..ee60af9 100644 (file)
@@ -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