From: Sebastian Spaeth <Sebastian@SSpaeth.de>
To: Notmuch developer list <notmuch@notmuchmail.org>
Subject: [PATCH 1/4] Add elisp file for FCC to maildir solution
Date: Fri, 23 Apr 2010 21:01:08 +0200
Message-Id: <1272049271-20049-1-git-send-email-Sebastian@SSpaeth.de>
In-Reply-To: <m37hny5kuy.fsf@x200.gr8dns.org>
References: <m37hny5kuy.fsf@x200.gr8dns.org>
Precedence: list

From: Jesse Rosenthal <jrosenthal@jhu.edu>

File grabbed from http://jkr.acm.jhu.edu/jkr-maildir.el
but not integrated yet.

Signed-off-by: Sebastian Spaeth <Sebastian@SSpaeth.de>
---
As stated by Dirk, patches are preferred by mail. So here is the updated 
patch series of 4 patches by mail again.

 emacs/notmuch-maildir-fcc.el |  115 ++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 115 insertions(+), 0 deletions(-)
 create mode 100644 emacs/notmuch-maildir-fcc.el

diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el
new file mode 100644
index 0000000..979428e
--- /dev/null
+++ b/emacs/notmuch-maildir-fcc.el
@@ -0,0 +1,115 @@
+;; 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
+;; option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; 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)))
+
+
+(defvar jkr/maildir-count 0)
+
+(defun jkr/maildir-host-fixer (hostname)
+  (replace-regexp-in-string "/\\|:"
+			    '(lambda (s)
+			         (cond ((string-equal s "/") "\\057")
+				       ((string-equal s ":") "\\072")
+				       (t s)))
+			    hostname
+			    t
+			    t))
+
+(defun jkr/maildir-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))
+     (format "%d.%d_%d_%d.%s"
+	     timeid
+	     (emacs-pid)
+	     microseconds
+	     jkr/maildir-count
+	     hostname)))
+
+(defun jkr/maildir-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)
+  "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)))
+    (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)
+	   (write-file (concat destdir "/tmp/" msg-id))
+	   msg-id)
+	  (t
+	   (message (format "Can't write to %s. Not a maildir."
+		     destdir))
+	   nil))))
+
+(defun jkr/maildir-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)
+  (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)
+  "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)
+      (catch 'link-error
+	(let ((msg-id (jkr/maildir-save-buffer-to-tmp destdir)))
+	  (when msg-id
+	    (cond (mark-seen
+		   (condition-case err
+		       (jkr/maildir-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)
+		     (file-already-exists
+		      (throw 'link-error nil))))))
+	  (delete-file (concat destdir "/tmp/" msg-id))))
+      t)))
\ No newline at end of file
-- 
1.7.0.4