X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-view.el;h=11e475d21ec05a9eb3e108be15b7e87363ec9776;hb=a0ccf8d66844c87fa4ab9d7c6f9216699d07a337;hp=473948e19c5f1be51de1ea157839f8143b6d6bea;hpb=6b490dee6b69902b6eed3bf3567898fae3bffe1e;p=gnus

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 473948e19..11e475d21 100644
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -1,7 +1,7 @@
 ;;; mm-view.el --- functions for viewing MIME objects
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008  Free Software Foundation, Inc.
+;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -22,6 +22,8 @@
 ;;; Commentary:
 
 ;;; Code:
+
+;; For Emacs <22.2 and XEmacs.
 (eval-and-compile
   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile (require 'cl))
@@ -31,6 +33,8 @@
 (require 'mm-decode)
 (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")
@@ -75,6 +79,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.
 
 ;;;
@@ -84,7 +95,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
@@ -258,14 +280,35 @@
 	(let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
 	      w3m-force-redisplay)
 	  (w3m-region (point-min) (point-max) nil charset))
+	;; Put the mark meaning this part was rendered by emacs-w3m.
+	(put-text-property (point-min) (point-max)
+			   'mm-inline-text-html-with-w3m t)
 	(when (and mm-inline-text-html-with-w3m-keymap
 		   (boundp 'w3m-minor-mode-map)
 		   w3m-minor-mode-map)
-	  (add-text-properties
-	   (point-min) (point-max)
-	   (list 'keymap w3m-minor-mode-map
-		 ;; Put the mark meaning this part was rendered by emacs-w3m.
-		 'mm-inline-text-html-with-w3m t)))
+	  (if (and (boundp 'w3m-link-map)
+		   w3m-link-map)
+	      (let* ((start (point-min))
+		     (end (point-max))
+		     (on (get-text-property start 'w3m-href-anchor))
+		     (map (copy-keymap w3m-link-map))
+		     next)
+		(set-keymap-parent map w3m-minor-mode-map)
+		(while (< start end)
+		  (if on
+		      (progn
+			(setq next (or (text-property-any start end
+							  'w3m-href-anchor nil)
+				       end))
+			(put-text-property start next 'keymap map))
+		    (setq next (or (text-property-not-all start end
+							  'w3m-href-anchor nil)
+				   end))
+		    (put-text-property start next 'keymap w3m-minor-mode-map))
+		  (setq start next
+			on (not on))))
+	    (put-text-property (point-min) (point-max)
+			       'keymap w3m-minor-mode-map)))
 	(mm-handle-set-undisplayer
 	 handle
 	 `(lambda ()
@@ -655,11 +698,9 @@
    (if (= (length smime-keys) 1)
        (cadar smime-keys)
      (smime-get-key-by-email
-      (completing-read
-       (concat "Decipher using key"
-	       (if smime-keys (concat "(default " (caar smime-keys) "): ")
-		 ": "))
-       smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
+      (gnus-completing-read
+       "Decipher using key"
+       smime-keys nil nil nil (car-safe (car-safe smime-keys))))))
   (goto-char (point-min))
   (while (search-forward "\r\n" nil t)
     (replace-match "\n"))
@@ -667,5 +708,4 @@
 
 (provide 'mm-view)
 
-;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2
 ;;; mm-view.el ends here