emacs: make modifications to message Fcc vars buffer-local

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

diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el
index e5e0549be8e10248cd4587b67919e19e724bbc38..c2f2f4cb127db3d9f2c786b8c8236cffe558193e 100644 (file)
--- a/emacs/notmuch-maildir-fcc.el
+++ b/emacs/notmuch-maildir-fcc.el
@@ -51,36 +51,32 @@ the database.path option in the notmuch configuration file).
 You will be prompted to create the directory if it does not exist
 yet when sending a mail."
 
- :require 'notmuch-fcc-initialization
- :group 'notmuch
  :type '(choice
         (const :tag "No FCC header" nil)
         (string :tag "A single folder")
         (repeat :tag "A folder based on the From header"
-                (cons regexp (string :tag "Folder")))))
-
-(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))
+                (cons regexp (string :tag "Folder"))))
+ :require 'notmuch-fcc-initialization
+ :group 'notmuch-send)
+
+(defun notmuch-fcc-handler (destdir)
+  "Write buffer to `destdir', marking it as sent
+
+Intended to be dynamically bound to `message-fcc-handler-function'"
+    (notmuch-maildir-fcc-write-buffer-to-maildir destdir t))
 
 (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
          ((or (not notmuch-fcc-dirs)
-              (message-fetch-field "Fcc"))
+              (message-field-value "Fcc"))
           ;; Nothing set or an existing header.
           nil)
 
@@ -88,12 +84,12 @@ will NOT be removed or replaced."
           notmuch-fcc-dirs)
 
          ((and (listp notmuch-fcc-dirs)
-               (= 1 (length (car notmuch-fcc-dirs))))
+               (stringp (car notmuch-fcc-dirs)))
           ;; Old style - no longer works.
           (error "Invalid `notmuch-fcc-dirs' setting (old style)"))
 
          ((listp notmuch-fcc-dirs)
-          (let* ((from (message-fetch-field "From"))
+          (let* ((from (message-field-value "From"))
                  (match
                   (catch 'first-match
                     (dolist (re-folder notmuch-fcc-dirs)
@@ -110,14 +106,15 @@ will NOT be removed or replaced."
     (when subdir
       (message-add-header
        (concat "Fcc: "
-              ;; 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))))
+              (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-fetch-field "Fcc")))
+      (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"
@@ -130,22 +127,21 @@ will NOT be removed or replaced."
  
 (defun notmuch-maildir-fcc-host-fixer (hostname)
   (replace-regexp-in-string "/\\|:"
-                           '(lambda (s)
-                               (cond ((string-equal s "/") "\\057")
-                                     ((string-equal s ":") "\\072")
-                                     (t s)))
+                           (lambda (s)
+                             (cond ((string-equal s "/") "\\057")
+                                   ((string-equal s ":") "\\072")
+                                   (t s)))
                            hostname
                            t
                            t))
 
 (defun notmuch-maildir-fcc-make-uniq-maildir-id ()
-   (let* ((ct (current-time))
-         (timeid (+ (* (car ct) 65536) (cadr ct)))
-         (microseconds (car (cdr (cdr ct))))
+   (let* ((ftime (float-time))
+         (microseconds (mod (* 1000000 ftime) 1000000))
          (hostname (notmuch-maildir-fcc-host-fixer system-name)))
      (setq notmuch-maildir-fcc-count (+ notmuch-maildir-fcc-count 1))
      (format "%d.%d_%d_%d.%s"
-            timeid
+            ftime
             (emacs-pid)
             microseconds
             notmuch-maildir-fcc-count
@@ -162,7 +158,7 @@ will NOT be removed or replaced."
         (make-directory (concat path "/new/") t)
         (make-directory (concat path "/tmp/") t))
        ((file-regular-p path)
-        (error "%s is a file. Can't creat maildir." path))
+        (error "%s is a file. Can't create maildir." path))
        (t
         (error "I don't know how to create a maildir here"))))
 
@@ -213,6 +209,5 @@ return t if successful, and nil otherwise."
          (delete-file (concat destdir "/tmp/" msg-id))))
       t)))
 
-(notmuch-fcc-initialization)
 (provide 'notmuch-maildir-fcc)