Synch to No Gnus 200601241028.

[elisp/gnus.git-] / lisp / mm-view.el

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 123f1a7..319acf7 100644 (file)
--- 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 Free Software Foundation, Inc.
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -49,8 +49,7 @@
 (defvar mm-text-html-renderer-alist
   '((w3  . mm-inline-text-html-render-with-w3)
     (w3m . mm-inline-text-html-render-with-w3m)
-    (w3m-standalone mm-inline-render-with-stdin nil
-                   "w3m" "-dump" "-T" "text/html")
+    (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
     (links mm-inline-render-with-file
           mm-links-remove-leading-blank
           "links" "-dump" file)
@@ -62,8 +61,7 @@
 (defvar mm-text-html-washer-alist
   '((w3  . gnus-article-wash-html-with-w3)
     (w3m . gnus-article-wash-html-with-w3m)
-    (w3m-standalone mm-inline-wash-with-stdin nil
-                   "w3m" "-dump" "-T" "text/html")
+    (w3m-standalone . gnus-article-wash-html-with-w3m-standalone)
     (links mm-inline-wash-with-file
           mm-links-remove-leading-blank
           "links" "-dump" file)
@@ -253,19 +251,71 @@
           (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))))
-      (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)))
-           (delete-region ,(point-min-marker)
-                          ,(point-max-marker))))))))
+                'mm-inline-text-html-with-w3m t)))
+       (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)))
+             (delete-region ,(point-min-marker)
+                            ,(point-max-marker)))))))))
+
+(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided)
+  "*T means the w3m command supports the m17n feature.")
+
+(defun mm-w3m-standalone-supports-m17n-p ()
+  "Say whether the w3m command supports the m17n feature."
+  (cond ((eq mm-w3m-standalone-supports-m17n-p t) t)
+       ((eq mm-w3m-standalone-supports-m17n-p nil) nil)
+       ((not (featurep 'mule)) (setq mm-w3m-standalone-supports-m17n-p nil))
+       ((condition-case nil
+            (let ((coding-system-for-write 'iso-2022-jp)
+                  (coding-system-for-read 'iso-2022-jp)
+                  (str (mm-decode-coding-string "\
+\e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t#s!!#m#1#7#n!)\e(B" 'iso-2022-jp)))
+              (mm-with-multibyte-buffer
+                (insert str)
+                (call-process-region
+                 (point-min) (point-max) "w3m" t t nil "-dump"
+                 "-T" "text/html" "-I" "iso-2022-jp" "-O" "iso-2022-jp")
+                (goto-char (point-min))
+                (search-forward str nil t)))
+          (error nil))
+        (setq mm-w3m-standalone-supports-m17n-p t))
+       (t
+        ;;(message "You had better upgrade your w3m command")
+        (setq mm-w3m-standalone-supports-m17n-p nil))))
+
+(defun mm-inline-text-html-render-with-w3m-standalone (handle)
+  "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))
+           cs)
+       (unless (and charset
+                    (setq cs (mm-charset-to-coding-system charset))
+                    (not (eq cs 'ascii)))
+         ;; The default.
+         (setq charset "iso-8859-1"
+               cs 'iso-8859-1))
+       (mm-insert-inline
+        handle
+        (mm-with-unibyte-buffer
+          (insert source)
+          (mm-enable-multibyte)
+          (let ((coding-system-for-write 'binary)
+                (coding-system-for-read cs))
+            (call-process-region
+             (point-min) (point-max)
+             "w3m" t t nil "-dump" "-T" "text/html"
+             "-I" charset "-O" charset))
+          (buffer-string))))
+    (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html")))
 
 (defun mm-links-remove-leading-blank ()
   ;; Delete the annoying three spaces preceding each line of links
@@ -371,9 +421,9 @@
        (goto-char (point-max))))
     (save-restriction
       (narrow-to-region b (point))
-      (set-text-properties (point-min) (point-max) nil)
       (when (or (equal type "enriched")
                (equal type "richtext"))
+       (set-text-properties (point-min) (point-max) nil)
        (ignore-errors
          (enriched-decode (point-min) (point-max))))
       (mm-handle-set-undisplayer