X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-mime.el;h=0c14cfdeb4466006733258e388f249832f060ea9;hb=13ea09ab66b44b1a3b0971e1a24ce0da47a6ca0a;hp=5dd9480a2ae1a3c27e09d09391382d02fe39be25;hpb=c858144859641b0dc23d73a47041f355897088cd;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-mime.el b/wl/wl-mime.el
index 5dd9480..0c14cfd 100644
--- a/wl/wl-mime.el
+++ b/wl/wl-mime.el
@@ -28,18 +28,16 @@
 
 ;;; Code:
 ;;
-
 (require 'mime-view)
 (require 'mime-edit)
 (require 'mime-play)
+(require 'mime-parse)
+(eval-when-compile (require 'mmbuffer))
 (require 'elmo)
-
-(eval-when-compile
-  (defalias-maybe 'pgg-decrypt-region 'ignore)
-  (defalias-maybe 'pgg-display-output-buffer 'ignore)
-  (defalias-maybe 'pgg-verify-region 'ignore))
-
-(defvar mime-edit-temp-message-buffer)
+(require 'elmo-mime)
+(require 'wl-vars)
+(require 'wl-util)
+(eval-when-compile (require 'cl))
 
 ;;; Draft
 
@@ -64,16 +62,53 @@ has Non-nil value\)"
 		     (function wl-draft-yank-to-draft-buffer))))
 	(message-buffer (wl-current-message-buffer)))
     (if message-buffer
-	(save-excursion
-	  (set-buffer message-buffer)
+	(with-current-buffer message-buffer
 	  (save-restriction
 	    (widen)
-	    (if (wl-region-exists-p)
-		(wl-mime-preview-follow-current-region)
-	      (mime-preview-follow-current-entity))))
+	    (cond
+	     ((wl-region-exists-p)
+	      (wl-mime-preview-follow-current-region))
+	     ((not (wl-message-mime-analysis-p
+		    (wl-message-buffer-display-type)))
+	      (wl-mime-preview-follow-no-mime
+	       (wl-message-buffer-display-type)))
+	     (t
+	      (mime-preview-follow-current-entity)))))
       (error "No message."))))
 
 ;; modified mime-preview-follow-current-entity from mime-view.el
+(defun wl-mime-preview-follow-no-mime (display-type)
+  "Write follow message to current message, without mime.
+It calls following-method selected from variable
+`mime-preview-following-method-alist'."
+  (interactive)
+  (let* ((mode (mime-preview-original-major-mode 'recursive))
+	 (new-name (format "%s-no-mime" (buffer-name)))
+	 new-buf min beg end
+	 (entity (get-text-property (point-min) 'elmo-as-is-entity))
+	 (the-buf (current-buffer))
+	 fields)
+    (save-excursion
+      (goto-char (point-min))
+      (setq min (point-min)
+	    beg (re-search-forward "^$" nil t)
+	    end (point-max)))
+    (with-current-buffer (setq new-buf (get-buffer-create new-name))
+      (erase-buffer)
+      (insert-buffer-substring the-buf beg end)
+      (goto-char (point-min))
+      ;; Insert all headers.
+      (let ((elmo-mime-display-header-analysis
+	     (wl-message-mime-analysis-p display-type 'header)))
+	(elmo-mime-insert-sorted-header entity))
+      (let ((f (cdr (assq mode mime-preview-following-method-alist))))
+	(if (functionp f)
+	    (funcall f new-buf)
+	  (message
+	   "Sorry, following method for %s is not implemented yet."
+	   mode))))))
+
+;; modified mime-preview-follow-current-entity from mime-view.el
 (defun wl-mime-preview-follow-current-region ()
   "Write follow message to current region.
 It calls following-method selected from variable
@@ -89,14 +124,14 @@ It calls following-method selected from variable
 	   new-buf
 	   (the-buf (current-buffer))
 	   fields)
-      (save-excursion
-	(set-buffer (setq new-buf (get-buffer-create new-name)))
+      (with-current-buffer (setq new-buf (get-buffer-create new-name))
 	(erase-buffer)
 	(insert ?\n)
 	(insert-buffer-substring the-buf r-beg r-end)
 	(goto-char (point-min))
 	(let ((current-entity
-	       (if (and (eq (mime-entity-media-type entity) 'message)
+	       (if (and entity
+			(eq (mime-entity-media-type entity) 'message)
 			(eq (mime-entity-media-subtype entity) 'rfc822))
 		   (car (mime-entity-children entity))
 		 entity)))
@@ -109,16 +144,14 @@ It calls following-method selected from variable
 			(mime-insert-header current-entity fields)
 			t))
 	    (setq fields (std11-collect-field-names)
-		  current-entity (mime-entity-parent current-entity))
-	    ))
+		  current-entity (mime-entity-parent current-entity))))
 	(let ((rest mime-view-following-required-fields-list)
 	      field-name ret)
 	  (while rest
 	    (setq field-name (car rest))
 	    (or (std11-field-body field-name)
 		(progn
-		  (save-excursion
-		    (set-buffer the-buf)
+		  (with-current-buffer the-buf
 		    (let ((entity (when mime-mother-buffer
 				    (set-buffer mime-mother-buffer)
 				    (get-text-property (point)
@@ -128,38 +161,83 @@ It calls following-method selected from variable
 						   entity field-name))))
 			(setq entity (mime-entity-parent entity)))))
 		  (if ret
-		      (insert (concat field-name ": " ret "\n"))
-		    )))
-	    (setq rest (cdr rest))
-	    ))
-	)
+		      (insert (concat field-name ": " ret "\n")))))
+	    (setq rest (cdr rest)))))
       (let ((f (cdr (assq mode mime-preview-following-method-alist))))
 	(if (functionp f)
 	    (funcall f new-buf)
 	  (message
 	   "Sorry, following method for %s is not implemented yet."
-	   mode)
-	  ))
-      )))
+	   mode))))))
 
 (defalias 'wl-draft-enclose-digest-region 'mime-edit-enclose-digest-region)
 
+(defun wl-draft-preview-attributes-list ()
+  (if (listp (car wl-draft-preview-attributes-list))
+      (elmo-uniq-list
+       (nconc (and (wl-message-mail-p)
+		   (copy-sequence
+		    (cdr (assq 'mail wl-draft-preview-attributes-list))))
+	      (and (wl-message-news-p)
+		   (copy-sequence
+		    (cdr (assq 'news wl-draft-preview-attributes-list))))))
+    wl-draft-preview-attributes-list))
+
+(defun wl-draft-show-attributes-buffer (attribute-values)
+  (let* ((cur-win (selected-window))
+	 (size (min
+		(- (window-height cur-win)
+		   window-min-height 1)
+		(- (window-height cur-win)
+		   (max
+		    window-min-height
+		    (1+ wl-draft-preview-attributes-buffer-lines))))))
+    (split-window cur-win (if (> size 0) size window-min-height))
+    (select-window (next-window))
+    (let ((pop-up-windows nil))
+      (switch-to-buffer (get-buffer-create
+			 wl-draft-preview-attributes-buffer-name)))
+    (with-current-buffer
+	(get-buffer wl-draft-preview-attributes-buffer-name)
+      (setq buffer-read-only t)
+      (let (buffer-read-only)
+	(erase-buffer)
+	(dolist (pair attribute-values)
+	  (insert (capitalize (symbol-name (car pair))) ": "
+		  (format "%s" (or (cdr pair) ""))
+		  "\n"))
+	(goto-char (point-min))
+	(wl-highlight-headers)))
+    (select-window cur-win)))
+
+(defun wl-draft-hide-attributes-buffer ()
+  (let (window buffer)
+    (when (setq window (get-buffer-window
+			wl-draft-preview-attributes-buffer-name))
+      (select-window window)
+      (delete-window))
+    (when (setq buffer (get-buffer wl-draft-preview-attributes-buffer-name))
+      (kill-buffer buffer))))
+
 (defun wl-draft-attribute-recipients ()
-  (concat (mapconcat
-	   'identity
-	   (wl-draft-deduce-address-list
-	    (current-buffer)
-	    (point-min)
-	    (save-excursion
-	      (goto-char (point-min))
-	      (re-search-forward
-	       (concat
-		"^"
-		(regexp-quote mail-header-separator)
-		"$")
-	       nil t)
-	      (point)))
-	   ", ")))
+  (let (wl-draft-remove-group-list-contents)
+    (mapconcat
+     'identity
+     (nconc
+      (wl-draft-deduce-address-list
+       (current-buffer)
+       (point-min)
+       (save-excursion
+	 (goto-char (point-min))
+	 (re-search-forward
+	  (concat
+	   "^"
+	   (regexp-quote mail-header-separator)
+	   "$")
+	  nil t)
+	 (point)))
+      (wl-draft-parse-mailbox-list wl-draft-mime-bcc-field-name))
+     ", ")))
 
 (defun wl-draft-attribute-envelope-from ()
   (or wl-envelope-from
@@ -174,6 +252,36 @@ It calls following-method selected from variable
   (or wl-smtp-posting-port
       (progn (require 'smtp) smtp-service)))
 
+(defun wl-draft-attribute-newsgroups ()
+  (std11-field-body "Newsgroups"))
+
+(defun wl-draft-nntp-attribute (attribute &optional alternatives)
+  (let ((config (cdr (elmo-string-matched-assoc
+		      (std11-field-body "newsgroups")
+		      wl-nntp-posting-config-alist)))
+	entry)
+    (when (stringp config)
+      (setq config (list (cons 'server config))))
+    (if (setq entry (assq attribute config))
+	;; maybe nil
+	(cdr entry)
+      (let (value)
+	(while alternatives
+	  (if (setq value (symbol-value (car alternatives)))
+	      (setq alternatives nil)
+	    (setq alternatives (cdr alternatives))))
+	value))))
+
+(defun wl-draft-attribute-nntp-posting-server ()
+  (wl-draft-nntp-attribute
+   'server
+   '(wl-nntp-posting-server elmo-nntp-default-server)))
+
+(defun wl-draft-attribute-nntp-posting-port ()
+  (wl-draft-nntp-attribute
+   'port
+   '(wl-nntp-posting-port elmo-nntp-default-port)))
+
 (defun wl-draft-attribute-value (attr)
   (let ((name (symbol-name attr))
 	fsymbol symbol)
@@ -189,7 +297,8 @@ It calls following-method selected from variable
 
 (defun wl-mime-quit-preview ()
   "Quitting method for mime-view."
-  (let* ((temp mime-edit-temp-message-buffer)
+  (let* ((temp (and (boundp 'mime-edit-temp-message-buffer) ;; for SEMI <= 1.14.6
+		    mime-edit-temp-message-buffer))
 	 (window (selected-window))
 	 buf)
     (mime-preview-kill-buffer)
@@ -202,7 +311,7 @@ It calls following-method selected from variable
 (defun wl-draft-preview-message ()
   "Preview editing message."
   (interactive)
-  (let* (attribute-list
+  (let* (attribute-values
 	 (orig-buffer (current-buffer))
 	 (current-point (point))
 	 (config-exec-flag wl-draft-config-exec-flag)
@@ -216,29 +325,30 @@ It calls following-method selected from variable
 	       (symbol-value 'mime-header-encode-method-alist))))
 	 mime-view-ignored-field-list	; all header.
 	 (mime-edit-translate-buffer-hook
-	  (append
-	   (list
-	    (lambda ()
-	      (let ((wl-draft-config-exec-flag config-exec-flag)
-		    (wl-draft-parent-folder parent-folder)
-		    (copy-buffer (current-buffer)))
+	  (cons
+	   (lambda ()
+	     (let ((wl-draft-config-exec-flag config-exec-flag)
+		   (wl-draft-parent-folder parent-folder)
+		   (copy-buffer (current-buffer)))
+	       (wl-copy-local-variables
+		orig-buffer
+		copy-buffer
 		(with-current-buffer orig-buffer
-		  (wl-copy-local-variables
-		   orig-buffer
-		   copy-buffer
-		   (append wl-draft-config-variables
-			   (wl-draft-clone-local-variables))))
-		(goto-char current-point)
-		(run-hooks 'wl-draft-send-hook)
-		(condition-case err
-		    (setq attribute-list
-			  (mapcar
-			   (lambda (attr)
-			     (cons attr (wl-draft-attribute-value attr)))
-			   wl-draft-preview-attributes-list))
-		  (error
-		   (kill-buffer (current-buffer))
-		   (signal (car err) (cdr err)))))))
+		  (append wl-draft-config-variables
+			  (wl-draft-clone-local-variables))))
+	       (goto-char current-point)
+	       (run-hooks 'wl-draft-send-hook)
+	       (condition-case err
+		   (setq attribute-values
+			 (mapcar
+			  (lambda (attr)
+			    (cons attr (wl-draft-attribute-value attr)))
+			  (if wl-draft-preview-attributes
+			      (wl-draft-preview-attributes-list)
+			    '(recipients))))
+		 (error
+		  (kill-buffer (current-buffer))
+		  (signal (car err) (cdr err))))))
 	   mime-edit-translate-buffer-hook)))
     (mime-edit-preview-message)
     (make-local-variable 'mime-preview-quitting-method-alist)
@@ -248,46 +358,13 @@ It calls following-method selected from variable
       (when wl-highlight-body-too
 	(wl-highlight-body))
       (run-hooks 'wl-draft-preview-message-hook))
-    (make-local-variable 'kill-buffer-hook)
-    (add-hook 'kill-buffer-hook
-	      (lambda ()
-		(when (get-buffer-window
-		       wl-draft-preview-attributes-buffer-name)
-		  (select-window (get-buffer-window
-				  wl-draft-preview-attributes-buffer-name))
-		  (delete-window))
-		(when (get-buffer wl-draft-preview-attributes-buffer-name)
-		  (kill-buffer (get-buffer
-				wl-draft-preview-attributes-buffer-name)))))
-    (if (not wl-draft-preview-attributes)
-	(message (concat "Recipients: "
-			 (cdr (assq 'recipients attribute-list))))
-      (ignore-errors ; in case when the window is too small
-	(let* ((cur-win (selected-window))
-	       (size (min
-		      (- (window-height cur-win)
-			 window-min-height 1)
-		      (- (window-height cur-win)
-			 (max
-			  window-min-height
-			  (1+ wl-draft-preview-attributes-buffer-lines))))))
-	  (split-window cur-win (if (> size 0) size window-min-height))
-	  (select-window (next-window))
-	  (let ((pop-up-windows nil))
-	    (switch-to-buffer (get-buffer-create
-			       wl-draft-preview-attributes-buffer-name)))
-	  (with-current-buffer
-	      (get-buffer wl-draft-preview-attributes-buffer-name)
-	    (setq buffer-read-only t)
-	    (let (buffer-read-only)
-	      (erase-buffer)
-	      (dolist (pair attribute-list)
-		(insert (capitalize (symbol-name (car pair))) ": "
-			(format "%s" (or (cdr pair) ""))
-			"\n"))
-	      (goto-char (point-min))
-	      (wl-highlight-headers)))
-	  (select-window cur-win))))))
+    (make-local-hook 'kill-buffer-hook)
+    (add-hook 'kill-buffer-hook #'wl-draft-hide-attributes-buffer nil t)
+    (if wl-draft-preview-attributes
+	(ignore-errors ; in case when the window is too small
+	 (wl-draft-show-attributes-buffer attribute-values))
+      (message (concat "Recipients: "
+		       (cdr (assq 'recipients attribute-values)))))))
 
 (defalias 'wl-draft-caesar-region  'mule-caesar-region)
 
@@ -309,19 +386,21 @@ It calls following-method selected from variable
 	mime-view-ignored-field-list)
     (mime-view-mode nil nil nil inbuf outbuf)))
 
-(defun wl-message-delete-mime-out-buf ()
-  (let (mime-out-buf mime-out-win)
-    (if (setq mime-out-buf (get-buffer mime-echo-buffer-name))
-	(if (setq mime-out-win (get-buffer-window mime-out-buf))
-	    (delete-window mime-out-win)))))
+(defun wl-message-delete-popup-windows ()
+  (dolist (buffer wl-message-popup-buffers)
+    (when (or (stringp buffer)
+	      (and (symbolp buffer)
+		   (boundp buffer)
+		   (setq buffer (symbol-value buffer))))
+      (let ((window (get-buffer-window buffer)))
+	(when window
+	  (delete-window window))))))
 
 (defun wl-message-request-partial (folder number)
   (elmo-set-work-buf
    (elmo-message-fetch (wl-folder-get-elmo-folder folder)
 		       number
 		       (elmo-make-fetch-strategy 'entire)
-		       nil
-		       (current-buffer)
 		       'unread)
    (mime-parse-buffer nil)))
 
@@ -336,7 +415,7 @@ It calls following-method selected from variable
 
 (defsubst wl-mime-node-id-to-string (node-id)
   (if (consp node-id)
-      (mapconcat (function (lambda (num) (format "%s" (1+ num))))
+      (mapconcat (lambda (num) (format "%s" (1+ num)))
 		 (reverse node-id)
 		 ".")
     "0"))
@@ -360,8 +439,9 @@ It calls following-method selected from variable
       (with-current-buffer orig-buf
 	(unless (string-equal
 		 (buffer-string)
-		 (elmo-message-fetch folder number
-				     (elmo-make-fetch-strategy 'entire)))
+		 (elmo-message-fetch-string
+		  folder number
+		  (elmo-make-fetch-strategy 'entire)))
 	  (error "Buffer content differs from actual message")))
       (when (and (elmo-folder-writable-p folder)
 		 (buffer-live-p orig-buf)
@@ -370,7 +450,7 @@ It calls following-method selected from variable
 		  (format "Do you really want to delete part %s? "
 			  (wl-mime-node-id-to-string node-id))))
 	(when (with-temp-buffer
-		(insert-buffer orig-buf)
+		(insert-buffer-substring orig-buf)
 		(delete-region header-start body-end)
 		(goto-char header-start)
 		(insert "Content-Type: text/plain; charset=US-ASCII\n")
@@ -400,69 +480,173 @@ It calls following-method selected from variable
 	  (setq wl-message-buffer nil)
 	  (wl-summary-sync nil "update"))))))
 
+;; PGP
+(eval-when-compile
+  (defmacro wl-define-dummy-functions (&rest symbols)
+    `(dolist (symbol (quote ,symbols))
+       (defalias symbol 'ignore))))
+
+(eval-when-compile
+  ;; split eval-when-compile form for avoid error on `make compile-strict'
+  (require 'mime-pgp)
+  (condition-case nil
+      (require 'epa)
+    (error
+     (wl-define-dummy-functions epg-make-context
+				epg-decrypt-string
+				epg-verify-string
+				epg-context-set-progress-callback
+				epg-context-result-for
+				epg-verify-result-to-string
+				epa-display-info)))
+  (condition-case nil
+      (require 'pgg)
+    (error
+     (wl-define-dummy-functions pgg-decrypt-region
+				pgg-verify-region
+				pgg-display-output-buffer))))
+
+(defun wl-epg-progress-callback (context what char current total reporter)
+  (let ((label (elmo-progress-counter-label reporter)))
+    (when label
+      (elmo-progress-notify label :set current :total total))))
+
+(defun wl-mime-pgp-decrypt-region-with-epg (beg end &optional no-decode)
+  (require 'epg)
+  (let ((context (epg-make-context)))
+    (elmo-with-progress-display (epg-decript nil reporter)
+	"Decrypting"
+      (epg-context-set-progress-callback context
+					 (cons #'wl-epg-progress-callback
+					       reporter))
+      (insert (prog1
+		  (decode-coding-string
+		   (epg-decrypt-string
+		    context
+		    (buffer-substring beg end))
+		   (if no-decode 'raw-text wl-cs-autoconv))
+		(delete-region beg end)))))
+  last-coding-system-used)
+
+(defun wl-mime-pgp-verify-region-with-epg (beg end &optional coding-system)
+  (require 'epa)
+  (let ((context (epg-make-context)))
+    (elmo-with-progress-display (epg-verify nil reporter)
+	"Verifying"
+      (epg-context-set-progress-callback context
+					 (cons #'wl-epg-progress-callback
+					       reporter))
+      (epg-verify-string
+       context
+       (encode-coding-string
+	(buffer-substring beg end)
+	(if coding-system
+	    (coding-system-change-eol-conversion coding-system 'dos)
+	  'raw-text-dos))))
+    (when (epg-context-result-for context 'verify)
+      (epa-display-info (epg-verify-result-to-string
+			 (epg-context-result-for context 'verify))))))
+
+(defun wl-mime-pgp-decrypt-region-with-pgg (beg end &optional no-decode)
+  (require 'pgg)
+  (let ((buffer-file-coding-system wl-cs-autoconv)
+	status)
+    (setq status (pgg-decrypt-region beg end))
+    (if no-decode
+	(when status
+	  (delete-region beg end)
+	  (insert-buffer-substring pgg-output-buffer))
+      (pgg-display-output-buffer beg end status))
+    (unless status
+      (error "Decryption is failed"))
+    last-coding-system-used))
+
+(defun wl-mime-pgp-verify-region-with-pgg (beg end &optional coding-system)
+  (require 'pgg)
+  (let ((message-buffer (current-buffer))
+	success)
+    (with-temp-buffer
+      (insert-buffer-substring message-buffer beg end)
+      (when coding-system
+	(encode-coding-region (point-min) (point-max) coding-system))
+      (setq success (pgg-verify-region (point-min) (point-max) nil 'fetch)))
+    (mime-show-echo-buffer)
+    (set-buffer mime-echo-buffer-name)
+    (set-window-start
+     (get-buffer-window mime-echo-buffer-name)
+     (point-max))
+    (insert-buffer-substring
+     (if success
+	 pgg-output-buffer
+       pgg-errors-buffer))))
+
+(defsubst wl-mime-pgp-decrypt-region (beg end &optional no-decode)
+  (case wl-use-pgp-module
+    (epg
+     (wl-mime-pgp-decrypt-region-with-epg beg end no-decode))
+    (pgg
+     (wl-mime-pgp-decrypt-region-with-pgg beg end no-decode))
+    (t
+     (error "Don't support PGP decryption"))))
+
+(defsubst wl-mime-pgp-verify-region (beg end &optional coding-system)
+  (case wl-use-pgp-module
+    (epg
+     (wl-mime-pgp-verify-region-with-epg beg end coding-system))
+    (pgg
+     (wl-mime-pgp-verify-region-with-pgg beg end coding-system))
+    (t
+     (error "Don't support PGP decryption"))))
+
 (defun wl-message-decrypt-pgp-nonmime ()
   "Decrypt PGP encrypted region"
   (interactive)
-  (require 'pgg)
   (save-excursion
     (beginning-of-line)
-    (if (or (re-search-forward "^-+END PGP MESSAGE-+$" nil t)
-	    (re-search-backward "^-+END PGP MESSAGE-+$" nil t))
-	(let (beg end status)
-	  (setq end (match-end 0))
-	  (if (setq beg (re-search-backward "^-+BEGIN PGP MESSAGE-+$" nil t))
-	      (let ((inhibit-read-only t)
-		    (buffer-file-coding-system wl-cs-autoconv))
-		(setq status (pgg-decrypt-region beg end))
-		(pgg-display-output-buffer beg end status))
-	    (message "Cannot find pgp encrypted region")))
-      (message "Cannot find pgp encrypted region"))))
-
-(defun wl-message-verify-pgp-nonmime ()
-  "Verify PGP signed region"
-  (interactive)
-  (require 'pgg)
+    (let ((region (wl-find-region "^-+BEGIN PGP MESSAGE-+$"
+				  "^-+END PGP MESSAGE-+$"))
+	  (inhibit-read-only t)
+	  coding-system)
+      (unless region
+	(error "Cannot find PGP encrypted region"))
+      (save-restriction
+	(let ((props (text-properties-at (car region))))
+	  (narrow-to-region (car region) (cdr region))
+	  (when (setq coding-system
+		      (wl-mime-pgp-decrypt-region (point-min) (point-max)))
+	    (setq props (plist-put props
+				   'wl-mime-decoded-coding-system
+				   coding-system)))
+	  (set-text-properties (point-min) (point-max) props))))))
+
+(defun wl-message-verify-pgp-nonmime (&optional arg)
+  "Verify PGP signed region.
+With ARG, ask coding system and encode the region with it before verifying."
+  (interactive "P")
   (save-excursion
     (beginning-of-line)
-    (if (and (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)
-		 (re-search-backward "^-+END PGP SIGNATURE-+$" nil t))
-	     (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
-	(let (status)
-	  (let* ((beg (point))
-		 (situation (mime-preview-find-boundary-info))
-		 (p-end (aref situation 1))
-		 (entity (aref situation 2))
-		 (count 0))
-	    (goto-char p-end)
-	    (while (< beg (point))
-	      (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
-		  (setq count (+ count 1))
-		(debug)))
-	    (with-temp-buffer
-	      (set-buffer-multibyte nil)
-	      (insert (mime-entity-body entity))
-	      (goto-char (point-max))
-	      (while (> count 0)
-		(if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
-		    (setq count (- count 1))
-		  (debug)))
-	      (let ((r-beg (point))
-		    (r-end (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)))
-		(if r-end
-		    (setq status (pgg-verify-region r-beg r-end nil 'fetch))
-		  (debug)))))
-	  (mime-show-echo-buffer)
-	  (set-buffer mime-echo-buffer-name)
-	  (set-window-start
-	   (get-buffer-window mime-echo-buffer-name)
-	   (point-max))
-	  (insert-buffer-substring
-	   (if status pgg-output-buffer pgg-errors-buffer)))
-      (message "Cannot find pgp signed region"))))
+    (let ((region (wl-find-region "^-+BEGIN PGP SIGNED MESSAGE-+$"
+				  "^-+END PGP SIGNATURE-+$"))
+	  coding-system)
+      (unless region
+	(error "Cannot find PGP signed region"))
+      (setq coding-system
+	    (or (get-text-property (car region) 'wl-mime-decoded-coding-system)
+		(let* ((situation (mime-preview-find-boundary-info))
+		       (entity (aref situation 2)))
+		  (mime-charset-to-coding-system
+		   (mime-content-type-parameter
+		    (mime-entity-content-type entity)
+		    "charset")))
+		buffer-file-coding-system))
+      (when arg
+	(setq coding-system (read-coding-system
+			     (format "Coding system (%S): " coding-system)
+			     coding-system)))
+      (wl-mime-pgp-verify-region (car region) (cdr region) coding-system))))
 
 ;; XXX: encrypted multipart isn't represented as multipart
 (defun wl-mime-preview-application/pgp (parent-entity entity situation)
-  (require 'pgg)
   (goto-char (point-max))
   (let ((p (point))
 	raw-buf to-buf representation-type child-entity)
@@ -476,9 +660,7 @@ It calls following-method selected from variable
 	(when (progn
 		(goto-char (point-min))
 		(re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
-	  (pgg-decrypt-region (point-min)(point-max))
-	  (delete-region (point-min) (point-max))
-	  (insert-buffer pgg-output-buffer)
+	  (wl-mime-pgp-decrypt-region (point-min) (point-max) 'no-decode)
 	  (setq representation-type 'elmo-buffer))
 	(setq child-entity (mime-parse-message
 			    (mm-expand-class-name representation-type)
@@ -520,6 +702,7 @@ It calls following-method selected from variable
 	   (setq entity
 		 (car (mime-entity-children message-entity)))
 	   (with-temp-buffer
+	     (set-buffer-multibyte nil)
 	     (insert (mime-entity-body message-entity))
 	     (elmo-folder-append-buffer target))))
     number))
@@ -580,6 +763,44 @@ With ARG, ask destination folder."
       (setq wl-mime-save-directory (file-name-directory filename))
       (mime-write-entity-content entity filename))))
 
+(defun wl-summary-extract-attachments-1 (message-entity directory number)
+  ;; returns new number.
+  (let (children filename)
+    (cond
+     ((setq children (mime-entity-children message-entity))
+      (dolist (entity children)
+	(setq number
+	      (wl-summary-extract-attachments-1 entity directory number))))
+     ((and (eq (mime-content-disposition-type
+		(mime-entity-content-disposition message-entity))
+	       'attachment)
+	   (setq filename (mime-entity-safe-filename message-entity)))
+      (let ((full (expand-file-name filename directory)))
+	(when (or (not (file-exists-p full))
+		  (yes-or-no-p
+		   (format "File %s exists. Save anyway? " filename)))
+	  (message "Extracting...%s" (setq number (+ 1 number)))
+	  (mime-write-entity-content message-entity full)))))
+    number))
+
+(defun wl-summary-extract-attachments (directory)
+  "Extract attachment parts in MIME format into the DIRECTORY."
+  (interactive
+   (let* ((default (or wl-mime-save-directory
+		       wl-temporary-file-directory))
+	  (directory (read-directory-name "Extract to " default default t)))
+     (list (if (> (length directory) 0) directory default))))
+  (unless (and (file-writable-p directory)
+	       (file-directory-p directory))
+    (error "%s is not writable" directory))
+  (save-excursion
+    (wl-summary-set-message-buffer-or-redisplay)
+    (let ((entity (get-text-property (point-min) 'mime-view-entity)))
+      (when entity
+	(message "Extracting...")
+	(wl-summary-extract-attachments-1 entity directory 0)
+	(message "Extracting...done")))))
+
 ;;; Yet another combine method.
 (defun wl-mime-combine-message/partial-pieces (entity situation)
   "Internal method for wl to combine message/partial messages automatically."
@@ -602,11 +823,11 @@ With ARG, ask destination folder."
 	(with-current-buffer mother
 	  (mime-store-message/partial-piece entity situation)
 	  (setq wl-message-buffer-cur-summary-buffer summary-buf)
-	  (make-variable-buffer-local 'mime-preview-over-to-next-method-alist)
+	  (make-local-variable 'mime-preview-over-to-next-method-alist)
 	  (setq mime-preview-over-to-next-method-alist
 		(cons (cons 'mime-show-message-mode 'wl-message-exit)
 		      mime-preview-over-to-next-method-alist))
-	  (make-variable-buffer-local 'mime-preview-over-to-previous-method-alist)
+	  (make-local-variable 'mime-preview-over-to-previous-method-alist)
 	  (setq mime-preview-over-to-previous-method-alist
 		(cons (cons 'mime-show-message-mode 'wl-message-exit)
 		      mime-preview-over-to-previous-method-alist)))
@@ -621,7 +842,7 @@ With ARG, ask destination folder."
 	(elmo-folder-do-each-message-entity (entity folder)
 	  (when (string-match
 		 (regexp-quote subject-id)
-		 (elmo-message-entity-field entity 'subject 'decode))
+		 (elmo-message-entity-field entity 'subject))
 	    (let* ((message
 		    ;; request message at the cursor in Subject buffer.
 		    (wl-message-request-partial
@@ -658,7 +879,7 @@ With ARG, ask destination folder."
     (mime-decrypt-application/pgp-encrypted entity situation)
     (setq wl-message-buffer-cur-summary-buffer summary-buffer)
     (setq wl-message-buffer-original-buffer original-buffer)))
-   
+
 
 ;;; Setup methods.
 (defun wl-mime-setup ()
@@ -672,8 +893,9 @@ With ARG, ask destination folder."
 	     'wl-original-message-mode 'wl-message-exit)
   (set-alist 'mime-preview-over-to-next-method-alist
 	     'wl-original-message-mode 'wl-message-exit)
-  (add-hook 'wl-summary-redisplay-hook 'wl-message-delete-mime-out-buf)
-  (add-hook 'wl-message-exit-hook 'wl-message-delete-mime-out-buf)
+  (add-hook 'wl-summary-toggle-disp-off-hook 'wl-message-delete-popup-windows)
+  (add-hook 'wl-summary-redisplay-hook 'wl-message-delete-popup-windows)
+  (add-hook 'wl-message-exit-hook 'wl-message-delete-popup-windows)
 
   (ctree-set-calist-strictly
    'mime-preview-condition