X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;ds=sidebyside;f=emacs%2Fnotmuch-maildir-fcc.el;h=835258f87b962992d96fa7e7cc0d78bc1d7eb97c;hb=37859d1fcb1ad661666dbdb95372becaa98d46cb;hp=c2f2f4cb127db3d9f2c786b8c8236cffe558193e;hpb=d0553ad524f241ba42f685cba6745c8a3a9ba20a;p=notmuch diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el index c2f2f4cb..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,11 +65,9 @@ yet when sending a mail." :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)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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. @@ -104,27 +108,25 @@ by notmuch-mua-mail" (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) @@ -186,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 @@ -211,3 +236,4 @@ return t if successful, and nil otherwise." (provide 'notmuch-maildir-fcc) +;;; notmuch-maildir-fcc.el ends here