The previous code did not correctly identify an old configuration and, as a consequence, broke new configurations. Minor re-arrangement to assist testing. --- emacs/notmuch-maildir-fcc.el | 107 +++++++++++++++++++++--------------------- 1 files changed, 53 insertions(+), 54 deletions(-) diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el index e5e0549..349c4d9 100644 --- a/emacs/notmuch-maildir-fcc.el +++ b/emacs/notmuch-maildir-fcc.el @@ -70,6 +70,31 @@ yet when sending a mail." ;; add a hook to actually insert the Fcc header when sending (add-hook 'message-header-setup-hook 'notmuch-fcc-header-setup)) +(defun notmuch-fcc-determine-folder (configuration from) + "Determine the correct folder to be used for Fcc." + + (cond + ((stringp configuration) + configuration) + + ((and (listp configuration) + (stringp (car configuration))) + ;; Old style - no longer works. + (error "Invalid Fcc configuration (old style)")) + + ((listp configuration) + (let ((match + (catch 'first-match + (dolist (re-folder configuration) + (when (string-match-p (car re-folder) from) + (throw 'first-match re-folder)))))) + (if match + (cdr match) + nil))) + + (t + (error "Invalid Fcc configuration (neither string nor list)")))) + (defun notmuch-fcc-header-setup () "Add an Fcc header to the current message buffer. @@ -77,63 +102,37 @@ 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." - (let ((subdir - (cond - ((or (not notmuch-fcc-dirs) - (message-fetch-field "Fcc")) - ;; Nothing set or an existing header. - nil) - - ((stringp notmuch-fcc-dirs) - notmuch-fcc-dirs) - - ((and (listp notmuch-fcc-dirs) - (= 1 (length (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")) - (match - (catch 'first-match - (dolist (re-folder notmuch-fcc-dirs) - (when (string-match-p (car re-folder) from) - (throw 'first-match re-folder)))))) - (if match - (cdr match) - (message "No Fcc header added.") - nil))) - - (t - (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)"))))) - - (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)))) - - ;; finally test if fcc points to a valid maildir - (let ((fcc-header (message-fetch-field "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")))))))) - + (when notmuch-fcc-dirs + (let* ((from (or (message-fetch-field "From") "")) + (subdir (notmuch-fcc-determine-folder notmuch-fcc-dirs from))) + + (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)))) + + ;; finally test if fcc points to a valid maildir + (let ((fcc-header (message-fetch-field "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"))))))))) + (defun notmuch-maildir-fcc-host-fixer (hostname) (replace-regexp-in-string "/\\|:" '(lambda (s) - (cond ((string-equal s "/") "\\057") - ((string-equal s ":") "\\072") - (t s))) + (cond ((string-equal s "/") "\\057") + ((string-equal s ":") "\\072") + (t s))) hostname t t)) -- 1.7.2.3