13/0881d9ee6060840301adbd9eca3513a1cd6b30

   1 Return-Path: <Sebastian@SSpaeth.de>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 4EF9D4196F2\r
   6         for <notmuch@notmuchmail.org>; Thu, 22 Apr 2010 02:07:47 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -1.9\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
  12         tests=[BAYES_00=-1.9] autolearn=ham\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id pHeYuH9TExiE for <notmuch@notmuchmail.org>;\r
  16         Thu, 22 Apr 2010 02:07:46 -0700 (PDT)\r
  17 Received: from homiemail-a13.g.dreamhost.com (caiajhbdcahe.dreamhost.com\r
  18         [208.97.132.74])\r
  19         by olra.theworths.org (Postfix) with ESMTP id 3E304431FC1\r
  20         for <notmuch@notmuchmail.org>; Thu, 22 Apr 2010 02:07:46 -0700 (PDT)\r
  21 Received: from localhost.localdomain (mtec-hg-docking-1-dhcp-204.ethz.ch\r
  22         [129.132.133.204]) (Authenticated sender: sebastian@sspaeth.de)\r
  23         by homiemail-a13.g.dreamhost.com (Postfix) with ESMTPA id C32A76A8058; \r
  24         Thu, 22 Apr 2010 02:07:35 -0700 (PDT)\r
  25 From: Sebastian Spaeth <Sebastian@SSpaeth.de>\r
  26 To: Notmuch developer list <notmuch@notmuchmail.org>\r
  27 Subject: [PATCH 1/6] Add elisp file for FCC to maildir solution\r
  28 Date: Thu, 22 Apr 2010 11:07:25 +0200\r
  29 Message-Id: <1271927251-19867-1-git-send-email-Sebastian@SSpaeth.de>\r
  30 X-Mailer: git-send-email 1.7.0.4\r
  31 In-Reply-To: <87ochbx3er.fsf@SSpaeth.de>\r
  32 References: <87ochbx3er.fsf@SSpaeth.de>\r
  33 X-BeenThere: notmuch@notmuchmail.org\r
  34 X-Mailman-Version: 2.1.13\r
  35 Precedence: list\r
  36 List-Id: "Use and development of the notmuch mail system."\r
  37         <notmuch.notmuchmail.org>\r
  38 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  39         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  40 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  41 List-Post: <mailto:notmuch@notmuchmail.org>\r
  42 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  43 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  44         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  45 X-List-Received-Date: Thu, 22 Apr 2010 09:07:47 -0000\r
  46 \r
  47 From: Jesse Rosenthal <jrosenthal@jhu.edu>\r
  48 \r
  49 File grabbed from http://jkr.acm.jhu.edu/jkr-maildir.el\r
  50 but not integrated yet.\r
  51 \r
  52 Signed-off-by: Sebastian Spaeth <Sebastian@SSpaeth.de>\r
  53 ---\r
  54  emacs/notmuch-maildir-fcc.el |  115 ++++++++++++++++++++++++++++++++++++++++++\r
  55  1 files changed, 115 insertions(+), 0 deletions(-)\r
  56  create mode 100644 emacs/notmuch-maildir-fcc.el\r
  57 \r
  58 diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el\r
  59 new file mode 100644\r
  60 index 0000000..e7fddf1\r
  61 --- /dev/null\r
  62 +++ b/emacs/notmuch-maildir-fcc.el\r
  63 @@ -0,0 +1,115 @@\r
  64 +;; This file is free software; you can redistribute it and/or modify\r
  65 +;; it under the terms of the GNU General Public License as published\r
  66 +;; by the Free Software Foundation; either version 2, or (at your\r
  67 +;; option) any later version.\r
  68 +\r
  69 +;; This program is distributed in the hope that it will be useful,\r
  70 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
  71 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
  72 +;; GNU General Public License for more details.\r
  73 +\r
  74 +;; You should have received a copy of the GNU General Public License\r
  75 +;; along with GNU Emacs; see the file COPYING.  If not, write to the\r
  76 +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,\r
  77 +;; Boston, MA 02110-1301, USA.\r
  78 +\r
  79 +;; Commentary: \r
  80 +;;\r
  81 +;; This is the beginning of a solution for storing sent mail in a\r
  82 +;; maildir in emacs message mode, presented because some people might\r
  83 +;; find it useful. It is *not* fully tested, it *may* overwrite files,\r
  84 +;; and any directories you point this at may no longer be there\r
  85 +;; afterwards. Use at your own risk.\r
  86 +;;\r
  87 +;; To use this as the fcc handler for message-mode, put\r
  88 +;; one of the following in your init file:\r
  89 +;; \r
  90 +;; if you want Fcc'd messages to be marked as read:\r
  91 +;;\r
  92 +;;     (setq message-fcc-handler-function \r
  93 +;;          '(lambda (destdir) \r
  94 +;;          (jkr/maildir-write-buffer-to-maildir destdir t)))\r
  95 +;;\r
  96 +;; if you want Fcc'd messages to be marked as new:\r
  97 +;;\r
  98 +;;     (setq message-fcc-handler-function \r
  99 +;;          '(lambda (destdir) \r
 100 +;;          (jkr/maildir-write-buffer-to-maildir destdir nil)))\r
 101 +\r
 102 +\r
 103 +(defvar jkr/maildir-count 0)\r
 104 +\r
 105 +(defun jkr/maildir-host-fixer (hostname)\r
 106 +  (replace-regexp-in-string "/\\|:"\r
 107 +                           '(lambda (s)\r
 108 +                                (cond ((string-equal s "/") "\\057")\r
 109 +                                      ((string-equal s ":") "\\072")\r
 110 +                                      (t s)))\r
 111 +                           hostname\r
 112 +                           t\r
 113 +                           t))\r
 114 +\r
 115 +(defun jkr/maildir-make-uniq-maildir-id ()\r
 116 +   (let* ((ct (current-time))\r
 117 +         (timeid (+ (* (car ct) 65536) (cadr ct)))\r
 118 +         (microseconds (caddr ct))\r
 119 +         (hostname (jkr/maildir-host-fixer system-name)))\r
 120 +     (setq jkr/maildir-count (+ jkr/maildir-count 1))\r
 121 +     (format "%d.%d_%d_%d.%s"\r
 122 +            timeid\r
 123 +            (emacs-pid)\r
 124 +            microseconds\r
 125 +            jkr/maildir-count\r
 126 +            hostname)))\r
 127 +\r
 128 +(defun jkr/maildir-dir-is-maildir-p (dir)\r
 129 +  (and (file-exists-p (concat dir "/cur/"))\r
 130 +       (file-exists-p (concat dir "/new/"))\r
 131 +       (file-exists-p (concat dir "/tmp/"))))\r
 132 +\r
 133 +(defun jkr/maildir-save-buffer-to-tmp (destdir)\r
 134 +  "Returns the msg id of the message written to the temp directory\r
 135 +if successful, nil if not."\r
 136 +  (let ((msg-id (jkr/maildir-make-uniq-maildir-id)))\r
 137 +    (while (file-exists-p (concat destdir "/tmp/" msg-id))\r
 138 +      (setq msg-id (jkr/maildir-make-uniq-maildir-id)))\r
 139 +    (cond ((jkr/maildir-dir-is-maildir-p destdir)\r
 140 +          (write-file (concat destdir "/tmp/" msg-id))\r
 141 +          msg-id)\r
 142 +         (t\r
 143 +          (message (format "Can't write to %s. Not a maildir."  \r
 144 +                    destdir))\r
 145 +          nil))))\r
 146 +\r
 147 +(defun jkr/maildir-move-tmp-to-new (destdir msg-id)\r
 148 +  (add-name-to-file \r
 149 +   (concat destdir "/tmp/" msg-id)\r
 150 +   (concat destdir "/new/" msg-id ":2,")))\r
 151 +\r
 152 +(defun jkr/maildir-move-tmp-to-cur (destdir msg-id &optional mark-seen)\r
 153 +  (add-name-to-file \r
 154 +   (concat destdir "/tmp/" msg-id)\r
 155 +   (concat destdir "/cur/" msg-id ":2," (when mark-seen "S"))))\r
 156 +\r
 157 +(defun jkr/maildir-write-buffer-to-maildir (destdir &optional mark-seen)\r
 158 +  "Writes the current buffer to maildir destdir. If mark-seen is\r
 159 +non-nil, it will write it to cur/, and mark it as read. It should\r
 160 +return t if successful, and nil otherwise."\r
 161 +  (let ((orig-buffer (buffer-name)))\r
 162 +    (with-temp-buffer \r
 163 +      (insert-buffer orig-buffer)\r
 164 +      (catch 'link-error\r
 165 +       (let ((msg-id (jkr/maildir-save-buffer-to-tmp destdir)))\r
 166 +         (when msg-id\r
 167 +           (cond (mark-seen\r
 168 +                  (condition-case err\r
 169 +                      (jkr/maildir-move-tmp-to-cur destdir msg-id t)\r
 170 +                    (file-already-exists\r
 171 +                     (throw 'link-error nil))))\r
 172 +                 (t \r
 173 +                  (condition-case err\r
 174 +                      (jkr/maildir-move-tmp-to-new destdir msg-id)\r
 175 +                    (file-already-exists\r
 176 +                     (throw 'link-error nil))))))\r
 177 +         (delete-file (concat destdir "/tmp/" msg-id))))\r
 178 +      t)))\r
 179 \ No newline at end of file\r
 180 -- \r
 181 1.7.0.4\r
 182 \r