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
(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")
- last-coding-system-used)
-
- (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"))
- last-coding-system-used))
-
- (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"
(unless region
(error "Cannot find pgp encrypted region"))
(save-restriction
- (narrow-to-region (car region) (cdr region))
- (when (setq coding-system
- (wl-mime-pgp-decrypt-region (point-min) (point-max)))
- (put-text-property (point-min) (point-max)
- 'wl-mime-decoded-coding-system
- coding-system))))))
+ (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.
(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."
(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)
'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
projects / elisp / wanderlust.git / blobdiff