X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-maildir-fcc.el;h=835258f87b962992d96fa7e7cc0d78bc1d7eb97c;hb=37859d1fcb1ad661666dbdb95372becaa98d46cb;hp=07eedba22a33a28ae802f260781c3fbfdeeca582;hpb=d094153a264a69bc560366198a0febfa96c1ceb5;p=notmuch

diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el
index 07eedba2..835258f8 100644
--- a/emacs/notmuch-maildir-fcc.el
+++ b/emacs/notmuch-maildir-fcc.el
@@ -1,3 +1,5 @@
+;;; notmuch-maildir-fcc.el ---
+
 ;; This file is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published
 ;; by the Free Software Foundation; either version 2, or (at your
@@ -12,10 +14,14 @@
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;; Boston, MA 02110-1301, USA.
-;;
+
+;;; Commentary:
+
 ;; To use this as the fcc handler for message-mode,
 ;; customize the notmuch-fcc-dirs variable
 
+;;; Code:
+
 (eval-when-compile (require 'cl))
 (require 'message)
 
@@ -59,23 +65,17 @@ yet when sending a mail."
  :require 'notmuch-fcc-initialization
  :group 'notmuch-send)
 
-(defun notmuch-fcc-initialization ()
-  "If notmuch-fcc-directories is set,
-   hook them into the message-fcc-handler-function"
-    ;; Set up the message-fcc-handler to move mails to the maildir in Fcc
-    ;; The parameter is set to mark messages as "seen"
-    (setq message-fcc-handler-function
-          (lambda (destdir)
-	    (notmuch-maildir-fcc-write-buffer-to-maildir destdir t)))
-    ;; add a hook to actually insert the Fcc header when sending
-    (add-hook 'message-header-setup-hook 'notmuch-fcc-header-setup))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions which set up the fcc header in the message buffer.
 
 (defun notmuch-fcc-header-setup ()
   "Add an Fcc header to the current message buffer.
 
-Can be added to `message-send-hook' and will set the Fcc header
-based on the values of `notmuch-fcc-dirs'. An existing Fcc header
-will NOT be removed or replaced."
+Sets the Fcc header based on the values of `notmuch-fcc-dirs'.
+
+Originally intended to be use a hook function, but now called directly
+by notmuch-mua-mail"
 
   (let ((subdir
 	 (cond
@@ -108,27 +108,25 @@ will NOT be removed or replaced."
 	   (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))
 
     (when subdir
-      (message-add-header
-       (concat "Fcc: "
-	       (file-truename
-		;; If the resulting directory is not an absolute path,
-		;; prepend the standard notmuch database path.
-		(if (= (elt subdir 0) ?/)
-		    subdir
-		  (concat (notmuch-database-path) "/" subdir)))))
-      
-      ;; finally test if fcc points to a valid maildir
-      (let ((fcc-header (message-field-value "Fcc")))
-	(unless (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)
-	  (cond ((not (file-writable-p fcc-header))
-		 (error (format "No permission to create %s, which does not exist"
-				fcc-header)))
-		((y-or-n-p (format "%s is not a maildir. Create it? "
-				   fcc-header))
-		 (notmuch-maildir-fcc-create-maildir fcc-header))
-		(t
-		 (error "Message not sent"))))))))
- 
+      (notmuch-maildir-add-file-style-fcc-header subdir))))
+
+(defun notmuch-maildir-add-file-style-fcc-header (subdir)
+  (message-add-header
+   (concat "Fcc: "
+	   (file-truename
+	    ;; If the resulting directory is not an absolute path,
+	    ;; prepend the standard notmuch database path.
+	    (if (= (elt subdir 0) ?/)
+		subdir
+	      (concat (notmuch-database-path) "/" subdir))))))
+
+(defun notmuch-fcc-handler (fcc-header)
+  "Store message with file fcc."
+  (notmuch-maildir-fcc-file-fcc fcc-header))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions for saving a message using file fcc.
+
 (defun notmuch-maildir-fcc-host-fixer (hostname)
   (replace-regexp-in-string "/\\|:"
 			    (lambda (s)
@@ -190,6 +188,29 @@ if successful, nil if not."
    (concat destdir "/tmp/" msg-id)
    (concat destdir "/cur/" msg-id ":2," (when mark-seen "S"))))
 
+(defun notmuch-maildir-fcc-file-fcc (fcc-header)
+  "Write the message to the file specified by FCC-HEADER.
+
+It offers the user a chance to correct the header, or filesystem,
+if needed."
+  (if (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)
+      (notmuch-maildir-fcc-write-buffer-to-maildir fcc-header 't)
+    ;; The fcc-header is not a valid maildir see if the user wants to
+    ;; fix it in some way.
+    (let* ((prompt (format "Fcc %s is not a maildir: (r)etry, (c)reate folder, (i)gnore, or  (e)dit the header? "
+			   fcc-header))
+	    (response (read-char-choice prompt '(?r ?c ?i ?e))))
+	 (case response
+	       (?r (notmuch-maildir-fcc-file-fcc fcc-header))
+	       (?c (if (file-writable-p fcc-header)
+		       (notmuch-maildir-fcc-create-maildir fcc-header)
+		     (message "No permission to create %s." fcc-header)
+		     (sit-for 2))
+		   (notmuch-maildir-fcc-file-fcc fcc-header))
+	       (?i 't)
+	       (?e (notmuch-maildir-fcc-file-fcc
+		    (read-from-minibuffer "Fcc header: " fcc-header)))))))
+
 (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen)
   "Writes the current buffer to maildir destdir. If mark-seen is
 non-nil, it will write it to cur/, and mark it as read. It should
@@ -213,6 +234,6 @@ return t if successful, and nil otherwise."
 	  (delete-file (concat destdir "/tmp/" msg-id))))
       t)))
 
-(notmuch-fcc-initialization)
 (provide 'notmuch-maildir-fcc)
 
+;;; notmuch-maildir-fcc.el ends here