git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-maildir-fcc.el

   1 ;; This file is free software; you can redistribute it and/or modify
   2 ;; it under the terms of the GNU General Public License as published
   3 ;; by the Free Software Foundation; either version 2, or (at your
   4 ;; option) any later version.
   5
   6 ;; This program is distributed in the hope that it will be useful,
   7 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
   8 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   9 ;; GNU General Public License for more details.
  10
  11 ;; You should have received a copy of the GNU General Public License
  12 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  13 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  14 ;; Boston, MA 02110-1301, USA.
  15
  16 ;; Commentary:
  17 ;;
  18 ;; This is the beginning of a solution for storing sent mail in a
  19 ;; maildir in emacs message mode, presented because some people might
  20 ;; find it useful. It is *not* fully tested, it *may* overwrite files,
  21 ;; and any directories you point this at may no longer be there
  22 ;; afterwards. Use at your own risk.
  23 ;;
  24 ;; To use this as the fcc handler for message-mode, put
  25 ;; one of the following in your init file:
  26 ;;
  27 ;; if you want Fcc'd messages to be marked as read:
  28 ;;
  29 ;;     (setq message-fcc-handler-function
  30 ;;          '(lambda (destdir)
  31 ;;           (notmuch-maildir-fcc-write-buffer-to-maildir destdir t)))
  32 ;;
  33 ;; if you want Fcc'd messages to be marked as new:
  34 ;;
  35 ;;     (setq message-fcc-handler-function
  36 ;;          '(lambda (destdir)
  37 ;;           (notmuch-maildir-fcc-write-buffer-to-maildir destdir nil)))
  38
  39
  40 (defvar notmuch-maildir-fcc-count 0)
  41
  42 (defun notmuch-maildir-fcc-host-fixer (hostname)
  43   (replace-regexp-in-string "/\\|:"
  44                             '(lambda (s)
  45                                  (cond ((string-equal s "/") "\\057")
  46                                        ((string-equal s ":") "\\072")
  47                                        (t s)))
  48                             hostname
  49                             t
  50                             t))
  51
  52 (defun notmuch-maildir-fcc-make-uniq-maildir-id ()
  53    (let* ((ct (current-time))
  54           (timeid (+ (* (car ct) 65536) (cadr ct)))
  55           (microseconds (caddr ct))
  56           (hostname (notmuch-maildir-fcc-host-fixer system-name)))
  57      (setq notmuch-maildir-fcc-count (+ notmuch-maildir-fcc-count 1))
  58      (format "%d.%d_%d_%d.%s"
  59              timeid
  60              (emacs-pid)
  61              microseconds
  62              notmuch-maildir-fcc-count
  63              hostname)))
  64
  65 (defun notmuch-maildir-fcc-dir-is-maildir-p (dir)
  66   (and (file-exists-p (concat dir "/cur/"))
  67        (file-exists-p (concat dir "/new/"))
  68        (file-exists-p (concat dir "/tmp/"))))
  69
  70 (defun notmuch-maildir-fcc-save-buffer-to-tmp (destdir)
  71   "Returns the msg id of the message written to the temp directory
  72 if successful, nil if not."
  73   (let ((msg-id (notmuch-maildir-fcc-make-uniq-maildir-id)))
  74     (while (file-exists-p (concat destdir "/tmp/" msg-id))
  75       (setq msg-id (notmuch-maildir-fcc-make-uniq-maildir-id)))
  76     (cond ((notmuch-maildir-fcc-dir-is-maildir-p destdir)
  77            (write-file (concat destdir "/tmp/" msg-id))
  78            msg-id)
  79           (t
  80            (message (format "Can't write to %s. Not a maildir."
  81                      destdir))
  82            nil))))
  83
  84 (defun notmuch-maildir-fcc-move-tmp-to-new (destdir msg-id)
  85   (add-name-to-file
  86    (concat destdir "/tmp/" msg-id)
  87    (concat destdir "/new/" msg-id ":2,")))
  88
  89 (defun notmuch-maildir-fcc-move-tmp-to-cur (destdir msg-id &optional mark-seen)
  90   (add-name-to-file
  91    (concat destdir "/tmp/" msg-id)
  92    (concat destdir "/cur/" msg-id ":2," (when mark-seen "S"))))
  93
  94 (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen)
  95   "Writes the current buffer to maildir destdir. If mark-seen is
  96 non-nil, it will write it to cur/, and mark it as read. It should
  97 return t if successful, and nil otherwise."
  98   (let ((orig-buffer (buffer-name)))
  99     (with-temp-buffer
 100       (insert-buffer orig-buffer)
 101       (catch 'link-error
 102         (let ((msg-id (notmuch-maildir-fcc-save-buffer-to-tmp destdir)))
 103           (when msg-id
 104             (cond (mark-seen
 105                    (condition-case err
 106                        (notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t)
 107                      (file-already-exists
 108                       (throw 'link-error nil))))
 109                   (t
 110                    (condition-case err
 111                        (notmuch-maildir-fcc-move-tmp-to-new destdir msg-id)
 112                      (file-already-exists
 113                       (throw 'link-error nil))))))
 114           (delete-file (concat destdir "/tmp/" msg-id))))
 115       t)))
 116
 117 (provide 'notmuch-maildir-fcc)