;;; nnmaildir.el --- maildir backend for Gnus
-;; Copyright (c) 2001, 2002 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; 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.
+;; * 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.
+;; * All information about a group is stored in the maildir, for easy backup,
+;; copying, restoring, etc.
;;
;; Todo:
-;; * 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 and XEmacs.
(eval-and-compile
- (require 'nnheader)
- (require 'gnus)
- (require 'gnus-util)
- (require 'gnus-range)
- (require 'gnus-start)
- (require 'gnus-int)
- (require 'message))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
+(require 'nnheader)
+(require 'gnus)
+(require 'gnus-util)
+(require 'gnus-range)
+(require 'gnus-start)
+(require 'gnus-int)
+(require 'message)
+(require 'nnmail)
+
(eval-when-compile
- (require 'cl)
- (require 'nnmail))
+ (require 'cl))
(defconst nnmaildir-version "Gnus")
+(defconst nnmaildir-flag-mark-mapping
+ '((?F . tick)
+ (?R . reply)
+ (?S . read))
+ "Alist mapping Maildir filename flags to Gnus marks.
+Maildir filenames are of the form \"unique-id:2,FLAGS\",
+where FLAGS are a string of characters in ASCII order.
+Some of the FLAGS correspond to Gnus marks.")
+
+(defsubst nnmaildir--mark-to-flag (mark)
+ "Find the Maildir flag that corresponds to MARK (an atom).
+Return a character, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+ (car (rassq mark nnmaildir-flag-mark-mapping)))
+
+(defsubst nnmaildir--flag-to-mark (flag)
+ "Find the Gnus mark that corresponds to FLAG (a character).
+Return an atom, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+ (cdr (assq flag nnmaildir-flag-mark-mapping)))
+
+(defun nnmaildir--ensure-suffix (filename)
+ "Ensure that FILENAME contains the suffix \":2,\"."
+ (if (gnus-string-match-p ":2," filename)
+ filename
+ (concat filename ":2,")))
+
+(defun nnmaildir--add-flag (flag suffix)
+ "Return a copy of SUFFIX where FLAG is set.
+SUFFIX should start with \":2,\"."
+ (unless (gnus-string-match-p "^:2," suffix)
+ (error "Invalid suffix `%s'" suffix))
+ (let* ((flags (substring suffix 3))
+ (flags-as-list (append flags nil))
+ (new-flags
+ (concat (gnus-delete-duplicates
+ ;; maildir flags must be sorted
+ (sort (cons flag flags-as-list) '<)))))
+ (concat ":2," new-flags)))
+
+(defun nnmaildir--remove-flag (flag suffix)
+ "Return a copy of SUFFIX where FLAG is cleared.
+SUFFIX should start with \":2,\"."
+ (unless (gnus-string-match-p "^:2," suffix)
+ (error "Invalid suffix `%s'" suffix))
+ (let* ((flags (substring suffix 3))
+ (flags-as-list (append flags nil))
+ (new-flags (concat (delq flag flags-as-list))))
+ (concat ":2," new-flags)))
+
(defvar nnmaildir-article-file-name nil
"*The filename of the most recently requested article. This variable is set
by nnmaildir-request-article.")
;; 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
- ;; The value of nnmail-extra-headers when this NOV data was parsed:
- (to in-reply-to)]]
-
-(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--article-set-flags (article new-suffix curdir)
+ (let* ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (article-file (concat curdir prefix suffix))
+ (new-name (concat curdir prefix new-suffix)))
+ (unless (file-exists-p article-file)
+ (error "Couldn't find article file %s" article-file))
+ (rename-file article-file new-name 'replace)
+ (setf (nnmaildir--art-suffix article) new-suffix)))
+
+(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 5 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-get-neh (nov) `(aref ,nov 4))
-(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--nov-set-neh (nov val) `(aset ,nov 4 ,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)
+ (declare (debug (body)))
+ `(with-current-buffer nntp-server-buffer
+ ,@body))
+(defmacro nnmaildir--with-work-buffer (&rest body)
+ (declare (debug (body)))
+ `(with-current-buffer (get-buffer-create " *nnmaildir work*")
+ ,@body))
+(defmacro nnmaildir--with-nov-buffer (&rest body)
+ (declare (debug (body)))
+ `(with-current-buffer (get-buffer-create " *nnmaildir nov*")
+ ,@body))
+(defmacro nnmaildir--with-move-buffer (&rest body)
+ (declare (debug (body)))
+ `(with-current-buffer (get-buffer-create " *nnmaildir move*")
+ ,@body))
+
+(defsubst nnmaildir--subdir (dir subdir)
+ (file-name-as-directory (concat dir subdir)))
+(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
+ (nnmaildir--subdir srv-dir gname))
+(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp"))
+(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new"))
+(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur"))
+(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir"))
+(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov"))
+(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
+(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num"))
+
+(defmacro nnmaildir--unlink (file-arg)
+ `(let ((file ,file-arg))
+ (if (file-attributes file) (delete-file file))))
+(defun nnmaildir--mkdir (dir)
+ (or (file-exists-p (file-name-as-directory dir))
+ (make-directory-internal (directory-file-name dir))))
+(defun nnmaildir--mkfile (file)
+ (write-region "" nil file nil 'no-message))
+(defun nnmaildir--delete-dir-files (dir ls)
+ (when (file-attributes dir)
+ (mapc 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
+ (delete-directory dir)))
+
+(defun nnmaildir--group-maxnum (server group)
+ (catch 'return
+ (if (zerop (nnmaildir--grp-count group)) (throw 'return 0))
+ (let ((dir (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
+ (nnmaildir--grp-name group)))
+ (number-opened 1)
+ attr ino-opened nlink number-linked)
+ (setq dir (nnmaildir--nndir dir)
+ dir (nnmaildir--num-dir dir))
+ (while t
+ (setq attr (file-attributes
+ (concat dir (number-to-string number-opened))))
+ (or attr (throw 'return (1- number-opened)))
+ (setq ino-opened (nth 10 attr)
+ nlink (nth 1 attr)
+ number-linked (+ number-opened nlink))
+ (if (or (< nlink 1) (< number-linked nlink))
+ (signal 'error '("Arithmetic overflow")))
+ (setq attr (file-attributes
+ (concat dir (number-to-string number-linked))))
+ (or attr (throw 'return (1- number-linked)))
+ (unless (equal ino-opened (nth 10 attr))
+ (setq number-opened number-linked))))))
+
+;; Make the given server, if non-nil, be the current server. Then make the
+;; given group, if non-nil, be the current group of the current server. Then
+;; return the group object for the current group.
(defun nnmaildir--prepare (server group)
(let (x groups)
(catch 'return
- (setq x nnmaildir--tmp-server)
- (when x
- (set (intern (nnmaildir--srv-get-name x) nnmaildir--servers) x)
- (setq nnmaildir--tmp-server nil))
(if (null server)
- (or (setq server nnmaildir--cur-server)
- (throw 'return nil))
- (or (setq server (intern-soft server nnmaildir--servers))
+ (unless (setq server nnmaildir--cur-server)
(throw 'return nil))
+ (unless (setq server (intern-soft server nnmaildir--servers))
+ (throw 'return nil))
(setq server (symbol-value server)
nnmaildir--cur-server server))
- (setq groups (nnmaildir--srv-get-groups server))
- (if groups nil (throw 'return nil))
- (if (nnmaildir--srv-get-method server) nil
- (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server))
+ (unless (setq groups (nnmaildir--srv-groups server))
+ (throw 'return nil))
+ (unless (nnmaildir--srv-method server)
+ (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
x (gnus-server-to-method x))
- (if x nil (throw 'return nil))
- (nnmaildir--srv-set-method server x))
- (setq x (nnmaildir--srv-get-tmpgrp server))
- (when x
- (set (intern (nnmaildir--grp-get-name x) groups) x)
- (nnmaildir--srv-set-tmpgrp server nil))
+ (unless x (throw 'return nil))
+ (setf (nnmaildir--srv-method server) x))
(if (null group)
- (or (setq group (nnmaildir--srv-get-curgrp server))
- (throw 'return nil))
- (setq group (intern-soft group groups))
- (if group nil (throw 'return nil))
+ (unless (setq group (nnmaildir--srv-curgrp server))
+ (throw 'return nil))
+ (unless (setq group (intern-soft group groups))
+ (throw 'return nil))
(setq group (symbol-value group)))
- (nnmaildir--lists-fix (nnmaildir--grp-get-lists group))
group)))
-(defun nnmaildir--update-nov (srv-dir group article)
+(defun nnmaildir--tab-to-space (string)
+ (let ((pos 0))
+ (while (string-match "\t" string pos)
+ (aset string (match-beginning 0) ? )
+ (setq pos (match-end 0))))
+ string)
+
+(defmacro nnmaildir--condcase (errsym body &rest handler)
+ (declare (debug (sexp form body)))
+ `(condition-case ,errsym
+ (let ((system-messages-locale "C")) ,body)
+ (error . ,handler)))
+
+(defun nnmaildir--emlink-p (err)
+ (and (eq (car err) 'file-error)
+ (string= (downcase (caddr err)) "too many links")))
+
+(defun nnmaildir--enoent-p (err)
+ (and (eq (car err) 'file-error)
+ (string= (downcase (caddr err)) "no such file or directory")))
+
+(defun nnmaildir--eexist-p (err)
+ (eq (car err) 'file-already-exists))
+
+(defun nnmaildir--new-number (nndir)
+ "Allocate a new article number by atomically creating a file under NNDIR."
+ (let ((numdir (nnmaildir--num-dir nndir))
+ (make-new-file t)
+ (number-open 1)
+ number-link previous-number-link path-open path-link ino-open)
+ (nnmaildir--mkdir numdir)
+ (catch 'return
+ (while t
+ (setq path-open (concat numdir (number-to-string number-open)))
+ (if (not make-new-file)
+ (setq previous-number-link number-link)
+ (nnmaildir--mkfile&nbs
projects / gnus / blobdiff