Modify our local copy of message-do-fcc

Since we also need to use this code for the draft handling we split
message-do-fcc into convenient sub-chunks (functions or macros as
appropriate).
This commit is contained in:
Mark Walters 2016-09-03 23:59:42 +01:00 committed by David Bremner
parent aa1e8352de
commit cf59859b20

View file

@ -124,40 +124,53 @@ by notmuch-mua-mail"
;; Functions for saving a message either using notmuch insert or file ;; Functions for saving a message either using notmuch insert or file
;; fcc. First functions common to the two cases. ;; fcc. First functions common to the two cases.
(defun notmuch-maildir-message-do-fcc () (defmacro with-temporary-notmuch-message-buffer (&rest body)
"Process Fcc headers in the current buffer. "Set-up a temporary copy of the current message-mode buffer."
`(let ((case-fold-search t)
This is a rearranged version of message mode's message-do-fcc."
(let ((case-fold-search t)
(buf (current-buffer)) (buf (current-buffer))
list file
(mml-externalize-attachments message-fcc-externalize-attachments)) (mml-externalize-attachments message-fcc-externalize-attachments))
(save-excursion (with-current-buffer (get-buffer-create " *message temp*")
(save-restriction
(message-narrow-to-headers)
(setq file (message-fetch-field "fcc" t)))
(when file
(set-buffer (get-buffer-create " *message temp*"))
(erase-buffer) (erase-buffer)
(insert-buffer-substring buf) (insert-buffer-substring buf)
,@body)))
(defun notmuch-maildir-setup-message-for-saving ()
"Setup message for saving. Should be called on a temporary copy.
This is taken from the function message-do-fcc."
(message-encode-message-body) (message-encode-message-body)
(save-restriction (save-restriction
(message-narrow-to-headers) (message-narrow-to-headers)
(while (setq file (message-fetch-field "fcc" t))
(push file list)
(message-remove-header "fcc" nil t))
(let ((mail-parse-charset message-default-charset)) (let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer))) (mail-encode-encoded-word-buffer)))
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward (when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") (concat "^" (regexp-quote mail-header-separator) "$")
nil t) nil t)
(replace-match "" t t )) (replace-match "" t t )))
(defun notmuch-maildir-message-do-fcc ()
"Process Fcc headers in the current buffer.
This is a rearranged version of message mode's message-do-fcc."
(let (list file)
(save-excursion
(save-restriction
(message-narrow-to-headers)
(setq file (message-fetch-field "fcc" t)))
(when file
(with-temporary-notmuch-message-buffer
(save-restriction
(message-narrow-to-headers)
(while (setq file (message-fetch-field "fcc" t))
(push file list)
(message-remove-header "fcc" nil t)))
(notmuch-maildir-setup-message-for-saving)
;; Process FCC operations. ;; Process FCC operations.
(while list (while list
(setq file (pop list)) (setq file (pop list))
(notmuch-fcc-handler file)) (notmuch-fcc-handler file))
(kill-buffer (current-buffer)))))) (kill-buffer (current-buffer)))))))
(defun notmuch-fcc-handler (fcc-header) (defun notmuch-fcc-handler (fcc-header)
"Store message with file fcc." "Store message with file fcc."