(mml2015-epg-encrypt): Save the recipient keys in message-options.
[gnus] / lisp / mm-view.el
index 14b5e67..5268582 100644 (file)
@@ -36,7 +36,7 @@
   (autoload 'vcard-parse-string "vcard")
   (autoload 'vcard-format-string "vcard")
   (autoload 'fill-flowed "flow-fill")
-  (autoload 'html2text "html2text"))
+  (autoload 'html2text "html2text" nil t))
 
 (defvar gnus-article-mime-handles)
 (defvar gnus-newsgroup-charset)
@@ -73,6 +73,7 @@
 (defcustom mm-fill-flowed t
   "If non-nil a format=flowed article will be displayed flowed."
   :type 'boolean
+  :version "22.1"
   :group 'mime-display)
 
 ;;; Internal variables.
 
 (defun mm-w3m-cid-retrieve-1 (url handle)
   (dolist (elem handle)
-    (when (listp elem)
-      (if (equal url (mm-handle-id elem))
-         (progn
-           (mm-insert-part elem)
-           (throw 'found-handle (mm-handle-media-type elem))))
-      (if (equal "multipart" (mm-handle-media-supertype elem))
-         (mm-w3m-cid-retrieve-1 url elem)))))
+    (when (consp elem)
+      (when (equal url (mm-handle-id elem))
+       (mm-insert-part elem)
+       (throw 'found-handle (mm-handle-media-type elem)))
+      (when (and (stringp (car elem))
+                (equal "multipart" (mm-handle-media-supertype elem)))
+       (mm-w3m-cid-retrieve-1 url elem)))))
 
 (defun mm-w3m-cid-retrieve (url &rest args)
   "Insert a content pointed by URL if it has the cid: scheme."
   (when (string-match "\\`cid:" url)
-    (catch 'found-handle
-      (mm-w3m-cid-retrieve-1 (concat "<" (substring url (match-end 0)) ">")
-                            (with-current-buffer w3m-current-buffer
-                              gnus-article-mime-handles)))))
+    (or (catch 'found-handle
+         (mm-w3m-cid-retrieve-1
+          (setq url (concat "<" (substring url (match-end 0)) ">"))
+          (with-current-buffer w3m-current-buffer
+            gnus-article-mime-handles)))
+       (prog1
+           nil
+         (message "Failed to find \"Content-ID: %s\"" url)))))
 
 (defun mm-inline-text-html-render-with-w3m (handle)
   "Render a text/html part using emacs-w3m."
              (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."
-  (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)))))
+  (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
       (save-restriction
        (narrow-to-region b (point))
        (goto-char b)
-       (fill-flowed)
+       (fill-flowed nil (equal (cdr (assoc 'delsp (mm-handle-type handle)))
+                               "yes"))
        (goto-char (point-max))))
     (save-restriction
       (narrow-to-region b (point))
              ;; disable prepare hook
              gnus-article-prepare-hook
              (gnus-newsgroup-charset
-              (or charset gnus-newsgroup-charset)))
+              (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
+                (or charset gnus-newsgroup-charset))))
          (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
            (run-hooks 'gnus-article-decode-hook))
          (gnus-article-prepare-display)
       (buffer-disable-undo)
       (mm-enable-multibyte)
       (insert (cond ((eq charset 'gnus-decoded)
-                    (mm-insert-part handle))
+                    (with-current-buffer (mm-handle-buffer handle)
+                      (buffer-string)))
                    (coding-system
                     (mm-decode-coding-string text coding-system))
                    (charset
     (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
 
 (defun mm-view-pkcs7-verify (handle)
-  ;; A bogus implementation of PKCS#7. FIXME::
-  (mm-insert-part handle)
-  (goto-char (point-min))
-  (if (search-forward "Content-Type: " nil t)
-      (delete-region (point-min) (match-beginning 0)))
-  (goto-char (point-max))
-  (if (re-search-backward "--\r?\n?" nil t)
-      (delete-region (match-end 0) (point-max)))
+  (let ((verified nil))
+    (with-temp-buffer
+      (insert "MIME-Version: 1.0\n")
+      (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
+      (insert-buffer-substring (mm-handle-buffer handle))
+      (setq verified (smime-verify-region (point-min) (point-max))))
+    (goto-char (point-min))
+    (mm-insert-part handle)
+    (if (search-forward "Content-Type: " nil t)
+       (delete-region (point-min) (match-beginning 0)))
+    (goto-char (point-max))
+    (if (re-search-backward "--\r?\n?" nil t)
+       (delete-region (match-end 0) (point-max)))
+    (unless verified
+      (insert-buffer-substring smime-details-buffer)))
   (goto-char (point-min))
   (while (search-forward "\r\n" nil t)
     (replace-match "\n"))
-  (message "Verify signed PKCS#7 message is unimplemented.")
-  (sit-for 1)
   t)
 
 (defun mm-view-pkcs7-decrypt (handle)