From 177589372092a51073b880d9ae79ea3909563d17 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Mon, 26 Apr 2010 10:23:15 +0200 Subject: [PATCH] Add elisp file for FCC to maildir solution File grabbed from http://jkr.acm.jhu.edu/jkr-maildir.el but not integrated yet. Signed-off-by: Sebastian Spaeth --- emacs/notmuch-maildir-fcc.el | 115 +++++++++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) 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 00000000..979428e4 --- /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 -- 2.43.0