X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-mime.el;h=540f87d14e742b4d70637a5ea5fac548a612a6c5;hb=acd82f4cf41e83cb2aab45ece9ff29842c6574b1;hp=a991ba3f3850992651af677f154020146176e451;hpb=db0560e0ba5f6dde7e73751df30ef16e8ae8f854;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-mime.el b/wl/wl-mime.el
index a991ba3..540f87d 100644
--- a/wl/wl-mime.el
+++ b/wl/wl-mime.el
@@ -33,6 +33,7 @@
 (require 'mime-play)
 (require 'elmo)
 (require 'wl-vars)
+(eval-when-compile (require 'cl))
 
 ;;; Draft
 
@@ -385,11 +386,15 @@ 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
@@ -445,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")
@@ -476,89 +481,140 @@ It calls following-method selected from variable
 	  (wl-summary-sync nil "update"))))))
 
 ;; PGP
-(static-cond
- ((require 'epg nil t)
-  (defun wl-mime-pgp-decrypt-region (beg end &optional no-decode)
-    (require 'epg)
-    (message "Decrypting...")
-    (insert (prog1
-		(decode-coding-string
-		 (epg-decrypt-string
-		  (epg-make-context)
-		  (buffer-substring beg end))
-		 (if no-decode 'raw-text wl-cs-autoconv))
-	      (delete-region beg end)))
-    (message "Decrypting...done"))
-
-  (defun wl-mime-pgp-verify-region (beg end &optional coding-system)
-    (require 'epg)
-    (let ((context (epg-make-context)))
-      (message "Verifying...")
+(eval-when-compile
+  (defmacro wl-define-dummy-functions (&rest symbols)
+    `(dolist (symbol (quote ,symbols))
+       (defalias symbol 'ignore)))
+
+  (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)))
-      (message "Verifying...done")
-      (when (epg-context-result-for context 'verify)
-	(epa-display-verify-result
-	 (epg-context-result-for context 'verify))))))
-
- ((require 'pgg nil t)
-  (defun wl-mime-pgp-decrypt-region (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"))))
-
-  (defun wl-mime-pgp-verify-region (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)))))
- (t
-  (defun wl-mime-pgp-decrypt-region (beg end &optional no-decode)
-    (error "Does not support PGP decryption"))
-
-  (defun wl-mime-pgp-verify-region (beg end &optional coding-system)
-    (error "Does not support PGP verification"))))
+	  '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)
   (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))
-		(wl-mime-pgp-decrypt-region beg end))
-	    (message "Cannot find pgp encrypted region")))
-      (message "Cannot find pgp encrypted region"))))
+    (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.
@@ -566,16 +622,12 @@ With ARG, ask coding system and encode the region with it before verifying."
   (interactive "P")
   (save-excursion
     (beginning-of-line)
-    (let ((message-buffer (current-buffer))
-	  beg end coding-system success)
-      (setq end (and (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)
-			 (re-search-backward "^-+END PGP SIGNATURE-+$" nil t)
-			 (error "Cannot find pgp signed region"))
-		     (match-end 0)))
-      (setq beg (or (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
-		    (error "Cannot find pgp signed region")))
+    (let ((region (wl-find-region "^-+BEGIN PGP SIGNED MESSAGE-+$"
+				  "^-+END PGP SIGNATURE-+$"))
+	  coding-system)
       (setq coding-system
-	    (or (let* ((situation (mime-preview-find-boundary-info))
+	    (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
@@ -586,7 +638,7 @@ With ARG, ask coding system and encode the region with it before verifying."
 	(setq coding-system (read-coding-system
 			     (format "Coding system (%S): " coding-system)
 			     coding-system)))
-      (wl-mime-pgp-verify-region beg end 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)
@@ -706,6 +758,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."
@@ -776,6 +866,8 @@ With ARG, ask destination folder."
 	(elmo-message-visible-field-list wl-message-visible-field-list)
 	(elmo-message-sorted-field-list wl-message-sort-field-list))
     (elmo-mime-insert-header entity situation)
+    (goto-char (point-min))
+    (delete-matching-lines "^$")
     (wl-highlight-headers)))
 
 (defun wl-mime-decrypt-application/pgp-encrypted (entity situation)
@@ -798,8 +890,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