+ (when (with-temp-buffer
+ (insert-buffer-substring orig-buf)
+ (delete-region header-start body-end)
+ (goto-char header-start)
+ (insert "Content-Type: text/plain; charset=US-ASCII\n")
+ (when filename
+ (insert
+ "Content-Disposition:"
+ (mime-encode-field-body
+ (concat ""
+ (and filename
+ (concat " inline; filename=" (std11-wrap-as-quoted-string filename))))
+ "Content-Disposition")
+ "\n"))
+ (insert "\n")
+ (insert "** This part has been removed by Wanderlust **\n\n")
+ (elmo-folder-append-buffer folder))
+
+ (elmo-folder-move-messages
+ folder (list number)
+ (wl-folder-get-elmo-folder wl-trash-folder))
+ (when (and (elmo-cache-get-path msgid)
+ (file-exists-p (elmo-cache-get-path msgid)))
+ (delete-file (elmo-cache-get-path msgid)))
+
+ (mime-preview-quit)
+ (wl-summary-delete-messages-on-buffer (list number))
+ (wl-summary-toggle-disp-msg 'off)
+ (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)))
+
+ (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)
+ (save-excursion
+ (beginning-of-line)
+ (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)
+ (let ((region (wl-find-region "^-+BEGIN PGP SIGNED MESSAGE-+$"
+ "^-+END PGP SIGNATURE-+$"))
+ coding-system)
+ (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)
+ (goto-char (point-max))
+ (let ((p (point))
+ raw-buf to-buf representation-type child-entity)
+ (goto-char p)
+ (save-restriction
+ (narrow-to-region p p)
+ (setq to-buf (current-buffer))
+ (with-temp-buffer
+ (setq raw-buf (current-buffer))
+ (mime-insert-entity entity)
+ (when (progn
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
+ (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)
+ nil
+ parent-entity
+ (mime-entity-node-id-internal parent-entity)))
+ (mime-display-entity
+ child-entity
+ nil
+ `((header . visible)
+ (body . visible)
+ (entity-button . invisible))
+ to-buf)))))
+
+(defun wl-mime-preview-application/pgp-encrypted (entity situation)
+ (let* ((entity-node-id (mime-entity-node-id entity))
+ (mother (mime-entity-parent entity))
+ (knum (car entity-node-id))
+ (onum (if (> knum 0)
+ (1- knum)
+ (1+ knum)))
+ (orig-entity (nth onum (mime-entity-children mother))))
+ (wl-mime-preview-application/pgp entity orig-entity situation)))