ef/0e31c4f90b64c30eb26fdd48822c50d9b80a2c

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