X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-view.el;h=405b304b47fcb2100d3aed59aaba6ef62f3d4cd7;hb=1af25b1aeba0b49aa3978a7ac236f76cb41ad73e;hp=e35cf29ee260550fc7ff06001f85c414a0b9466e;hpb=546e9828be8e39aa275a4e2c53c217e86ae8f122;p=elisp%2Fgnus.git-

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index e35cf29..405b304 100644
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -34,6 +34,7 @@
   (autoload 'vcard-parse-string "vcard")
   (autoload 'vcard-format-string "vcard")
   (autoload 'fill-flowed "flow-fill")
+  (autoload 'html2text "html2text")
   (unless (fboundp 'diff-mode)
     (autoload 'diff-mode "diff-mode" "" t nil)))
 
@@ -44,7 +45,8 @@
 	   mm-links-remove-leading-blank
 	   "links" "-dump" file)
     (lynx  mm-inline-render-with-stdin nil
-	   "lynx" "-dump" "-force_html" "-stdin"))
+	   "lynx" "-dump" "-force_html" "-stdin")
+    (html2text  mm-inline-render-with-function html2text))
   "The attributes of renderer types for text/html.")
 
 (defvar mm-text-html-washer-alist
@@ -54,7 +56,8 @@
 	   mm-links-remove-leading-blank
 	   "links" "-dump" file)
     (lynx  mm-inline-wash-with-stdin nil
-	   "lynx" "-dump" "-force_html" "-stdin"))
+	   "lynx" "-dump" "-force_html" "-stdin")
+    (html2text  html2text))
   "The attributes of washer types for text/html.")
 
 ;;; Internal variables.
@@ -142,23 +145,25 @@
 		  ;; Don't let w3 set the global version of
 		  ;; this variable.
 		  (fill-column fill-column))
-	      (condition-case var
+	      (if (or debug-on-error debug-on-quit)
 		  (w3-region (point-min) (point-max))
-		(error
-		 (delete-region (point-min) (point-max))
-		 (let ((b (point))
-		       (charset (mail-content-type-get
-				 (mm-handle-type handle) 'charset)))
-		   (if (or (eq charset 'gnus-decoded)
-			   (eq mail-parse-charset 'gnus-decoded))
+		(condition-case ()
+		    (w3-region (point-min) (point-max))
+		  (error
+		   (delete-region (point-min) (point-max))
+		   (let ((b (point))
+			 (charset (mail-content-type-get
+				   (mm-handle-type handle) 'charset)))
+		     (if (or (eq charset 'gnus-decoded)
+			     (eq mail-parse-charset 'gnus-decoded))
 		       (save-restriction
 			 (narrow-to-region (point) (point))
 			 (mm-insert-part handle)
 			 (goto-char (point-max)))
-		     (insert (mm-decode-string (mm-get-part handle)
-					       charset))))
-		 (message
-		  "Error while rendering html; showing as text/plain"))))))
+		       (insert (mm-decode-string (mm-get-part handle)
+						 charset))))
+		   (message
+		    "Error while rendering html; showing as text/plain")))))))
 	(mm-handle-set-undisplayer
 	 handle
 	 `(lambda ()
@@ -308,7 +313,7 @@ will not be substituted.")
     (delete-region (match-beginning 0) (match-end 0))))
 
 (defun mm-inline-wash-with-file (post-func cmd &rest args)
-  (let ((file (make-temp-name
+  (let ((file (mm-make-temp-file
 	       (expand-file-name "mm" mm-tmp-directory))))
     (let ((coding-system-for-write 'binary))
       (write-region (point-min) (point-max) file nil 'silent))
@@ -569,8 +574,25 @@ will not be substituted.")
 (defun mm-view-pkcs7 (handle)
   (case (mm-view-pkcs7-get-type handle)
     (enveloped (mm-view-pkcs7-decrypt handle))
+    (signed (mm-view-pkcs7-verify handle))
     (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)))
+  (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)
   (insert-buffer (mm-handle-buffer handle))
   (goto-char (point-min))
@@ -581,10 +603,15 @@ will not be substituted.")
    (if (= (length smime-keys) 1)
        (cadar smime-keys)
      (smime-get-key-by-email
-      (completing-read "Decrypt this part with which key? "
-		       smime-keys nil nil
-		       (and (listp (car-safe smime-keys))
-			    (caar smime-keys)))))))
+      (completing-read
+       (concat "Decipher using which key? "
+	       (if smime-keys (concat "(default " (caar smime-keys) ") ")
+		 ""))
+       smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
+  (goto-char (point-min))
+  (while (search-forward "\r\n" nil t)
+    (replace-match "\n"))
+  (goto-char (point-min)))
 
 (provide 'mm-view)