c5/1ba145de0f9172961b2672bb83dd3f09e00814

   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 1CA8C418C25\r
   6         for <notmuch@notmuchmail.org>; Fri, 23 Apr 2010 12:01:20 -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, RCVD_IN_DNSWL_NONE=-0.0001] 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 2W+QyX8klGez for <notmuch@notmuchmail.org>;\r
  16         Fri, 23 Apr 2010 12:01:18 -0700 (PDT)\r
  17 Received: from homiemail-a15.g.dreamhost.com (caiajhbdcaid.dreamhost.com\r
  18         [208.97.132.83])\r
  19         by olra.theworths.org (Postfix) with ESMTP id 83296431FC1\r
  20         for <notmuch@notmuchmail.org>; Fri, 23 Apr 2010 12:01:18 -0700 (PDT)\r
  21 Received: from localhost.localdomain (unknown [195.190.188.219])\r
  22         (Authenticated sender: sebastian@sspaeth.de)\r
  23         by homiemail-a15.g.dreamhost.com (Postfix) with ESMTPA id A94FA76C065; \r
  24         Fri, 23 Apr 2010 12:01:15 -0700 (PDT)\r
  25 From: Sebastian Spaeth <Sebastian@SSpaeth.de>\r
  26 To: Notmuch developer list <notmuch@notmuchmail.org>\r
  27 Subject: [PATCH 1/4] Add elisp file for FCC to maildir solution\r
  28 Date: Fri, 23 Apr 2010 21:01:08 +0200\r
  29 Message-Id: <1272049271-20049-1-git-send-email-Sebastian@SSpaeth.de>\r
  30 X-Mailer: git-send-email 1.7.0.4\r
  31 In-Reply-To: <m37hny5kuy.fsf@x200.gr8dns.org>\r
  32 References: <m37hny5kuy.fsf@x200.gr8dns.org>\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: Fri, 23 Apr 2010 19:01:20 -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 As stated by Dirk, patches are preferred by mail. So here is the updated \r
  55 patch series of 4 patches by mail again.\r
  56 \r
  57  emacs/notmuch-maildir-fcc.el |  115 ++++++++++++++++++++++++++++++++++++++++++\r
  58  1 files changed, 115 insertions(+), 0 deletions(-)\r
  59  create mode 100644 emacs/notmuch-maildir-fcc.el\r
  60 \r
  61 diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el\r
  62 new file mode 100644\r
  63 index 0000000..979428e\r
  64 --- /dev/null\r
  65 +++ b/emacs/notmuch-maildir-fcc.el\r
  66 @@ -0,0 +1,115 @@\r
  67 +;; This file is free software; you can redistribute it and/or modify\r
  68 +;; it under the terms of the GNU General Public License as published\r
  69 +;; by the Free Software Foundation; either version 2, or (at your\r
  70 +;; option) any later version.\r
  71 +\r
  72 +;; This program is distributed in the hope that it will be useful,\r
  73 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
  74 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
  75 +;; GNU General Public License for more details.\r
  76 +\r
  77 +;; You should have received a copy of the GNU General Public License\r
  78 +;; along with GNU Emacs; see the file COPYING.  If not, write to the\r
  79 +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,\r
  80 +;; Boston, MA 02110-1301, USA.\r
  81 +\r
  82 +;; Commentary:\r
  83 +;;\r
  84 +;; This is the beginning of a solution for storing sent mail in a\r
  85 +;; maildir in emacs message mode, presented because some people might\r
  86 +;; find it useful. It is *not* fully tested, it *may* overwrite files,\r
  87 +;; and any directories you point this at may no longer be there\r
  88 +;; afterwards. Use at your own risk.\r
  89 +;;\r
  90 +;; To use this as the fcc handler for message-mode, put\r
  91 +;; one of the following in your init file:\r
  92 +;;\r
  93 +;; if you want Fcc'd messages to be marked as read:\r
  94 +;;\r
  95 +;;     (setq message-fcc-handler-function\r
  96 +;;          '(lambda (destdir)\r
  97 +;;          (jkr/maildir-write-buffer-to-maildir destdir t)))\r
  98 +;;\r
  99 +;; if you want Fcc'd messages to be marked as new:\r
 100 +;;\r
 101 +;;     (setq message-fcc-handler-function\r
 102 +;;          '(lambda (destdir)\r
 103 +;;          (jkr/maildir-write-buffer-to-maildir destdir nil)))\r
 104 +\r
 105 +\r
 106 +(defvar jkr/maildir-count 0)\r
 107 +\r
 108 +(defun jkr/maildir-host-fixer (hostname)\r
 109 +  (replace-regexp-in-string "/\\|:"\r
 110 +                           '(lambda (s)\r
 111 +                                (cond ((string-equal s "/") "\\057")\r
 112 +                                      ((string-equal s ":") "\\072")\r
 113 +                                      (t s)))\r
 114 +                           hostname\r
 115 +                           t\r
 116 +                           t))\r
 117 +\r
 118 +(defun jkr/maildir-make-uniq-maildir-id ()\r
 119 +   (let* ((ct (current-time))\r
 120 +         (timeid (+ (* (car ct) 65536) (cadr ct)))\r
 121 +         (microseconds (caddr ct))\r
 122 +         (hostname (jkr/maildir-host-fixer system-name)))\r
 123 +     (setq jkr/maildir-count (+ jkr/maildir-count 1))\r
 124 +     (format "%d.%d_%d_%d.%s"\r
 125 +            timeid\r
 126 +            (emacs-pid)\r
 127 +            microseconds\r
 128 +            jkr/maildir-count\r
 129 +            hostname)))\r
 130 +\r
 131 +(defun jkr/maildir-dir-is-maildir-p (dir)\r
 132 +  (and (file-exists-p (concat dir "/cur/"))\r
 133 +       (file-exists-p (concat dir "/new/"))\r
 134 +       (file-exists-p (concat dir "/tmp/"))))\r
 135 +\r
 136 +(defun jkr/maildir-save-buffer-to-tmp (destdir)\r
 137 +  "Returns the msg id of the message written to the temp directory\r
 138 +if successful, nil if not."\r
 139 +  (let ((msg-id (jkr/maildir-make-uniq-maildir-id)))\r
 140 +    (while (file-exists-p (concat destdir "/tmp/" msg-id))\r
 141 +      (setq msg-id (jkr/maildir-make-uniq-maildir-id)))\r
 142 +    (cond ((jkr/maildir-dir-is-maildir-p destdir)\r
 143 +          (write-file (concat destdir "/tmp/" msg-id))\r
 144 +          msg-id)\r
 145 +         (t\r
 146 +          (message (format "Can't write to %s. Not a maildir."\r
 147 +                    destdir))\r
 148 +          nil))))\r
 149 +\r
 150 +(defun jkr/maildir-move-tmp-to-new (destdir msg-id)\r
 151 +  (add-name-to-file\r
 152 +   (concat destdir "/tmp/" msg-id)\r
 153 +   (concat destdir "/new/" msg-id ":2,")))\r
 154 +\r
 155 +(defun jkr/maildir-move-tmp-to-cur (destdir msg-id &optional mark-seen)\r
 156 +  (add-name-to-file\r
 157 +   (concat destdir "/tmp/" msg-id)\r
 158 +   (concat destdir "/cur/" msg-id ":2," (when mark-seen "S"))))\r
 159 +\r
 160 +(defun jkr/maildir-write-buffer-to-maildir (destdir &optional mark-seen)\r
 161 +  "Writes the current buffer to maildir destdir. If mark-seen is\r
 162 +non-nil, it will write it to cur/, and mark it as read. It should\r
 163 +return t if successful, and nil otherwise."\r
 164 +  (let ((orig-buffer (buffer-name)))\r
 165 +    (with-temp-buffer\r
 166 +      (insert-buffer orig-buffer)\r
 167 +      (catch 'link-error\r
 168 +       (let ((msg-id (jkr/maildir-save-buffer-to-tmp destdir)))\r
 169 +         (when msg-id\r
 170 +           (cond (mark-seen\r
 171 +                  (condition-case err\r
 172 +                      (jkr/maildir-move-tmp-to-cur destdir msg-id t)\r
 173 +                    (file-already-exists\r
 174 +                     (throw 'link-error nil))))\r
 175 +                 (t\r
 176 +                  (condition-case err\r
 177 +                      (jkr/maildir-move-tmp-to-new destdir msg-id)\r
 178 +                    (file-already-exists\r
 179 +                     (throw 'link-error nil))))))\r
 180 +         (delete-file (concat destdir "/tmp/" msg-id))))\r
 181 +      t)))\r
 182 \ No newline at end of file\r
 183 -- \r
 184 1.7.0.4\r
 185 \r