(require 'mime-view)
(require 'mime-edit)
(require 'mime-play)
+(require 'mime-parse)
+(eval-when-compile (require 'mmbuffer))
(require 'elmo)
+(require 'elmo-mime)
(require 'wl-vars)
+(require 'wl-util)
+(eval-when-compile (require 'cl))
;;; Draft
(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)
(cond
(setq min (point-min)
beg (re-search-forward "^$" nil t)
end (point-max)))
- (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-buffer-substring the-buf beg end)
(goto-char (point-min))
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)
(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)
(when wl-highlight-body-too
(wl-highlight-body))
(run-hooks 'wl-draft-preview-message-hook))
- (make-local-hook 'kill-buffer-hook)
+ (if (fboundp 'make-local-hook)
+ (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
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
(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"))
(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")
(eval-when-compile
(defmacro wl-define-dummy-functions (&rest symbols)
`(dolist (symbol (quote ,symbols))
- (defalias symbol 'ignore)))
+ (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
(elmo-with-progress-display (epg-decript nil reporter)
"Decrypting"
(epg-context-set-progress-callback context
- #'wl-epg-progress-callback
- reporter)
+ (cons #'wl-epg-progress-callback
+ reporter))
(insert (prog1
(decode-coding-string
(epg-decrypt-string
(elmo-with-progress-display (epg-verify nil reporter)
"Verifying"
(epg-context-set-progress-callback context
- #'wl-epg-progress-callback
- reporter)
+ (cons #'wl-epg-progress-callback
+ reporter))
(epg-verify-string
context
(encode-coding-string
(inhibit-read-only t)
coding-system)
(unless region
- (error "Cannot find pgp encrypted region"))
+ (error "Cannot find PGP encrypted region"))
(save-restriction
(let ((props (text-properties-at (car region))))
(narrow-to-region (car region) (cdr 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))
(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."
'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