;;; nnmaildir.el --- maildir backend for Gnus
-;; Copyright (c) 2001 Free Software Foundation, Inc.
-;; Copyright (c) 2000, 2001 Paul Jarc <prj@po.cwru.edu>
+
+;; This file is in the public domain.
;; Author: Paul Jarc <prj@po.cwru.edu>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; Maildir format is documented in the maildir(5) man page from qmail
-;; and at <URL:http://cr.yp.to/proto/maildir.html>. nnmaildir also
-;; stores extra information in the .nnmaildir/ directory within a
-;; maildir.
+;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
+;; and in the maildir(5) man page from qmail (available at
+;; <URL:http://www.qmail.org/man/man5/maildir.html>). nnmaildir also stores
+;; extra information in the .nnmaildir/ directory within a maildir.
;;
;; Some goals of nnmaildir:
-;; * Everything Just Works, and correctly. E.g., stale NOV data is
-;; ignored when articles have been edited; no need for
-;; -generate-nov-databases.
-;; * Perfect reliability: [C-g] will never corrupt its data in memory,
-;; and SIGKILL will never corrupt its data in the filesystem.
-;; * We make it easy to manipulate marks, etc., from outside Gnus.
-;; * All information about a group is stored in the maildir, for easy
-;; backup and restoring.
-;; * We use the filesystem as a database.
+;; * Everything Just Works, and correctly. E.g., NOV data is automatically
+;; regenerated when stale; no need for manually running
+;; *-generate-nov-databases.
+;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
+;; SIGKILL will never corrupt its data in the filesystem.
+;; * Allow concurrent operation as much as possible. If files change out
+;; from under us, adapt to the changes or degrade gracefully.
+;; * We use the filesystem as a database, so that, e.g., it's easy to
+;; manipulate marks from outside Gnus.
+;; * All information about a group is stored in the maildir, for easy backup,
+;; copying, restoring, etc.
;;
;; Todo:
-;; * Ignore old NOV data when gnus-extra-headers has changed.
-;; * Don't force article renumbering, so nnmaildir can be used with
-;; the cache and agent. Alternatively, completely rewrite the Gnus
-;; backend interface, which would have other advantages.
-;;
-;; See also <URL:http://multivac.cwru.edu./nnmaildir/> until that
-;; information is added to the Gnus manual.
+;; * When moving an article for expiry, copy all the marks except 'expire
+;; from the original article.
+;; * Add a hook for when moving messages from new/ to cur/, to support
+;; nnmail's duplicate detection.
+;; * Improve generated Xrefs, so crossposts are detectable.
+;; * Improve code readability.
;;; Code:
+;; eval this before editing
+[(progn
+ (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--condcase 'lisp-indent-function 2)
+ )
+]
+
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-and-compile
(require 'nnheader)
(require 'gnus)
;; Variables to generate filenames of messages being delivered:
(defvar nnmaildir--delivery-time "")
-(defconst nnmaildir--delivery-pid (number-to-string (emacs-pid)))
-(defvar nnmaildir--delivery-ct nil)
+(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
+(defvar nnmaildir--delivery-count nil)
;; An obarry containing symbols whose names are server names and whose values
;; are servers:
(defvar nnmaildir--servers (make-vector 3 0))
-;; A server which has not necessarily been added to nnmaildir--servers, or nil:
-(defvar nnmaildir--tmp-server nil)
;; The current server:
(defvar nnmaildir--cur-server nil)
-;; A server is a vector:
-["server-name"
- select-method
- "/expanded/path/to/directory/containing/symlinks/to/maildirs/"
- directory-files-function
- group-name-transformation-function
- ;; An obarray containing symbols whose names are group names and whose values
- ;; are groups:
- group-hash
- ;; A group which has not necessarily been added to the group hash, or nil:
- tmp-group
- current-group ;; or nil
- "Last error message, or nil"
- directory-modtime
- get-new-mail-p ;; Should we split mail from mail-sources?
- "new/group/creation/directory"]
-
-;; A group is a vector:
-["group.name"
- "prefixed:group.name"
- ;; Modification times of the "new", and "cur" directories:
- new-modtime
- cur-modtime
- ;; A vector containing lists of articles:
- [;; A list of articles, with article numbers in descending order, ending with
- ;; article 1:
- article-list
- ;; An obarray containing symbols whose names are filename prefixes and whose
- ;; values are articles:
- file-hash
- ;; Same as above, but keyed on Message-ID:
- msgid-hash
- ;; An article which has not necessarily been added to the file and msgid
- ;; hashes, or nil:
- tmp-article]
- ;; A vector containing nil, or articles with NOV data:
- nov-cache
- ;; The index of the next nov-cache entry to be replaced:
- nov-cache-index
- ;; An obarray containing symbols whose names are mark names and whose values
- ;; are modtimes of mark directories:
- mark-modtime-hash]
-
-;; An article is a vector:
-["file.name.prefix"
- ":2,suffix" ;; or 'expire if expired
- number
- "msgid"
- ;; A NOV data vector, or nil:
- ["subject\tfrom\tdate"
- "references\tchars\lines"
- "extra"
- article-file-modtime]]
-
-(defmacro nnmaildir--srv-new () '(make-vector 11 nil))
-(defmacro nnmaildir--srv-get-name (server) `(aref ,server 0))
-(defmacro nnmaildir--srv-get-method (server) `(aref ,server 1))
-(defmacro nnmaildir--srv-get-dir (server) `(aref ,server 2))
-(defmacro nnmaildir--srv-get-ls (server) `(aref ,server 3))
-(defmacro nnmaildir--srv-get-groups (server) `(aref ,server 4))
-(defmacro nnmaildir--srv-get-tmpgrp (server) `(aref ,server 5))
-(defmacro nnmaildir--srv-get-curgrp (server) `(aref ,server 6))
-(defmacro nnmaildir--srv-get-error (server) `(aref ,server 7))
-(defmacro nnmaildir--srv-get-mtime (server) `(aref ,server 8))
-(defmacro nnmaildir--srv-get-gnm (server) `(aref ,server 9))
-(defmacro nnmaildir--srv-get-create-dir (server) `(aref ,server 10))
-(defmacro nnmaildir--srv-set-name (server val) `(aset ,server 0 ,val))
-(defmacro nnmaildir--srv-set-method (server val) `(aset ,server 1 ,val))
-(defmacro nnmaildir--srv-set-dir (server val) `(aset ,server 2 ,val))
-(defmacro nnmaildir--srv-set-ls (server val) `(aset ,server 3 ,val))
-(defmacro nnmaildir--srv-set-groups (server val) `(aset ,server 4 ,val))
-(defmacro nnmaildir--srv-set-tmpgrp (server val) `(aset ,server 5 ,val))
-(defmacro nnmaildir--srv-set-curgrp (server val) `(aset ,server 6 ,val))
-(defmacro nnmaildir--srv-set-error (server val) `(aset ,server 7 ,val))
-(defmacro nnmaildir--srv-set-mtime (server val) `(aset ,server 8 ,val))
-(defmacro nnmaildir--srv-set-gnm (server val) `(aset ,server 9 ,val))
-(defmacro nnmaildir--srv-set-create-dir (server val) `(aset ,server 10 ,val))
-
-(defmacro nnmaildir--grp-new () '(make-vector 8 nil))
-(defmacro nnmaildir--grp-get-name (group) `(aref ,group 0))
-(defmacro nnmaildir--grp-get-pname (group) `(aref ,group 1))
-(defmacro nnmaildir--grp-get-new (group) `(aref ,group 2))
-(defmacro nnmaildir--grp-get-cur (group) `(aref ,group 3))
-(defmacro nnmaildir--grp-get-lists (group) `(aref ,group 4))
-(defmacro nnmaildir--grp-get-cache (group) `(aref ,group 5))
-(defmacro nnmaildir--grp-get-index (group) `(aref ,group 6))
-(defmacro nnmaildir--grp-get-mmth (group) `(aref ,group 7))
-(defmacro nnmaildir--grp-set-name (group val) `(aset ,group 0 ,val))
-(defmacro nnmaildir--grp-set-pname (group val) `(aset ,group 1 ,val))
-(defmacro nnmaildir--grp-set-new (group val) `(aset ,group 2 ,val))
-(defmacro nnmaildir--grp-set-cur (group val) `(aset ,group 3 ,val))
-(defmacro nnmaildir--grp-set-lists (group val) `(aset ,group 4 ,val))
-(defmacro nnmaildir--grp-set-cache (group val) `(aset ,group 5 ,val))
-(defmacro nnmaildir--grp-set-index (group val) `(aset ,group 6 ,val))
-(defmacro nnmaildir--grp-set-mmth (group val) `(aset ,group 7 ,val))
-
-(defmacro nnmaildir--lists-new () '(make-vector 4 nil))
-(defmacro nnmaildir--lists-get-nlist (lists) `(aref ,lists 0))
-(defmacro nnmaildir--lists-get-flist (lists) `(aref ,lists 1))
-(defmacro nnmaildir--lists-get-mlist (lists) `(aref ,lists 2))
-(defmacro nnmaildir--lists-get-tmpart (lists) `(aref ,lists 3))
-(defmacro nnmaildir--lists-set-nlist (lists val) `(aset ,lists 0 ,val))
-(defmacro nnmaildir--lists-set-flist (lists val) `(aset ,lists 1 ,val))
-(defmacro nnmaildir--lists-set-mlist (lists val) `(aset ,lists 2 ,val))
-(defmacro nnmaildir--lists-set-tmpart (lists val) `(aset ,lists 3 ,val))
-
-(defmacro nnmaildir--nlist-last-num (list)
- `(if ,list (nnmaildir--art-get-num (car ,list)) 0))
-(defmacro nnmaildir--nlist-art (list num)
- `(and ,list
- (>= (nnmaildir--art-get-num (car ,list)) ,num)
- (nth (- (nnmaildir--art-get-num (car ,list)) ,num) ,list)))
+;; A copy of nnmail-extra-headers
+(defvar nnmaildir--extra nil)
+
+;; A NOV structure looks like this (must be prin1-able, so no defstruct):
+["subject\tfrom\tdate"
+ "references\tchars\lines"
+ "To: you\tIn-Reply-To: <your.mess@ge>"
+ (12345 67890) ;; modtime of the corresponding article file
+ (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
+(defconst nnmaildir--novlen 5)
+(defmacro nnmaildir--nov-new (beg mid end mtime extra)
+ `(vector ,beg ,mid ,end ,mtime ,extra))
+(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
+(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
+(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
+(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
+(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
+(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value))
+(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value))
+(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value))
+(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
+(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
+
+(defstruct nnmaildir--art
+ (prefix nil :type string) ;; "time.pid.host"
+ (suffix nil :type string) ;; ":2,flags"
+ (num nil :type natnum) ;; article number
+ (msgid nil :type string) ;; "<mess.age@id>"
+ (nov nil :type vector)) ;; cached nov structure, or nil
+
+(defstruct nnmaildir--grp
+ (name nil :type string) ;; "group.name"
+ (new nil :type list) ;; new/ modtime
+ (cur nil :type list) ;; cur/ modtime
+ (min 1 :type natnum) ;; minimum article number
+ (count 0 :type natnum) ;; count of articles
+ (nlist nil :type list) ;; list of articles, ordered descending by number
+ (flist nil :type vector) ;; obarray mapping filename prefix->article
+ (mlist nil :type vector) ;; obarray mapping message-id->article
+ (cache nil :type vector) ;; nov cache
+ (index nil :type natnum) ;; index of next cache entry to replace
+ (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
+ ; ("Mark Mod Time Hash")
+
+(defstruct nnmaildir--srv
+ (address nil :type string) ;; server address string
+ (method nil :type list) ;; (nnmaildir "address" ...)
+ (prefix nil :type string) ;; "nnmaildir+address:"
+ (dir nil :type string) ;; "/expanded/path/to/server/dir/"
+ (ls nil :type function) ;; directory-files function
+ (groups nil :type vector) ;; obarray mapping group name->group
+ (curgrp nil :type nnmaildir--grp) ;; current group, or nil
+ (error nil :type string) ;; last error message, or nil
+ (mtime nil :type list) ;; modtime of dir
+ (gnm nil) ;; flag: split from mail-sources?
+ (target-prefix nil :type string)) ;; symlink target prefix
+
+(defun nnmaildir--expired-article (group article)
+ (setf (nnmaildir--art-nov article) nil)
+ (let ((flist (nnmaildir--grp-flist group))
+ (mlist (nnmaildir--grp-mlist group))
+ (min (nnmaildir--grp-min group))
+ (count (1- (nnmaildir--grp-count group)))
+ (prefix (nnmaildir--art-prefix article))
+ (msgid (nnmaildir--art-msgid article))
+ (new-nlist nil)
+ (nlist-pre '(nil . nil))
+ nlist-post num)
+ (unless (zerop count)
+ (setq nlist-post (nnmaildir--grp-nlist group)
+ num (nnmaildir--art-num article))
+ (if (eq num (caar nlist-post))
+ (setq new-nlist (cdr nlist-post))
+ (setq new-nlist nlist-post
+ nlist-pre nlist-post
+ nlist-post (cdr nlist-post))
+ (while (/= num (caar nlist-post))
+ (setq nlist-pre nlist-post
+ nlist-post (cdr nlist-post)))
+ (setq nlist-post (cdr nlist-post))
+ (if (eq num min)
+ (setq min (caar nlist-pre)))))
+ (let ((inhibit-quit t))
+ (setf (nnmaildir--grp-min group) min)
+ (setf (nnmaildir--grp-count group) count)
+ (setf (nnmaildir--grp-nlist group) new-nlist)
+ (setcdr nlist-pre nlist-post)
+ (unintern prefix flist)
+ (unintern msgid mlist))))
+
+(defun nnmaildir--nlist-art (group num)
+ (let ((entry (assq num (nnmaildir--grp-nlist group))))
+ (if entry
+ (cdr entry))))
(defmacro nnmaildir--flist-art (list file)
`(symbol-value (intern-soft ,file ,list)))
(defmacro nnmaildir--mlist-art (list msgid)
`(symbol-value (intern-soft ,msgid ,list)))
-(defmacro nnmaildir--art-new () '(make-vector 5 nil))
-(defmacro nnmaildir--art-get-prefix (article) `(aref ,article 0))
-(defmacro nnmaildir--art-get-suffix (article) `(aref ,article 1))
-(defmacro nnmaildir--art-get-num (article) `(aref ,article 2))
-(defmacro nnmaildir--art-get-msgid (article) `(aref ,article 3))
-(defmacro nnmaildir--art-get-nov (article) `(aref ,article 4))
-(defmacro nnmaildir--art-set-prefix (article val) `(aset ,article 0 ,val))
-(defmacro nnmaildir--art-set-suffix (article val) `(aset ,article 1 ,val))
-(defmacro nnmaildir--art-set-num (article val) `(aset ,article 2 ,val))
-(defmacro nnmaildir--art-set-msgid (article val) `(aset ,article 3 ,val))
-(defmacro nnmaildir--art-set-nov (article val) `(aset ,article 4 ,val))
-
-(defmacro nnmaildir--nov-new () '(make-vector 4 nil))
-(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
-(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
-(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
-(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
-(defmacro nnmaildir--nov-set-beg (nov val) `(aset ,nov 0 ,val))
-(defmacro nnmaildir--nov-set-mid (nov val) `(aset ,nov 1 ,val))
-(defmacro nnmaildir--nov-set-end (nov val) `(aset ,nov 2 ,val))
-(defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val))
-
-(defmacro nnmaildir--srv-grp-dir (srv-dir gname)
- `(file-name-as-directory (concat ,srv-dir ,gname)))
-
-(defun nnmaildir--param (prefixed-group-name param)
- (setq param
- (gnus-group-find-parameter prefixed-group-name param 'allow-list)
- param (if (vectorp param) (aref param 0) param))
+(defun nnmaildir--pgname (server gname)
+ (let ((prefix (nnmaildir--srv-prefix server)))
+ (if prefix (concat prefix gname)
+ (setq gname (gnus-group-prefixed-name gname
+ (nnmaildir--srv-method server)))
+ (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
+ gname)))
+
+(defun nnmaildir--param (pgname param)
+ (setq param (gnus-group-find-parameter pgname param 'allow-list))
+ (if (vectorp param) (setq param (aref param 0)))
(eval param))
-(defmacro nnmaildir--unlink (file)
- `(if (file-attributes ,file) (delete-file ,file)))
-
-(defmacro nnmaildir--tmp (dir) `(file-name-as-directory (concat ,dir "tmp")))
-(defmacro nnmaildir--new (dir) `(file-name-as-directory (concat ,dir "new")))
-(defmacro nnmaildir--cur (dir) `(file-name-as-directory (concat ,dir "cur")))
-(defmacro nnmaildir--nndir (dir)
- `(file-name-as-directory (concat ,dir ".nnmaildir")))
-
-(defun nnmaildir--lists-fix (lists)
- (let ((tmp (nnmaildir--lists-get-tmpart lists)))
- (when tmp
- (set (intern (nnmaildir--art-get-prefix tmp)
- (nnmaildir--lists-get-flist lists))
- tmp)
- (set (intern (nnmaildir--art-get-msgid tmp)
- (nnmaildir--lists-get-mlist lists))
- tmp)
- (nnmaildir--lists-set-tmpart lists nil))))
-
+(defmacro nnmaildir--with-nntp-buffer (&rest body)
+ `(save-excursion
+ (set-buffer nntp-server-buffer)
+ ,@body))
+(defmacro nnmaildir--with-work-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir work*"))
+ ,@body))
+(defmacro nnmaildir--with-nov-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir nov*"))
+ ,@body))
+(defmacro nnmaildir--with-move-buffer (&rest body)
+ `(
projects / gnus / blobdiff