X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-maildir-fcc.el;h=34b19154ac94995d7ab7098251724c308e876107;hp=979428e44e616dddbcbe46d6cdc7eea97e351116;hb=9b85872ed4526688a6195cfa8af19be20ed869c2;hpb=177589372092a51073b880d9ae79ea3909563d17 diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el index 979428e4..34b19154 100644 --- a/emacs/notmuch-maildir-fcc.el +++ b/emacs/notmuch-maildir-fcc.el @@ -12,104 +12,144 @@ ;; 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: -;; -;; This is the beginning of a solution for storing sent mail in a -;; maildir in emacs message mode, presented because some people might -;; find it useful. It is *not* fully tested, it *may* overwrite files, -;; and any directories you point this at may no longer be there -;; afterwards. Use at your own risk. -;; -;; To use this as the fcc handler for message-mode, put -;; one of the following in your init file: -;; -;; if you want Fcc'd messages to be marked as read: ;; -;; (setq message-fcc-handler-function -;; '(lambda (destdir) -;; (jkr/maildir-write-buffer-to-maildir destdir t))) -;; -;; if you want Fcc'd messages to be marked as new: -;; -;; (setq message-fcc-handler-function -;; '(lambda (destdir) -;; (jkr/maildir-write-buffer-to-maildir destdir nil))) +;; To use this as the fcc handler for message-mode, +;; customize the notmuch-fcc-dirs variable + +(require 'message) +(defvar notmuch-maildir-fcc-count 0) -(defvar jkr/maildir-count 0) +(defcustom notmuch-fcc-dirs nil + "If set to non-nil, this will cause message mode to file (fcc) your mail in the specified directory, depending on your From address. -(defun jkr/maildir-host-fixer (hostname) + The first entry (a list) is used as a default fallback + when nothing matches. So in the easiest case notmuch-fcc-dirs is + just something like ((\"INBOX.Sent\")) + + If you need a more fancy setup, where you want different Outboxes depending + on your From address, you use something like this: + + ( (\"defaultinbox\") + (\"Sebastian Spaeth \" . \"privat\") + (\"Sebastian Spaeth \" . \"uni\") + ) + + This will constructs a path, concatenating the content of the + variable 'message-directory' (a message mode variable + customizable via m-x + customize-variablemessage-directory) and the second + part in the alist." + :require 'notmuch-fcc-initialization + :group 'notmuch +) + +(defun notmuch-fcc-initialization () + "If notmuch-fcc-directories is set, + hook them into the message-fcc-handler-function" +(if (not (eq notmuch-fcc-dirs nil)) (progn + ;Set up the message-fcc-handler to move mails to the maildir in Fcc + ;The parameter is hardcoded 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 + ;(preferrably we would use message-header-setup-up, but notmuch-reply + ; munges headers after that is run, so it won't work for replies within + ; notmuch) + (add-hook 'message-send-hook 'notmuch-fcc-header-setup)))) + +(defun notmuch-fcc-header-setup () + "Can be added to message-send-hook and will set the FCC header + based on the values of notmuch-fcc-directories (see the + variable customization there for examples). It uses the + first entry as default fallback if no From address + matches." + ; only do something if notmuch-fcc-dirs is set + (if notmuch-fcc-dirs + (let ((subdir + (cdr (assoc-string (message-fetch-field "from") notmuch-fcc-dirs t)))) + (if (eq subdir nil) (setq subdir (car (car notmuch-fcc-dirs)))) + (unless (message-fetch-field "fcc") + (message-add-header (concat "Fcc: " message-directory subdir))) + (unless (notmuch-maildir-fcc-dir-is-maildir-p + (message-fetch-field "fcc")) + (error (format "%s is not a maildir." (message-fetch-field "fcc"))))))) + +(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)) -(defun jkr/maildir-make-uniq-maildir-id () +(defun notmuch-maildir-fcc-make-uniq-maildir-id () (let* ((ct (current-time)) (timeid (+ (* (car ct) 65536) (cadr ct))) - (microseconds (caddr ct)) - (hostname (jkr/maildir-host-fixer system-name))) - (setq jkr/maildir-count (+ jkr/maildir-count 1)) + (microseconds (car (cdr (cdr ct)))) + (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 (emacs-pid) microseconds - jkr/maildir-count + notmuch-maildir-fcc-count hostname))) -(defun jkr/maildir-dir-is-maildir-p (dir) +(defun notmuch-maildir-fcc-dir-is-maildir-p (dir) (and (file-exists-p (concat dir "/cur/")) (file-exists-p (concat dir "/new/")) (file-exists-p (concat dir "/tmp/")))) -(defun jkr/maildir-save-buffer-to-tmp (destdir) +(defun notmuch-maildir-fcc-save-buffer-to-tmp (destdir) "Returns the msg id of the message written to the temp directory if successful, nil if not." - (let ((msg-id (jkr/maildir-make-uniq-maildir-id))) + (let ((msg-id (notmuch-maildir-fcc-make-uniq-maildir-id))) (while (file-exists-p (concat destdir "/tmp/" msg-id)) - (setq msg-id (jkr/maildir-make-uniq-maildir-id))) - (cond ((jkr/maildir-dir-is-maildir-p destdir) + (setq msg-id (notmuch-maildir-fcc-make-uniq-maildir-id))) + (cond ((notmuch-maildir-fcc-dir-is-maildir-p destdir) (write-file (concat destdir "/tmp/" msg-id)) msg-id) (t - (message (format "Can't write to %s. Not a maildir." - destdir)) + (error (format "Can't write to %s. Not a maildir." + destdir)) nil)))) -(defun jkr/maildir-move-tmp-to-new (destdir msg-id) +(defun notmuch-maildir-fcc-move-tmp-to-new (destdir msg-id) (add-name-to-file (concat destdir "/tmp/" msg-id) (concat destdir "/new/" msg-id ":2,"))) -(defun jkr/maildir-move-tmp-to-cur (destdir msg-id &optional mark-seen) +(defun notmuch-maildir-fcc-move-tmp-to-cur (destdir msg-id &optional mark-seen) (add-name-to-file (concat destdir "/tmp/" msg-id) (concat destdir "/cur/" msg-id ":2," (when mark-seen "S")))) -(defun jkr/maildir-write-buffer-to-maildir (destdir &optional mark-seen) +(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 return t if successful, and nil otherwise." (let ((orig-buffer (buffer-name))) (with-temp-buffer - (insert-buffer orig-buffer) + (insert-buffer-substring orig-buffer) (catch 'link-error - (let ((msg-id (jkr/maildir-save-buffer-to-tmp destdir))) + (let ((msg-id (notmuch-maildir-fcc-save-buffer-to-tmp destdir))) (when msg-id (cond (mark-seen (condition-case err - (jkr/maildir-move-tmp-to-cur destdir msg-id t) + (notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t) (file-already-exists (throw 'link-error nil)))) (t (condition-case err - (jkr/maildir-move-tmp-to-new destdir msg-id) + (notmuch-maildir-fcc-move-tmp-to-new destdir msg-id) (file-already-exists (throw 'link-error nil)))))) (delete-file (concat destdir "/tmp/" msg-id)))) - t))) \ No newline at end of file + t))) + +(notmuch-fcc-initialization) +(provide 'notmuch-maildir-fcc)