1 ;; This file is free software; you can redistribute it and/or modify
2 ;; it under the terms of the GNU General Public License as published
3 ;; by the Free Software Foundation; either version 2, or (at your
4 ;; option) any later version.
6 ;; This program is distributed in the hope that it will be useful,
7 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
8 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9 ;; GNU General Public License for more details.
11 ;; You should have received a copy of the GNU General Public License
12 ;; along with GNU Emacs; see the file COPYING. If not, write to the
13 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
14 ;; Boston, MA 02110-1301, USA.
18 ;; This is the beginning of a solution for storing sent mail in a
19 ;; maildir in emacs message mode, presented because some people might
20 ;; find it useful. It is *not* fully tested, it *may* overwrite files,
21 ;; and any directories you point this at may no longer be there
22 ;; afterwards. Use at your own risk.
24 ;; To use this as the fcc handler for message-mode, put
25 ;; one of the following in your init file:
27 ;; if you want Fcc'd messages to be marked as read:
29 ;; (setq message-fcc-handler-function
31 ;; (jkr/maildir-write-buffer-to-maildir destdir t)))
33 ;; if you want Fcc'd messages to be marked as new:
35 ;; (setq message-fcc-handler-function
37 ;; (jkr/maildir-write-buffer-to-maildir destdir nil)))
40 (defvar jkr/maildir-count 0)
42 (defun jkr/maildir-host-fixer (hostname)
43 (replace-regexp-in-string "/\\|:"
45 (cond ((string-equal s "/") "\\057")
46 ((string-equal s ":") "\\072")
52 (defun jkr/maildir-make-uniq-maildir-id ()
53 (let* ((ct (current-time))
54 (timeid (+ (* (car ct) 65536) (cadr ct)))
55 (microseconds (caddr ct))
56 (hostname (jkr/maildir-host-fixer system-name)))
57 (setq jkr/maildir-count (+ jkr/maildir-count 1))
58 (format "%d.%d_%d_%d.%s"
65 (defun jkr/maildir-dir-is-maildir-p (dir)
66 (and (file-exists-p (concat dir "/cur/"))
67 (file-exists-p (concat dir "/new/"))
68 (file-exists-p (concat dir "/tmp/"))))
70 (defun jkr/maildir-save-buffer-to-tmp (destdir)
71 "Returns the msg id of the message written to the temp directory
72 if successful, nil if not."
73 (let ((msg-id (jkr/maildir-make-uniq-maildir-id)))
74 (while (file-exists-p (concat destdir "/tmp/" msg-id))
75 (setq msg-id (jkr/maildir-make-uniq-maildir-id)))
76 (cond ((jkr/maildir-dir-is-maildir-p destdir)
77 (write-file (concat destdir "/tmp/" msg-id))
80 (message (format "Can't write to %s. Not a maildir."
84 (defun jkr/maildir-move-tmp-to-new (destdir msg-id)
86 (concat destdir "/tmp/" msg-id)
87 (concat destdir "/new/" msg-id ":2,")))
89 (defun jkr/maildir-move-tmp-to-cur (destdir msg-id &optional mark-seen)
91 (concat destdir "/tmp/" msg-id)
92 (concat destdir "/cur/" msg-id ":2," (when mark-seen "S"))))
94 (defun jkr/maildir-write-buffer-to-maildir (destdir &optional mark-seen)
95 "Writes the current buffer to maildir destdir. If mark-seen is
96 non-nil, it will write it to cur/, and mark it as read. It should
97 return t if successful, and nil otherwise."
98 (let ((orig-buffer (buffer-name)))
100 (insert-buffer orig-buffer)
102 (let ((msg-id (jkr/maildir-save-buffer-to-tmp destdir)))
106 (jkr/maildir-move-tmp-to-cur destdir msg-id t)
108 (throw 'link-error nil))))
111 (jkr/maildir-move-tmp-to-new destdir msg-id)
113 (throw 'link-error nil))))))
114 (delete-file (concat destdir "/tmp/" msg-id))))