Merge from emacs--devo--0

[gnus] / lisp / mm-view.el

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 6f110c5..5abeea1 100644 (file)
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -1,14 +1,14 @@
 ;;; mm-view.el --- functions for viewing MIME objects
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008 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
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -24,12 +24,14 @@
 ;;; Commentary:
 
 ;;; Code:
-
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile (require 'cl))
 (require 'mail-parse)
 (require 'mailcap)
 (require 'mm-bodies)
 (require 'mm-decode)
+(require 'smime)
 
 (eval-and-compile
   (autoload 'gnus-article-prepare-display "gnus-art")
@@ -96,25 +98,31 @@
          (delete-region b (+ b 2)))))))
 
 (defun mm-inline-image-xemacs (handle)
-  (insert "\n\n")
-  (forward-char -2)
-  (let ((annot (make-annotation (mm-get-image handle) nil 'text))
-       buffer-read-only)
-    (mm-handle-set-undisplayer
-     handle
-     `(lambda ()
-       (let ((b ,(point-marker))
-             buffer-read-only)
-         (delete-annotation ,annot)
-         (delete-region (- b 2) b))))
-    (set-extent-property annot 'mm t)
-    (set-extent-property annot 'duplicable t)))
+  (when (featurep 'xemacs)
+    (insert "\n\n")
+    (forward-char -2)
+    (let ((annot (make-annotation (mm-get-image handle) nil 'text))
+         buffer-read-only)
+      (mm-handle-set-undisplayer
+       handle
+       `(lambda ()
+         (let ((b ,(point-marker))
+               buffer-read-only)
+           (delete-annotation ,annot)
+           (delete-region (- b 2) b))))
+      (set-extent-property annot 'mm t)
+      (set-extent-property annot 'duplicable t))))
 
 (eval-and-compile
   (if (featurep 'xemacs)
       (defalias 'mm-inline-image 'mm-inline-image-xemacs)
     (defalias 'mm-inline-image 'mm-inline-image-emacs)))
 
+;; External.
+(declare-function w3-do-setup       "ext:w3"         ())
+(declare-function w3-region         "ext:w3-display" (st nd))
+(declare-function w3-prepare-buffer "ext:w3-display" (&rest args))
+
 (defvar mm-w3-setup nil)
 (defun mm-setup-w3 ()
   (unless mm-w3-setup
@@ -187,18 +195,22 @@
         handle
         `(lambda ()
            (let (buffer-read-only)
-             (if (functionp 'remove-specifier)
-                 (mapcar (lambda (prop)
-                           (remove-specifier
-                            (face-property 'default prop)
-                            (current-buffer)))
-                         '(background background-pixmap foreground)))
+             ,@(if (functionp 'remove-specifier)
+                   '((mapcar (lambda (prop)
+                               (remove-specifier
+                                (face-property 'default prop)
+                                (current-buffer)))
+                             '(background background-pixmap foreground))))
              (delete-region ,(point-min-marker)
                             ,(point-max-marker)))))))))
 
 (defvar mm-w3m-setup nil
   "Whether gnus-article-mode has been setup to use emacs-w3m.")
 
+;; External.
+(declare-function w3m-detect-meta-charset "ext:w3m" ())
+(declare-function w3m-region "ext:w3m" (start end &optional url charset))
+
 (defun mm-setup-w3m ()
   "Setup gnus-article-mode to use emacs-w3m."
   (unless mm-w3m-setup
@@ -236,7 +248,8 @@
   (mm-setup-w3m)
   (let ((text (mm-get-part handle))
        (b (point))
-       (charset (mail-content-type-get (mm-handle-type handle) 'charset)))
+       (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
+                    mail-parse-charset)))
     (save-excursion
       (insert (if charset (mm-decode-string text charset) text))
       (save-restriction
@@ -260,13 +273,7 @@
        (mm-handle-set-undisplayer
         handle
         `(lambda ()
-           (let (buffer-read-only)
-             (if (functionp 'remove-specifier)
-                 (mapcar (lambda (prop)
-                           (remove-specifier
-                            (face-property 'default prop)
-                            (current-buffer)))
-                         '(background background-pixmap foreground)))
+           (let ((inhibit-read-only t))
              (delete-region ,(point-min-marker)
                             ,(point-max-marker)))))))))
 
@@ -300,7 +307,9 @@
   "Render a text/html part using w3m."
   (if (mm-w3m-standalone-supports-m17n-p)
       (let ((source (mm-get-part handle))
-           (charset (mail-content-type-get (mm-handle-type handle) 'charset))
+           (charset (or (mail-content-type-get (mm-handle-type handle)
+                                               'charset)
+                        (symbol-name mail-parse-charset)))
            cs)
        (unless (and charset
                     (setq cs (mm-charset-to-coding-system charset))
@@ -366,7 +375,8 @@
 
 (defun mm-inline-render-with-function (handle func &rest args)
   (let ((source (mm-get-part handle))
-       (charset (mail-content-type-get (mm-handle-type handle) 'charset)))
+       (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
+                    mail-parse-charset)))
     (mm-insert-inline
      handle
      (mm-with-multibyte-buffer
@@ -569,7 +579,7 @@
       ;; By default, XEmacs font-lock uses non-duplicable text
       ;; properties.  This code forces all the text properties
       ;; to be copied along with the text.
-      (when (fboundp 'extent-list)
+      (when (featurep 'xemacs)
        (map-extents (lambda (ext ignored)
                       (set-extent-property ext 'duplicable t)
                       nil)