[PATCH v2 3/6] emacs: maildir import message-do-fcc

[Mark Walters]

We will need our own local copy of message-do-fcc so this commit just
copies the code straight from message.el so that it is easier to see
our local changes coming in the next commit.
---
 emacs/notmuch-maildir-fcc.el | 64 ++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch-mua.el         |  7 +++--
 2 files changed, 69 insertions(+), 2 deletions(-)

diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el
index 835258f..6fed11f 100644
--- a/emacs/notmuch-maildir-fcc.el
+++ b/emacs/notmuch-maildir-fcc.el
@@ -120,6 +120,70 @@ by notmuch-mua-mail"
 		subdir
 	      (concat (notmuch-database-path) "/" subdir))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions for saving a message either using notmuch insert or file
+;; fcc. First functions common to the two cases.
+
+(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))
+    (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))))))
+
 (defun notmuch-fcc-handler (fcc-header)
   "Store message with file fcc."
   (notmuch-maildir-fcc-file-fcc fcc-header))
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index f3a4e5a..61b029b 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -33,6 +33,7 @@
 (declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
 (declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
 (declare-function notmuch-fcc-handler "notmuch-maildir-fcc" (destdir))
+(declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
 
 ;;
 
@@ -491,12 +492,14 @@ will be addressed to all recipients of the source message."
 (defun notmuch-mua-send-and-exit (&optional arg)
   (interactive "P")
   (let ((message-fcc-handler-function #'notmuch-fcc-handler))
-    (message-send-and-exit arg)))
+    (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
+	  (message-send-and-exit arg))))
 
 (defun notmuch-mua-send (&optional arg)
   (interactive "P")
   (let ((message-fcc-handler-function #'notmuch-fcc-handler))
-    (message-send arg)))
+    (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
+	  (message-send arg))))
 
 (defun notmuch-mua-kill-buffer ()
   (interactive)
-- 
2.1.4