(shr-tag-li): Get <li> indentation right.
[gnus] / lisp / mm-view.el
index d91f0da..82be361 100644 (file)
@@ -1,25 +1,23 @@
 ;;; 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.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 (require 'mm-decode)
 (require 'smime)
 
-(eval-and-compile
-  (autoload 'gnus-article-prepare-display "gnus-art")
-  (autoload 'vcard-parse-string "vcard")
-  (autoload 'vcard-format-string "vcard")
-  (autoload 'fill-flowed "flow-fill")
-  (autoload 'html2text "html2text" nil t))
+(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")
+(autoload 'fill-flowed "flow-fill")
+(autoload 'html2text "html2text" nil t)
 
 (defvar gnus-article-mime-handles)
 (defvar gnus-newsgroup-charset)
   :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
        (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 ()
 ;;      id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
 (defvar mm-pkcs7-signed-magic
-  (funcall (if (fboundp 'unibyte-string) 'unibyte-string 'string)
-   ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
-   ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
-   ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
-   ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02))
+  "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\
+\x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x02")
 
 ;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
 (defvar mm-pkcs7-enveloped-magic
-  (funcall (if (fboundp 'unibyte-string) 'unibyte-string 'string)
-   ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
-   ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
-   ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
-   ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03))
+  "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\
+\x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x03")
 
 (defun mm-view-pkcs7-get-type (handle)
   (mm-with-unibyte-buffer
    (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"))
 
 (provide 'mm-view)
 
-;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2
 ;;; mm-view.el ends here