Modify our local copy of message-do-fcc

[notmuch] / emacs / notmuch-maildir-fcc.el

diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el
index 6fed11f28363fb6c589ba2e5b6c41a215f7da7ef..cda51e7f3d07072b0c9ecdb7e0669bac34155745 100644 (file)
--- a/emacs/notmuch-maildir-fcc.el
+++ b/emacs/notmuch-maildir-fcc.el
@@ -124,65 +124,53 @@ by notmuch-mua-mail"
 ;; Functions for saving a message either using notmuch insert or file
 ;; fcc. First functions common to the two cases.
 
+(defmacro with-temporary-notmuch-message-buffer (&rest body)
+  "Set-up a temporary copy of the current message-mode buffer."
+  `(let ((case-fold-search t)
+        (buf (current-buffer))
+        (mml-externalize-attachments message-fcc-externalize-attachments))
+     (with-current-buffer (get-buffer-create " *message temp*")
+       (erase-buffer)
+       (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)
+  (save-restriction
+    (message-narrow-to-headers)
+    (let ((mail-parse-charset message-default-charset))
+      (mail-encode-encoded-word-buffer)))
+  (goto-char (point-min))
+  (when (re-search-forward
+        (concat "^" (regexp-quote mail-header-separator) "$")
+        nil t)
+    (replace-match "" t t )))
+
 (defun notmuch-maildir-message-do-fcc ()
   "Process Fcc headers in the current buffer.
 
-This is a direct copy from message-mode's message-do-fcc."
-  (let ((case-fold-search t)
-       (buf (current-buffer))
-       list file
-       (mml-externalize-attachments message-fcc-externalize-attachments))
+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
-       (set-buffer (get-buffer-create " *message temp*"))
-       (erase-buffer)
-       (insert-buffer-substring buf)
-       (message-encode-message-body)
-       (save-restriction
-         (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)
-               (rfc2047-header-encoding-alist
-                (cons '("Newsgroups" . default)
-                      rfc2047-header-encoding-alist)))
-           (mail-encode-encoded-word-buffer)))
-       (goto-char (point-min))
-       (when (re-search-forward
-              (concat "^" (regexp-quote mail-header-separator) "$")
-              nil t)
-         (replace-match "" t t ))
-       ;; Process FCC operations.
-       (while list
-         (setq file (pop list))
-         (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
-             ;; Pipe the article to the program in question.
-             (call-process-region (point-min) (point-max) shell-file-name
-                                  nil nil nil shell-command-switch
-                                  (match-string 1 file))
-           ;; Save the article.
-           (setq file (expand-file-name file))
-           (unless (file-exists-p (file-name-directory file))
-             (make-directory (file-name-directory file) t))
-           (if (and message-fcc-handler-function
-                    (not (eq message-fcc-handler-function 'rmail-output)))
-               (funcall message-fcc-handler-function file)
-             ;; FIXME this option, rmail-output (also used if
-             ;; message-fcc-handler-function is nil) is not
-             ;; documented anywhere AFAICS.  It should work in Emacs
-             ;; 23; I suspect it does not work in Emacs 22.
-             ;; FIXME I don't see the need for the two different cases here.
-             ;; mail-use-rfc822 makes no difference (in Emacs 23),and
-             ;; the third argument just controls \"Wrote file\" message.
-             (if (and (file-readable-p file) (mail-file-babyl-p file))
-                 (rmail-output file 1 nil t)
-               (let ((mail-use-rfc822 t))
-                 (rmail-output file 1 t t))))))
-       (kill-buffer (current-buffer))))))
+       (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.
+        (while list
+          (setq file (pop list))
+          (notmuch-fcc-handler file))
+        (kill-buffer (current-buffer)))))))
 
 (defun notmuch-fcc-handler (fcc-header)
   "Store message with file fcc."