;;; mua-msg.el -- part of mua, the mu mail user agent ;; ;; Copyright (C) 2011 Dirk-Jan C. Binnema ;; Author: Dirk-Jan C. Binnema ;; Maintainer: Dirk-Jan C. Binnema ;; Keywords: email ;; Version: 0.0 ;; This file is not part of GNU Emacs. ;; ;; GNU Emacs 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 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs 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. If not, see . ;;; Commentary: ;; mua ;;; Code: (eval-when-compile (require 'cl)) (defvar mua/msg-file-map nil "*internal* a map of uid->message. This map adds a level of indirection for message files; many actions (such moving, responding to or even reading a message) cause the file names to change. Here we map the initial file to a uid, the latter which stays constant over the lifetime of a message in the system (in practice, the lifetime of a particular headers buffer). When creating the headers buffer, the file names are registered with `mua/msg-file-register'. All operation that change file names ultimately (should) end up in `mua/msg-file-move', which will update the map after the moving (using `mua/msg-file-update') Other places of the code can use the uid to get the *current* path of the file using `mua/msg-file-get-path'. ") (defun mua/msg-file-register (path) "Register a message PATH in the `mua/msg-file-map', and return the uid for it." (unless mua/msg-file-map (setq mua/msg-file-map (make-hash-table :size 256 :rehash-size 2))) (let ((uid (sha1 path))) (puthash uid path mua/msg-file-map) uid)) (defun mua/msg-file-update (uid path) "Set the new path for the message identified by UID to PATH." (if (gethash uid mua/msg-file-map) (puthash uid path mua/msg-file-map) (mua/warn "No message file registered for uid"))) (defun mua/msg-file-get-path (uid) "Get the current path for the message identified by UID." (gethash uid mua/msg-file-map)) (defun mua/msg-file-move-uid (uid targetdir &optional flags) "Move message identified by UID to TARGETDIR using 'mu mv', and update the database with the new situation. SRC must be the full, absolute path to a message file, while TARGETDIR must be a maildir - that is, the part _without_ cur/ or new/. 'mu mv' will calculate the target directory and the exact file name. See `mua/msg-file-map' for a discussion about UID. After the file system move (rename) has been done, 'mu remove' and/or 'mu add' are invoked asynchronously to update the database with the changes. Optionally, you can specify the FLAGS for the new file; this must be a list consisting of one or more of DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen and g, as defined in [1]. See `mua/msg-file-string-to-flags' and `mua/msg-file-flags-to-string'. If TARGETDIR is '/dev/null', remove SRC. After the file system move, the database will be updated as well, using the 'mu add' and 'mu remove' commands. Function returns t the move succeeds, in other cases, it returns `nil'. \[1\] http://cr.yp.to/proto/maildir.html." (let ((src (mua/msg-file-get-path uid))) (unless src (error "Source path not registered.")) (let ((fulltarget (mua/mu-mv src targetdir flags))) (when (and fulltarget (not (string= src fulltarget))) (mua/msg-file-update uid fulltarget) ;; update the path (mua/mu-remove-async src) (unless (string= targetdir "/dev/null") (mua/mu-add-async fulltarget))))) t) (defun mua/msg-file-mark-as-read (uid) "Mark the message identified by UID as read if it is not so already. In Maildir terms, this means moving the message from \"new/\" to \"cur/\" (if it's not yet there), and setting the \"S\" flag." (let* ((path (mua/msg-file-get-path uid)) (flags (and path (mua/msg-file-flags-from-path path)))) (when (or (member 'new flags) (not (member 'seen flags))) (let* ((newflags (delq 'new (cons 'seen flags))) (target (mua/msg-file-maildir-from-path path t))) (unless (mua/msg-file-move-uid uid target newflags) (mua/warn "Failed to mark message as read")))))) (defun mua/msg-file-flags-from-path (path) "Get the flags for the message at PATH, which does not have to exist. The flags are returned as a list consisting of one or more of DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen and Trash, as defined in [1]. See `mua/msg-file-string-to-flags' and `mua/msg-file-flags-to-string'. \[1\] http://cr.yp.to/proto/maildir.html." (when (string-match ",\\(\[A-Z\]*\\)$" path) (mua/msg-file-string-to-flags (match-string 1 path)))) (defun mua/msg-file-maildir-from-path (path &optional dont-strip-prefix) "Get the maildir from PATH; in this context, 'maildir' is the part between the `mua/maildir' and the /cur or /new; so e.g. \"/home/user/Maildir/foo/bar/cur/12345:2,S\" would have \"/foo/bar\" as its maildir. If DONT-STRIP-PREFIX is non-nil, function will instead _not_ remove the `mua/maildir' from the front - so in that case, the example would return \"/home/user/Maildir/foo/bar/\". If the maildir cannot be determined, return `nil'." (when (and (string-match "^\\(.*\\)/\\(cur\\|new\\)/\[^/\]*$" path)) (let ((mdir (match-string 1 path))) (when (and (< (length mua/maildir) (length mdir)) (string= (substring mdir 0 (length mua/maildir)) mua/maildir)) (if dont-strip-prefix mdir (substring mdir (length mua/maildir))))))) (defun mua/msg-file-flags-to-string (flags) "Remove duplicates and sort the output of `mua/msg-file-flags-to-string-1'" (concat (sort (remove-duplicates (append (mua/msg-file-flags-to-string-1 flags) nil)) '>))) (defun mua/msg-file-flags-to-string-1 (flags) "Convert a list of flags into a string as seen in Maildir message files; flags are symbols draft, flagged, new, passed, replied, seen, trashed and the string is the concatenation of the uppercased first letters of these flags, as per [1]. Other flags than the ones listed here are ignored. Also see `mua/msg-file-string-to-flags'. \[1\]: http://cr.yp.to/proto/maildir.html" (when flags (let ((kar (case (car flags) ('draft ?D) ('flagged ?F) ('passed ?P) ('replied ?R) ('seen ?S) ('trashed ?T)))) (concat (and kar (string kar)) (mua/msg-file-flags-to-string-1 (cdr flags)))))) (defun mua/msg-file-string-to-flags (str) "Remove duplicates from the output of `mua/msg-file-string-to-flags-1'" (remove-duplicates (mua/msg-file-string-to-flags-1 str))) (defun mua/msg-file-string-to-flags-1 (str) "Convert a string with message flags as seen in Maildir messages into a list of flags in; flags are symbols draft, flagged, new, passed, replied, seen, trashed and the string is the concatenation of the uppercased first letters of these flags, as per [1]. Other letters than the ones listed here are ignored. Also see `mua/msg-file-flags-to-string'. \[1\]: http://cr.yp.to/proto/maildir.html" (when (/= 0 (length str)) (let ((flag (case (string-to-char str) (?D 'draft) (?F 'flagged) (?P 'passed) (?R 'replied) (?S 'seen) (?T 'trashed)))) (append (when flag (list flag)) (mua/msg-file-string-to-flags-1 (substring str 1)))))) (provide 'mua-msg-file)