Stop message.el from loading about 40 libraries it doesn't always need.
[bpt/emacs.git] / lisp / gnus / mm-decode.el
index 1125492..8bc659f 100644 (file)
@@ -1,26 +1,24 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; 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:
 
   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 
 (require 'mail-parse)
-(require 'mailcap)
 (require 'mm-bodies)
-(require 'gnus-util)
 (eval-when-compile (require 'cl)
                   (require 'term))
 
-(eval-and-compile
-  (autoload 'mm-inline-partial "mm-partial")
-  (autoload 'mm-inline-external-body "mm-extern")
-  (autoload 'mm-extern-cache-contents "mm-extern")
-  (autoload 'mm-insert-inline "mm-view"))
+(autoload 'gnus-map-function "gnus-util")
+(autoload 'gnus-replace-in-string "gnus-util")
+(autoload 'gnus-read-shell-command "gnus-util")
+
+(autoload 'mm-inline-partial "mm-partial")
+(autoload 'mm-inline-external-body "mm-extern")
+(autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'mm-insert-inline "mm-view")
 
 (defvar gnus-current-window-configuration)
 
@@ -235,6 +234,9 @@ before the external MIME handler is invoked."
        ;; makes it possible to install another package which provides an
        ;; alternative implementation of diff-mode.  --Stef
        (fboundp 'diff-mode)))
+    ;; In case mime.types uses x-diff (as does Debian's mime-support-3.40).
+    ("text/x-diff" mm-display-patch-inline
+     (lambda (handle) (fboundp 'diff-mode)))
     ("application/emacs-lisp" mm-display-elisp-inline identity)
     ("application/x-emacs-lisp" mm-display-elisp-inline identity)
     ("text/dns" mm-display-dns-inline identity)
@@ -550,6 +552,8 @@ Postpone undisplaying of viewers for types in
     (message "Destroying external MIME viewers")
     (mm-destroy-parts mm-postponed-undisplay-list)))
 
+(autoload 'message-fetch-field "message")
+
 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
@@ -563,7 +567,9 @@ Postpone undisplaying of viewers for types in
                ctl (and ct (mail-header-parse-content-type ct))
                cte (mail-fetch-field "content-transfer-encoding")
                cd (mail-fetch-field "content-disposition")
-               description (mail-fetch-field "content-description")
+               ;; Newlines in description should be stripped so as
+               ;; not to break the MIME tag into two or more lines.
+               description (message-fetch-field "content-description")
                id (mail-fetch-field "content-id"))
          (unless from
            (setq from (mail-fetch-field "from")))
@@ -686,6 +692,9 @@ Postpone undisplaying of viewers for types in
          (goto-char (point-max)))
       (mapcar 'mm-display-parts handle))))
 
+(autoload 'mailcap-parse-mailcaps "mailcap")
+(autoload 'mailcap-mime-info "mailcap")
+
 (defun mm-display-part (handle &optional no-default)
   "Display the MIME part represented by HANDLE.
 Returns nil if the part is removed; inline if displayed inline;
@@ -745,6 +754,7 @@ external if displayed external."
                 handle 'mailcap-save-binary-file)))))))))
 
 (declare-function gnus-configure-windows "gnus-win" (setting &optional force))
+(defvar mailcap-mime-extensions)       ; mailcap-mime-info autoloads
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
@@ -796,7 +806,7 @@ external if displayed external."
               (copiousoutput (assoc "copiousoutput" mime-info))
               file buffer)
          ;; We create a private sub-directory where we store our files.
-         (set-file-modes dir 448)
+         (set-file-modes dir #o700)
          (if filename
              (setq file (expand-file-name
                          (gnus-map-function mm-file-name-rewrite-functions
@@ -816,6 +826,10 @@ external if displayed external."
                                            nil suffix))))
          (let ((coding-system-for-write mm-binary-coding-system))
            (write-region (point-min) (point-max) file nil 'nomesg))
+         ;; The file is deleted after the viewer exists.  If the users edits
+         ;; the file, changes will be lost.  Set file to read-only to make it
+         ;; clear.
+         (set-file-modes file #o400)
          (message "Viewing with %s" method)
          (cond
           (needsterm
@@ -1233,10 +1247,9 @@ PROMPT overrides the default one used to ask user for a file name."
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
                                        (file-name-nondirectory filename))))
     (setq file
-         (mm-with-multibyte
-          (read-file-name (or prompt "Save MIME part to: ")
-                          (or mm-default-directory default-directory)
-                          nil nil (or filename ""))))
+          (read-file-name (or prompt "Save MIME part to: ")
+                          (or mm-default-directory default-directory)
+                          nil nil (or filename "")))
     (setq mm-default-directory (file-name-directory file))
     (and (or (not (file-exists-p file))
             (yes-or-no-p (format "File %s already exists; overwrite? "
@@ -1291,7 +1304,8 @@ text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t)
   "Pipe HANDLE to a process."
   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
         (command
-         (read-string "Shell command on MIME part: " mm-last-shell-command)))
+         (gnus-read-shell-command
+           "Shell command on MIME part: " mm-last-shell-command)))
     (mm-with-unibyte-buffer
       (mm-insert-part handle)
       (mm-add-meta-html-tag handle)
@@ -1433,6 +1447,8 @@ be determined."
            (intern type))
        :data (buffer-string)))))))
 
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))