git.chise.org Git - elisp/gnus.git-/blob - lisp/nnmaildir.el

   1 ;;; nnmaildir.el --- maildir backend for Gnus
   2 ;; Copyright (c) 2001, 2002 Free Software Foundation, Inc.
   3 ;; Copyright (c) 2000, 2001 Paul Jarc <prj@po.cwru.edu>
   4
   5 ;; Author: Paul Jarc <prj@po.cwru.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Maildir format is documented in the maildir(5) man page from qmail
  27 ;; and at <URL:http://cr.yp.to/proto/maildir.html>.  nnmaildir also
  28 ;; stores extra information in the .nnmaildir/ directory within a
  29 ;; maildir.
  30 ;;
  31 ;; Some goals of nnmaildir:
  32 ;; * Everything Just Works, and correctly.  E.g., stale NOV data is
  33 ;;   ignored; no need for -generate-nov-databases.
  34 ;; * Perfect reliability: [C-g] will never corrupt its data in memory,
  35 ;;   and SIGKILL will never corrupt its data in the filesystem.
  36 ;; * We make it easy to manipulate marks, etc., from outside Gnus.
  37 ;; * All information about a group is stored in the maildir, for easy
  38 ;;   backup, copying, restoring, etc.
  39 ;; * We use the filesystem as a database.
  40 ;;
  41 ;; Todo:
  42 ;; * Don't force article renumbering, so nnmaildir can be used with
  43 ;;   the cache and agent.  Alternatively, completely rewrite the Gnus
  44 ;;   backend interface, which would have other advantages.
  45 ;;
  46 ;; See also <URL:http://multivac.cwru.edu./nnmaildir/> until that
  47 ;; information is added to the Gnus manual.
  48
  49 ;;; Code:
  50
  51 (eval-and-compile
  52   (require 'nnheader)
  53   (require 'gnus)
  54   (require 'gnus-util)
  55   (require 'gnus-range)
  56   (require 'gnus-start)
  57   (require 'gnus-int)
  58   (require 'message))
  59 (eval-when-compile
  60   (require 'cl)
  61   (require 'nnmail))
  62
  63 (defconst nnmaildir-version "Gnus")
  64
  65 (defvar nnmaildir-article-file-name nil
  66   "*The filename of the most recently requested article.  This variable is set
  67 by nnmaildir-request-article.")
  68
  69 ;; The filename of the article being moved/copied:
  70 (defvar nnmaildir--file nil)
  71
  72 ;; Variables to generate filenames of messages being delivered:
  73 (defvar   nnmaildir--delivery-time "")
  74 (defconst nnmaildir--delivery-pid  (number-to-string (emacs-pid)))
  75 (defvar   nnmaildir--delivery-ct   nil)
  76
  77 ;; An obarry containing symbols whose names are server names and whose values
  78 ;; are servers:
  79 (defvar nnmaildir--servers (make-vector 3 0))
  80 ;; A server which has not necessarily been added to nnmaildir--servers, or nil:
  81 (defvar nnmaildir--tmp-server nil)
  82 ;; The current server:
  83 (defvar nnmaildir--cur-server nil)
  84
  85 ;; A server is a vector:
  86 ["server-name"
  87  select-method
  88  "/expanded/path/to/directory/containing/symlinks/to/maildirs/"
  89  directory-files-function
  90  group-name-transformation-function
  91  ;; An obarray containing symbols whose names are group names and whose values
  92  ;; are groups:
  93  group-hash
  94  ;; A group which has not necessarily been added to the group hash, or nil:
  95  tmp-group
  96  current-group ;; or nil
  97  "Last error message, or nil"
  98  directory-modtime
  99  get-new-mail-p ;; Should we split mail from mail-sources?
 100  "new/group/creation/directory"]
 101
 102 ;; A group is a vector:
 103 ["group.name"
 104  "prefixed:group.name"
 105  ;; Modification times of the "new", and "cur" directories:
 106  new-modtime
 107  cur-modtime
 108  ;; A vector containing lists of articles:
 109  [;; A list of articles, with article numbers in descending order, ending with
 110   ;; article 1:
 111   article-list
 112   ;; An obarray containing symbols whose names are filename prefixes and whose
 113   ;; values are articles:
 114   file-hash
 115   ;; Same as above, but keyed on Message-ID:
 116   msgid-hash
 117   ;; An article which has not necessarily been added to the file and msgid
 118   ;; hashes, or nil:
 119   tmp-article]
 120  ;; A vector containing nil, or articles with NOV data:
 121  nov-cache
 122  ;; The index of the next nov-cache entry to be replaced:
 123  nov-cache-index
 124  ;; An obarray containing symbols whose names are mark names and whose values
 125  ;; are modtimes of mark directories:
 126  mark-modtime-hash]
 127
 128 ;; An article is a vector:
 129 ["file.name.prefix"
 130  ":2,suffix" ;; or 'expire if expired
 131  number
 132  "msgid"
 133  ;; A NOV data vector, or nil:
 134  ["subject\tfrom\tdate"
 135   "references\tchars\lines"
 136   "extra"
 137   article-file-modtime
 138   ;; The value of nnmail-extra-headers when this NOV data was parsed:
 139   (to in-reply-to)]]
 140
 141 (defmacro nnmaildir--srv-new () '(make-vector 11 nil))
 142 (defmacro nnmaildir--srv-get-name       (server) `(aref ,server  0))
 143 (defmacro nnmaildir--srv-get-method     (server) `(aref ,server  1))
 144 (defmacro nnmaildir--srv-get-dir        (server) `(aref ,server  2))
 145 (defmacro nnmaildir--srv-get-ls         (server) `(aref ,server  3))
 146 (defmacro nnmaildir--srv-get-groups     (server) `(aref ,server  4))
 147 (defmacro nnmaildir--srv-get-tmpgrp     (server) `(aref ,server  5))
 148 (defmacro nnmaildir--srv-get-curgrp     (server) `(aref ,server  6))
 149 (defmacro nnmaildir--srv-get-error      (server) `(aref ,server  7))
 150 (defmacro nnmaildir--srv-get-mtime      (server) `(aref ,server  8))
 151 (defmacro nnmaildir--srv-get-gnm        (server) `(aref ,server  9))
 152 (defmacro nnmaildir--srv-get-create-dir (server) `(aref ,server 10))
 153 (defmacro nnmaildir--srv-set-name       (server val) `(aset ,server  0 ,val))
 154 (defmacro nnmaildir--srv-set-method     (server val) `(aset ,server  1 ,val))
 155 (defmacro nnmaildir--srv-set-dir        (server val) `(aset ,server  2 ,val))
 156 (defmacro nnmaildir--srv-set-ls         (server val) `(aset ,server  3 ,val))
 157 (defmacro nnmaildir--srv-set-groups     (server val) `(aset ,server  4 ,val))
 158 (defmacro nnmaildir--srv-set-tmpgrp     (server val) `(aset ,server  5 ,val))
 159 (defmacro nnmaildir--srv-set-curgrp     (server val) `(aset ,server  6 ,val))
 160 (defmacro nnmaildir--srv-set-error      (server val) `(aset ,server  7 ,val))
 161 (defmacro nnmaildir--srv-set-mtime      (server val) `(aset ,server  8 ,val))
 162 (defmacro nnmaildir--srv-set-gnm        (server val) `(aset ,server  9 ,val))
 163 (defmacro nnmaildir--srv-set-create-dir (server val) `(aset ,server 10 ,val))
 164
 165 (defmacro nnmaildir--grp-new () '(make-vector 8 nil))
 166 (defmacro nnmaildir--grp-get-name   (group) `(aref ,group 0))
 167 (defmacro nnmaildir--grp-get-pname  (group) `(aref ,group 1))
 168 (defmacro nnmaildir--grp-get-new    (group) `(aref ,group 2))
 169 (defmacro nnmaildir--grp-get-cur    (group) `(aref ,group 3))
 170 (defmacro nnmaildir--grp-get-lists  (group) `(aref ,group 4))
 171 (defmacro nnmaildir--grp-get-cache  (group) `(aref ,group 5))
 172 (defmacro nnmaildir--grp-get-index  (group) `(aref ,group 6))
 173 (defmacro nnmaildir--grp-get-mmth   (group) `(aref ,group 7))
 174 (defmacro nnmaildir--grp-set-name   (group val) `(aset ,group 0 ,val))
 175 (defmacro nnmaildir--grp-set-pname  (group val) `(aset ,group 1 ,val))
 176 (defmacro nnmaildir--grp-set-new    (group val) `(aset ,group 2 ,val))
 177 (defmacro nnmaildir--grp-set-cur    (group val) `(aset ,group 3 ,val))
 178 (defmacro nnmaildir--grp-set-lists  (group val) `(aset ,group 4 ,val))
 179 (defmacro nnmaildir--grp-set-cache  (group val) `(aset ,group 5 ,val))
 180 (defmacro nnmaildir--grp-set-index  (group val) `(aset ,group 6 ,val))
 181 (defmacro nnmaildir--grp-set-mmth   (group val) `(aset ,group 7 ,val))
 182
 183 (defmacro nnmaildir--lists-new () '(make-vector 4 nil))
 184 (defmacro nnmaildir--lists-get-nlist  (lists) `(aref ,lists 0))
 185 (defmacro nnmaildir--lists-get-flist  (lists) `(aref ,lists 1))
 186 (defmacro nnmaildir--lists-get-mlist  (lists) `(aref ,lists 2))
 187 (defmacro nnmaildir--lists-get-tmpart (lists) `(aref ,lists 3))
 188 (defmacro nnmaildir--lists-set-nlist  (lists val) `(aset ,lists 0 ,val))
 189 (defmacro nnmaildir--lists-set-flist  (lists val) `(aset ,lists 1 ,val))
 190 (defmacro nnmaildir--lists-set-mlist  (lists val) `(aset ,lists 2 ,val))
 191 (defmacro nnmaildir--lists-set-tmpart (lists val) `(aset ,lists 3 ,val))
 192
 193 (defmacro nnmaildir--nlist-last-num (list)
 194   `(if ,list (nnmaildir--art-get-num (car ,list)) 0))
 195 (defmacro nnmaildir--nlist-art (list num)
 196   `(and ,list
 197         (>= (nnmaildir--art-get-num (car ,list)) ,num)
 198         (nth (- (nnmaildir--art-get-num (car ,list)) ,num) ,list)))
 199 (defmacro nnmaildir--flist-art (list file)
 200   `(symbol-value (intern-soft ,file ,list)))
 201 (defmacro nnmaildir--mlist-art (list msgid)
 202   `(symbol-value (intern-soft ,msgid ,list)))
 203
 204 (defmacro nnmaildir--art-new () '(make-vector 5 nil))
 205 (defmacro nnmaildir--art-get-prefix (article) `(aref ,article 0))
 206 (defmacro nnmaildir--art-get-suffix (article) `(aref ,article 1))
 207 (defmacro nnmaildir--art-get-num    (article) `(aref ,article 2))
 208 (defmacro nnmaildir--art-get-msgid  (article) `(aref ,article 3))
 209 (defmacro nnmaildir--art-get-nov    (article) `(aref ,article 4))
 210 (defmacro nnmaildir--art-set-prefix (article val) `(aset ,article 0 ,val))
 211 (defmacro nnmaildir--art-set-suffix (article val) `(aset ,article 1 ,val))
 212 (defmacro nnmaildir--art-set-num    (article val) `(aset ,article 2 ,val))
 213 (defmacro nnmaildir--art-set-msgid  (article val) `(aset ,article 3 ,val))
 214 (defmacro nnmaildir--art-set-nov    (article val) `(aset ,article 4 ,val))
 215
 216 (defmacro nnmaildir--nov-new () '(make-vector 5 nil))
 217 (defmacro nnmaildir--nov-get-beg   (nov) `(aref ,nov 0))
 218 (defmacro nnmaildir--nov-get-mid   (nov) `(aref ,nov 1))
 219 (defmacro nnmaildir--nov-get-end   (nov) `(aref ,nov 2))
 220 (defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
 221 (defmacro nnmaildir--nov-get-neh   (nov) `(aref ,nov 4))
 222 (defmacro nnmaildir--nov-set-beg   (nov val) `(aset ,nov 0 ,val))
 223 (defmacro nnmaildir--nov-set-mid   (nov val) `(aset ,nov 1 ,val))
 224 (defmacro nnmaildir--nov-set-end   (nov val) `(aset ,nov 2 ,val))
 225 (defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val))
 226 (defmacro nnmaildir--nov-set-neh   (nov val) `(aset ,nov 4 ,val))
 227
 228 (defmacro nnmaildir--srv-grp-dir (srv-dir gname)
 229   `(file-name-as-directory (concat ,srv-dir ,gname)))
 230
 231 (defun nnmaildir--param (prefixed-group-name param)
 232   (setq param
 233         (gnus-group-find-parameter prefixed-group-name param 'allow-list)
 234         param (if (vectorp param) (aref param 0) param))
 235   (eval param))
 236
 237 (defmacro nnmaildir--unlink (file)
 238   `(if (file-attributes ,file) (delete-file ,file)))
 239
 240 (defmacro nnmaildir--tmp (dir) `(file-name-as-directory (concat ,dir "tmp")))
 241 (defmacro nnmaildir--new (dir) `(file-name-as-directory (concat ,dir "new")))
 242 (defmacro nnmaildir--cur (dir) `(file-name-as-directory (concat ,dir "cur")))
 243 (defmacro nnmaildir--nndir (dir)
 244   `(file-name-as-directory (concat ,dir ".nnmaildir")))
 245
 246 (defun nnmaildir--lists-fix (lists)
 247   (let ((tmp (nnmaildir--lists-get-tmpart lists)))
 248     (when tmp
 249       (set (intern (nnmaildir--art-get-prefix tmp)
 250                    (nnmaildir--lists-get-flist lists))
 251            tmp)
 252       (set (intern (nnmaildir--art-get-msgid tmp)
 253                    (nnmaildir--lists-get-mlist lists))
 254            tmp)
 255       (nnmaildir--lists-set-tmpart lists nil))))
 256
 257 (defun nnmaildir--prepare (server group)
 258   (let (x groups)
 259     (catch 'return
 260       (setq x nnmaildir--tmp-server)
 261       (when x
 262         (set (intern (nnmaildir--srv-get-name x) nnmaildir--servers) x)
 263         (setq nnmaildir--tmp-server nil))
 264       (if (null server)
 265           (or (setq server nnmaildir--cur-server)
 266               (throw 'return nil))
 267         (or (setq server (intern-soft server nnmaildir--servers))
 268             (throw 'return nil))
 269         (setq server (symbol-value server)
 270               nnmaildir--cur-server server))
 271       (setq groups (nnmaildir--srv-get-groups server))
 272       (if groups nil (throw 'return nil))
 273       (if (nnmaildir--srv-get-method server) nil
 274         (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server))
 275               x (gnus-server-to-method x))
 276         (if x nil (throw 'return nil))
 277         (nnmaildir--srv-set-method server x))
 278       (setq x (nnmaildir--srv-get-tmpgrp server))
 279       (when x
 280         (set (intern (nnmaildir--grp-get-name x) groups) x)
 281         (nnmaildir--srv-set-tmpgrp server nil))
 282       (if (null group)
 283           (or (setq group (nnmaildir--srv-get-curgrp server))
 284               (throw 'return nil))
 285         (setq group (intern-soft group groups))
 286         (if group nil (throw 'return nil))
 287         (setq group (symbol-value group)))
 288       (nnmaildir--lists-fix (nnmaildir--grp-get-lists group))
 289       group)))
 290
 291 (defun nnmaildir--update-nov (srv-dir group article)
 292   (let ((nnheader-file-coding-system 'binary)
 293         dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
 294         nov msgid nov-beg nov-mid nov-end field pos extra val old-neh new-neh
 295         deactivate-mark)
 296     (catch 'return
 297       (setq suffix (nnmaildir--art-get-suffix article))
 298       (if (stringp suffix) nil
 299         (nnmaildir--art-set-nov article nil)
 300         (throw 'return nil))
 301       (setq gname (nnmaildir--grp-get-name group)
 302             pgname (nnmaildir--grp-get-pname group)
 303             dir (nnmaildir--srv-grp-dir srv-dir gname)
 304             msgdir (if (nnmaildir--param pgname 'read-only)
 305                        (nnmaildir--new dir) (nnmaildir--cur dir))
 306             prefix (nnmaildir--art-get-prefix article)
 307             file (concat msgdir prefix suffix)
 308             attr (file-attributes file))
 309       (if attr nil
 310         (nnmaildir--art-set-suffix article 'expire)
 311         (nnmaildir--art-set-nov article nil)
 312         (throw 'return nil))
 313       (setq mtime (nth 5 attr)
 314             attr (nth 7 attr)
 315             nov (nnmaildir--art-get-nov article)
 316             novdir (concat (nnmaildir--nndir dir) "nov")
 317             novdir (file-name-as-directory novdir)
 318             novfile (concat novdir prefix))
 319       (save-excursion
 320         (set-buffer (get-buffer-create " *nnmaildir nov*"))
 321         (when (file-exists-p novfile) ;; If not, force reparsing the message.
 322           (if nov nil ;; It's already in memory.
 323             ;; Else read the data from the NOV file.
 324             (erase-buffer)
 325             (nnheader-insert-file-contents novfile)
 326             (setq nov (read (current-buffer)))
 327             (nnmaildir--art-set-msgid article (car nov))
 328             (setq nov (cadr nov)))
 329           ;; If the NOV's modtime matches the file's current modtime,
 330           ;; and it has the right length (i.e., it wasn't produced by
 331           ;; a too-much older version of nnmaildir), then we may use
 332           ;; this NOV data rather than parsing the message file,
 333           ;; unless nnmail-extra-headers has been augmented since this
 334           ;; data was last parsed.
 335           (when (and (equal mtime (nnmaildir--nov-get-mtime nov))
 336                      (= (length nov) (length (nnmaildir--nov-new))))
 337             ;; This NOV data is potentially up-to-date.
 338             (setq old-neh (nnmaildir--nov-get-neh nov)
 339                   new-neh nnmail-extra-headers)
 340             (if (equal new-neh old-neh) (throw 'return nov)) ;; Common case.
 341             ;; They're not equal, but maybe the new is a subset of the old...
 342             (if (null new-neh) (throw 'return nov))
 343             (while new-neh
 344               (if (memq (car new-neh) old-neh)
 345                   (progn
 346                     (setq new-neh (cdr new-neh))
 347                     (if new-neh nil (throw 'return nov)))
 348                 (setq new-neh nil)))))
 349         ;; Parse the NOV data out of the message.
 350         (erase-buffer)
 351         (nnheader-insert-file-contents file)
 352         (insert "\n")
 353         (goto-char (point-min))
 354         (save-restriction
 355           (if (search-forward "\n\n" nil 'noerror)
 356               (progn
 357                 (setq nov-mid (count-lines (point) (point-max)))
 358                 (narrow-to-region (point-min) (1- (point))))
 359             (setq nov-mid 0))
 360           (goto-char (point-min))
 361           (delete-char 1)
 362           (nnheader-fold-continuation-lines)
 363           (setq nov (nnheader-parse-head 'naked)
 364                 field (or (mail-header-lines nov) 0)))
 365         (if (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) nil
 366           (setq nov-mid field))
 367         (setq nov-mid (number-to-string nov-mid)
 368               nov-mid (concat (number-to-string attr) "\t" nov-mid)
 369               field (or (mail-header-references nov) "")
 370               pos 0)
 371         (save-match-data
 372           (while (string-match "\t" field pos)
 373             (aset field (match-beginning 0) ? )
 374             (setq pos (match-end 0)))
 375           (setq nov-mid (concat field "\t" nov-mid)
 376                 extra (mail-header-extra nov)
 377                 nov-end "")
 378           (while extra
 379             (setq field (car extra) extra (cdr extra)
 380                   val (cdr field) field (symbol-name (car field))
 381                   pos 0)
 382             (while (string-match "\t" field pos)
 383               (aset field (match-beginning 0) ? )
 384               (setq pos (match-end 0)))
 385             (setq pos 0)
 386             (while (string-match "\t" val pos)
 387               (aset val (match-beginning 0) ? )
 388               (setq pos (match-end 0)))
 389             (setq nov-end (concat nov-end "\t" field ": " val)))
 390           (setq nov-end (if (zerop (length nov-end)) "" (substring nov-end 1))
 391                 field (or (mail-header-subject nov) "")
 392                 pos 0)
 393           (while (string-match "\t" field pos)
 394             (aset field (match-beginning 0) ? )
 395             (setq pos (match-end 0)))
 396           (setq nov-beg field
 397                 field (or (mail-header-from nov) "")
 398                 pos 0)
 399           (while (string-match "\t" field pos)
 400             (aset field (match-beginning 0) ? )
 401             (setq pos (match-end 0)))
 402           (setq nov-beg (concat nov-beg "\t" field)
 403                 field (or (mail-header-date nov) "")
 404                 pos 0)
 405           (while (string-match "\t" field pos)
 406             (aset field (match-beginning 0) ? )
 407             (setq pos (match-end 0)))
 408           (setq nov-beg (concat nov-beg "\t" field)
 409                 field (mail-header-id nov)
 410                 pos 0)
 411           (while (string-match "\t" field pos)
 412             (aset field (match-beginning 0) ? )
 413             (setq pos (match-end 0)))
 414           (setq msgid field))
 415         (if (or (null msgid) (nnheader-fake-message-id-p msgid))
 416             (setq msgid (concat "<" prefix "@nnmaildir>")))
 417         (erase-buffer)
 418         (setq nov (nnmaildir--nov-new))
 419         (nnmaildir--nov-set-beg nov nov-beg)
 420         (nnmaildir--nov-set-mid nov nov-mid)
 421         (nnmaildir--nov-set-end nov nov-end)
 422         (nnmaildir--nov-set-mtime nov mtime)
 423         (nnmaildir--nov-set-neh nov (copy-sequence nnmail-extra-headers))
 424         (prin1 (list msgid nov) (current-buffer))
 425         (setq file (concat novfile ":"))
 426         (nnmaildir--unlink file)
 427         (write-region (point-min) (point-max) file nil 'no-message))
 428       (rename-file file novfile 'replace)
 429       (nnmaildir--art-set-msgid article msgid)
 430       nov)))
 431
 432 (defun nnmaildir--cache-nov (group article nov)
 433   (let ((cache (nnmaildir--grp-get-cache group))
 434         (index (nnmaildir--grp-get-index group))
 435         goner)
 436     (if (nnmaildir--art-get-nov article) nil
 437       (setq goner (aref cache index))
 438       (if goner (nnmaildir--art-set-nov goner nil))
 439       (aset cache index article)
 440       (nnmaildir--grp-set-index group (% (1+ index) (length cache))))
 441     (nnmaildir--art-set-nov article nov)))
 442
 443 (defun nnmaildir--grp-add-art (srv-dir group article)
 444   (let ((nov (nnmaildir--update-nov srv-dir group article))
 445         old-lists new-lists)
 446     (when nov
 447       (setq old-lists (nnmaildir--grp-get-lists group)
 448             new-lists (nnmaildir--lists-new))
 449       (nnmaildir--lists-set-nlist
 450         new-lists (cons article (nnmaildir--lists-get-nlist old-lists)))
 451       (nnmaildir--lists-set-flist new-lists
 452                                   (nnmaildir--lists-get-flist old-lists))
 453       (nnmaildir--lists-set-mlist new-lists
 454                                   (nnmaildir--lists-get-mlist old-lists))
 455       (nnmaildir--lists-set-tmpart new-lists article)
 456       (nnmaildir--grp-set-lists group new-lists)
 457       (nnmaildir--lists-fix new-lists)
 458       (nnmaildir--cache-nov group article nov)
 459       t)))
 460
 461 (defun nnmaildir--mkdir (dir)
 462   (or (file-exists-p (file-name-as-directory dir))
 463       (make-directory-internal (directory-file-name dir))))
 464
 465 (defun nnmaildir--article-count (group)
 466   (let ((ct 0)
 467         (min 0))
 468     (setq group (nnmaildir--grp-get-lists group)
 469           group (nnmaildir--lists-get-nlist group))
 470     (while group
 471       (if (stringp (nnmaildir--art-get-suffix (car group)))
 472           (setq ct (1+ ct)
 473                 min (nnmaildir--art-get-num (car group))))
 474       (setq group (cdr group)))
 475     (cons ct min)))
 476
 477 (defun nnmaildir-article-number-to-file-name
 478        (number group-name server-address-string)
 479   (let ((group (nnmaildir--prepare server-address-string group-name))
 480         list article suffix dir filename)
 481     (catch 'return
 482       (if (null group)
 483           ;; The given group or server does not exist.
 484           (throw 'return nil))
 485       (setq list (nnmaildir--grp-get-lists group)
 486             list (nnmaildir--lists-get-nlist list)
 487             article (nnmaildir--nlist-art list number))
 488       (if (null article)
 489           ;; The given article number does not exist in this group.
 490           (throw 'return nil))
 491       (setq suffix (nnmaildir--art-get-suffix article))
 492       (if (not (stringp suffix))
 493           ;; The article has expired.
 494           (throw 'return nil))
 495       (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
 496             dir (nnmaildir--srv-grp-dir dir group-name)
 497             group (if (nnmaildir--param (nnmaildir--grp-get-pname group)
 498                                         'read-only)
 499                       (nnmaildir--new dir) (nnmaildir--cur dir))
 500             filename (concat group (nnmaildir--art-get-prefix article) suffix))
 501       (if (file-exists-p filename)
 502           filename
 503         ;; The article disappeared out from under us.
 504         (nnmaildir--art-set-suffix article 'expire)
 505         (nnmaildir--art-set-nov article nil)
 506         nil))))
 507
 508 (defun nnmaildir-request-type (group &optional article)
 509   'mail)
 510
 511 (defun nnmaildir-status-message (&optional server)
 512   (nnmaildir--prepare server nil)
 513   (nnmaildir--srv-get-error nnmaildir--cur-server))
 514
 515 (defun nnmaildir-server-opened (&optional server)
 516   (and nnmaildir--cur-server
 517        (if server
 518            (string-equal server
 519                          (nnmaildir--srv-get-name nnmaildir--cur-server))
 520          t)
 521        (nnmaildir--srv-get-groups nnmaildir--cur-server)
 522        t))
 523
 524 (defun nnmaildir-open-server (server &optional defs)
 525   (let ((x server)
 526         dir size)
 527     (catch 'return
 528       (setq server (intern-soft x nnmaildir--servers))
 529       (if server
 530           (and (setq server (symbol-value server))
 531                (nnmaildir--srv-get-groups server)
 532                (setq nnmaildir--cur-server server)
 533                (throw 'return t))
 534         (setq server (nnmaildir--srv-new))
 535         (nnmaildir--srv-set-name server x)
 536         (setq nnmaildir--tmp-server server)
 537         (set (intern x nnmaildir--servers) server)
 538         (setq nnmaildir--tmp-server nil))
 539       (setq dir (assq 'directory defs))
 540       (if dir nil
 541         (nnmaildir--srv-set-error
 542           server "You must set \"directory\" in the select method")
 543         (throw 'return nil))
 544       (setq dir (cadr dir)
 545             dir (eval dir)
 546             dir (expand-file-name dir)
 547             dir (file-name-as-directory dir))
 548       (if (file-exists-p dir) nil
 549         (nnmaildir--srv-set-error server (concat "No such directory: " dir))
 550         (throw 'return nil))
 551       (nnmaildir--srv-set-dir server dir)
 552       (setq x (assq 'directory-files defs))
 553       (if (null x)
 554           (setq x (symbol-function (if nnheader-directory-files-is-safe
 555                                        'directory-files
 556                                      'nnheader-directory-files-safe)))
 557         (setq x (cadr x))
 558         (if (functionp x) nil
 559           (nnmaildir--srv-set-error
 560             server (concat "Not a function: " (prin1-to-string x)))
 561           (throw 'return nil)))
 562       (nnmaildir--srv-set-ls server x)
 563       (setq x (funcall x dir nil "\\`[^.]" 'nosort)
 564             x (length x)
 565             size 1)
 566       (while (<= size x) (setq size (* 2 size)))
 567       (if (/= size 1) (setq size (1- size)))
 568       (and (setq x (assq 'get-new-mail defs))
 569            (setq x (cdr x))
 570            (car x)
 571            (nnmaildir--srv-set-gnm server t)
 572            (require 'nnmail))
 573       (setq x (assq 'create-directory defs))
 574       (when x
 575         (setq x (cadr x)
 576               x (eval x))
 577         (nnmaildir--srv-set-create-dir server x))
 578       (nnmaildir--srv-set-groups server (make-vector size 0))
 579       (setq nnmaildir--cur-server server)
 580       t)))
 581
 582 (defun nnmaildir--parse-filename (file)
 583   (let ((prefix (car file))
 584         timestamp len)
 585     (if (string-match
 586           "\\`\\([0-9]+\\)\\.\\([0-9]+\\)\\(_\\([0-9]+\\)\\)?\\(\\..*\\)\\'"
 587           prefix)
 588         (progn
 589           (setq timestamp (concat "0000" (match-string 1 prefix))
 590                 len (- (length timestamp) 4))
 591           (vector (string-to-number (substring timestamp 0 len))
 592                   (string-to-number (substring timestamp len))
 593                   (string-to-number (match-string 2 prefix))
 594                   (string-to-number (or (match-string 4 prefix) "-1"))
 595                   (match-string 5 prefix)
 596                   file))
 597       file)))
 598
 599 (defun nnmaildir--sort-files (a b)
 600   (catch 'return
 601     (if (consp a)
 602         (throw 'return (and (consp b) (string-lessp (car a) (car b)))))
 603     (if (consp b) (throw 'return t))
 604     (if (< (aref a 0) (aref b 0)) (throw 'return t))
 605     (if (> (aref a 0) (aref b 0)) (throw 'return nil))
 606     (if (< (aref a 1) (aref b 1)) (throw 'return t))
 607     (if (> (aref a 1) (aref b 1)) (throw 'return nil))
 608     (if (< (aref a 2) (aref b 2)) (throw 'return t))
 609     (if (> (aref a 2) (aref b 2)) (throw 'return nil))
 610     (if (< (aref a 3) (aref b 3)) (throw 'return t))
 611     (if (> (aref a 3) (aref b 3)) (throw 'return nil))
 612     (string-lessp (aref a 4) (aref b 4))))
 613
 614 (defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls)
 615   (catch 'return
 616     (let ((36h-ago (- (car (current-time)) 2))
 617           absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
 618           files file num dir flist group x)
 619       (setq absdir (file-name-as-directory (concat srv-dir gname))
 620             nndir (nnmaildir--nndir absdir))
 621       (if (file-attributes absdir) nil
 622         (nnmaildir--srv-set-error nnmaildir--cur-server
 623                                   (concat "No such directory: " absdir))
 624         (throw 'return nil))
 625       (setq tdir (nnmaildir--tmp absdir)
 626             ndir (nnmaildir--new absdir)
 627             cdir (nnmaildir--cur absdir)
 628             nattr (file-attributes ndir)
 629             cattr (file-attributes cdir))
 630       (if (and (file-exists-p tdir) nattr cattr) nil
 631         (nnmaildir--srv-set-error nnmaildir--cur-server
 632                                   (concat "Not a maildir: " absdir))
 633         (throw 'return nil))
 634       (setq group (nnmaildir--prepare nil gname))
 635       (if group
 636           (setq isnew nil
 637                 pgname (nnmaildir--grp-get-pname group))
 638         (setq isnew t
 639               group (nnmaildir--grp-new)
 640               pgname (gnus-group-prefixed-name gname method))
 641         (nnmaildir--grp-set-name group gname)
 642         (nnmaildir--grp-set-pname group pgname)
 643         (nnmaildir--grp-set-lists group (nnmaildir--lists-new))
 644         (nnmaildir--grp-set-index group 0)
 645         (nnmaildir--mkdir nndir)
 646         (nnmaildir--mkdir (concat nndir "nov"))
 647         (nnmaildir--mkdir (concat nndir "marks"))
 648         (write-region "" nil (concat nndir "markfile") nil 'no-message))
 649       (setq read-only (nnmaildir--param pgname 'read-only)
 650             ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
 651       (if read-only nil
 652         (setq x (nth 11 (file-attributes tdir)))
 653         (if (and (= x (nth 11 nattr)) (= x (nth 11 cattr))) nil
 654           (nnmaildir--srv-set-error nnmaildir--cur-server
 655                                     (concat "Maildir spans filesystems: "
 656                                             absdir))
 657           (throw 'return nil))
 658         (setq files (funcall ls tdir 'full "\\`[^.]" 'nosort))
 659         (while files
 660           (setq file (car files) files (cdr files)
 661                 x (file-attributes file))
 662           (if (or (< 1 (cadr x)) (> 36h-ago (car (nth 4 x))))
 663               (delete-file file))))
 664       (or scan-msgs
 665           isnew
 666           (throw 'return t))
 667       (setq nattr (nth 5 nattr))
 668       (if (equal nattr (nnmaildir--grp-get-new group))
 669           (setq nattr nil))
 670       (if read-only (setq dir (and (or isnew nattr) ndir))
 671         (when (or isnew nattr)
 672           (setq files (funcall ls ndir nil "\\`[^.]" 'nosort))
 673           (while files
 674             (setq file (car files) files (cdr files))
 675             (rename-file (concat ndir file) (concat cdir file ":2,")))
 676           (nnmaildir--grp-set-new group nattr))
 677         (setq cattr (file-attributes cdir)
 678               cattr (nth 5 cattr))
 679         (if (equal cattr (nnmaildir--grp-get-cur group))
 680             (setq cattr nil))
 681         (setq dir (and (or isnew cattr) cdir)))
 682       (if dir nil (throw 'return t))
 683       (setq files (funcall ls dir nil "\\`[^.]" 'nosort))
 684       (when isnew
 685         (setq x (length files)
 686               num 1)
 687         (while (<= num x) (setq num (* 2 num)))
 688         (if (/= num 1) (setq num (1- num)))
 689         (setq x (nnmaildir--grp-get-lists group))
 690         (nnmaildir--lists-set-flist x (make-vector num 0))
 691         (nnmaildir--lists-set-mlist x (make-vector num 0))
 692         (nnmaildir--grp-set-mmth group (make-vector 1 0))
 693         (setq num (nnmaildir--param pgname 'nov-cache-size))
 694         (if (numberp num) (if (< num 1) (setq num 1))
 695           (setq x files
 696                 num 16
 697                 cdir (file-name-as-directory (concat nndir "marks"))
 698                 ndir (file-name-as-directory (concat cdir "tick"))
 699                 cdir (file-name-as-directory (concat cdir "read")))
 700           (while x
 701             (setq file (car x) x (cdr x))
 702             (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
 703             (setq file (match-string 1 file))
 704             (if (or (not (file-exists-p (concat cdir file)))
 705                     (file-exists-p (concat ndir file)))
 706                 (setq num (1+ num)))))
 707         (nnmaildir--grp-set-cache group (make-vector num nil))
 708         (nnmaildir--srv-set-tmpgrp nnmaildir--cur-server group)
 709         (set (intern gname groups) group)
 710         (nnmaildir--srv-set-tmpgrp nnmaildir--cur-server nil)
 711         (or scan-msgs (throw 'return t)))
 712       (setq flist (nnmaildir--grp-get-lists group)
 713             num (nnmaildir--lists-get-nlist flist)
 714             flist (nnmaildir--lists-get-flist flist)
 715             num (nnmaildir--nlist-last-num num)
 716             x files
 717             files nil)
 718       (while x
 719         (setq file (car x) x (cdr x))
 720         (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
 721         (setq file (cons (match-string 1 file) (match-string 2 file)))
 722         (if (nnmaildir--flist-art flist (car file)) nil
 723           (setq files (cons file files))))
 724       (setq files (mapcar 'nnmaildir--parse-filename files)
 725             files (sort files 'nnmaildir--sort-files))
 726       (while files
 727         (setq file (car files) files (cdr files)
 728               file (if (consp file) file (aref file 5))
 729               x (nnmaildir--art-new))
 730         (nnmaildir--art-set-prefix x (car file))
 731         (nnmaildir--art-set-suffix x (cdr file))
 732         (nnmaildir--art-set-num x (1+ num))
 733         (if (nnmaildir--grp-add-art srv-dir group x)
 734             (setq num (1+ num))))
 735       (if read-only (nnmaildir--grp-set-new group nattr)
 736         (nnmaildir--grp-set-cur group cattr)))
 737     t))
 738
 739 (defun nnmaildir-request-scan (&optional scan-group server)
 740   (let ((coding-system-for-write nnheader-file-coding-system)
 741         (buffer-file-coding-system nil)
 742         (file-coding-system-alist nil)
 743         (nnmaildir-get-new-mail t)
 744         (nnmaildir-group-alist nil)
 745         (nnmaildir-active-file nil)
 746         x srv-ls srv-dir method groups group dirs grp-dir seen deactivate-mark)
 747     (nnmaildir--prepare server nil)
 748     (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server)
 749           srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
 750           method (nnmaildir--srv-get-method nnmaildir--cur-server)
 751           groups (nnmaildir--srv-get-groups nnmaildir--cur-server))
 752     (save-excursion
 753       (set-buffer (get-buffer-create " *nnmaildir work*"))
 754       (save-match-data
 755         (if (stringp scan-group)
 756             (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls)
 757                 (if (nnmaildir--srv-get-gnm nnmaildir--cur-server)
 758                     (nnmail-get-new-mail 'nnmaildir nil nil scan-group))
 759               (unintern scan-group groups))
 760           (setq x (nth 5 (file-attributes srv-dir)))
 761           (if (equal x (nnmaildir--srv-get-mtime nnmaildir--cur-server))
 762               (if scan-group nil
 763                 (mapatoms (lambda (sym)
 764                             (nnmaildir--scan (symbol-name sym) t groups
 765                                              method srv-dir srv-ls))
 766                           groups))
 767             (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
 768                   x (length dirs)
 769                   seen 1)
 770             (while (<= seen x) (setq seen (* 2 seen)))
 771             (if (/= seen 1) (setq seen (1- seen)))
 772             (setq seen (make-vector seen 0)
 773                   scan-group (null scan-group))
 774             (while dirs
 775               (setq grp-dir (car dirs) dirs (cdr dirs))
 776               (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
 777                                    srv-ls)
 778                   (intern grp-dir seen)))
 779             (setq x nil)
 780             (mapatoms (lambda (group)
 781                         (setq group (symbol-name group))
 782                         (if (intern-soft group seen) nil
 783                           (setq x (cons group x))))
 784                       groups)
 785             (while x
 786               (unintern (car x) groups)
 787               (setq x (cdr x)))
 788             (nnmaildir--srv-set-mtime nnmaildir--cur-server
 789                                       (nth 5 (file-attributes srv-dir))))
 790           (if (nnmaildir--srv-get-gnm nnmaildir--cur-server)
 791               (nnmail-get-new-mail 'nnmaildir nil nil))))))
 792   t)
 793
 794 (defun nnmaildir-request-list (&optional server)
 795   (nnmaildir-request-scan 'find-new-groups server)
 796   (let (pgname ro ct-min deactivate-mark)
 797     (nnmaildir--prepare server nil)
 798     (save-excursion
 799       (set-buffer nntp-server-buffer)
 800       (erase-buffer)
 801       (mapatoms (lambda (group)
 802                   (setq group (symbol-value group)
 803                         ro (nnmaildir--param (nnmaildir--grp-get-pname group)
 804                                              'read-only)
 805                         ct-min (nnmaildir--article-count group))
 806                   (insert (nnmaildir--grp-get-name group) " ")
 807                   (princ (car ct-min) nntp-server-buffer)
 808                   (insert " ")
 809                   (princ (cdr ct-min) nntp-server-buffer)
 810                   (insert " " (if ro "n" "y") "\n"))
 811                 (nnmaildir--srv-get-groups nnmaildir--cur-server))))
 812   t)
 813
 814 (defun nnmaildir-request-newgroups (date &optional server)
 815   (nnmaildir-request-list server))
 816
 817 (defun nnmaildir-retrieve-groups (groups &optional server)
 818   (let (gname group ct-min deactivate-mark)
 819     (nnmaildir--prepare server nil)
 820     (save-excursion
 821       (set-buffer nntp-server-buffer)
 822       (erase-buffer)
 823       (while groups
 824         (setq gname (car groups) groups (cdr groups))
 825         (nnmaildir-request-scan gname server)
 826         (setq group (nnmaildir--prepare nil gname))
 827         (if (null group) (insert "411 no such news group\n")
 828           (setq ct-min (nnmaildir--article-count group))
 829           (insert "211 ")
 830           (princ (car ct-min) nntp-server-buffer)
 831           (insert " ")
 832           (princ (cdr ct-min) nntp-server-buffer)
 833           (insert " ")
 834           (princ (nnmaildir--nlist-last-num
 835                    (nnmaildir--lists-get-nlist
 836                      (nnmaildir--grp-get-lists group)))
 837                  nntp-server-buffer)
 838           (insert " " gname "\n")))))
 839   'group)
 840
 841 (defun nnmaildir-request-update-info (gname info &optional server)
 842   (nnmaildir-request-scan gname server)
 843   (let ((group (nnmaildir--prepare server gname))
 844         srv-ls pgname nlist flist last always-marks never-marks old-marks
 845         dotfile num dir markdirs marks mark ranges articles article read end
 846         new-marks ls old-mmth new-mmth mtime mark-sym deactivate-mark)
 847     (catch 'return
 848       (if group nil
 849         (nnmaildir--srv-set-error nnmaildir--cur-server
 850                                   (concat "No such group: " gname))
 851         (throw 'return nil))
 852       (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server)
 853             gname (nnmaildir--grp-get-name group)
 854             pgname (nnmaildir--grp-get-pname group)
 855             nlist (nnmaildir--grp-get-lists group)
 856             flist (nnmaildir--lists-get-flist nlist)
 857             nlist (nnmaildir--lists-get-nlist nlist))
 858       (if nlist nil
 859         (gnus-info-set-read info nil)
 860         (gnus-info-set-marks info nil 'extend)
 861         (throw 'return info))
 862       (setq old-marks (cons 'read (gnus-info-read info))
 863             old-marks (cons old-marks (gnus-info-marks info))
 864             last (nnmaildir--nlist-last-num nlist)
 865             always-marks (nnmaildir--param pgname 'always-marks)
 866             never-marks (nnmaildir--param pgname 'never-marks)
 867             dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
 868             dir (nnmaildir--srv-grp-dir dir gname)
 869             dir (nnmaildir--nndir dir)
 870             dir (concat dir "marks")
 871             dir (file-name-as-directory dir)
 872             ls (nnmaildir--param pgname 'directory-files)
 873             ls (or ls srv-ls)
 874             markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
 875             num (length markdirs)
 876             new-mmth 1)
 877       (while (<= new-mmth num) (setq new-mmth (* 2 new-mmth)))
 878       (if (/= new-mmth 1) (setq new-mmth (1- new-mmth)))
 879       (setq new-mmth (make-vector new-mmth 0)
 880             old-mmth (nnmaildir--grp-get-mmth group))
 881       (while markdirs
 882         (setq mark (car markdirs) markdirs (cdr markdirs)
 883               articles (concat dir mark)
 884               articles (file-name-as-directory articles)
 885               mark-sym (intern mark)
 886               ranges nil)
 887         (catch 'got-ranges
 888           (if (memq mark-sym never-marks) (throw 'got-ranges nil))
 889           (when (memq mark-sym always-marks)
 890             (setq ranges (list (cons 1 last)))
 891             (throw 'got-ranges nil))
 892           (setq mtime (file-attributes articles)
 893                 mtime (nth 5 mtime))
 894           (set (intern mark new-mmth) mtime)
 895           (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
 896             (setq ranges (assq mark-sym old-marks))
 897             (if ranges (setq ranges (cdr ranges)))
 898             (throw 'got-ranges nil))
 899           (setq articles (funcall ls articles nil "\\`[^.]" 'nosort))
 900           (while articles
 901             (setq article (car articles) articles (cdr articles)
 902                   article (nnmaildir--flist-art flist article))
 903             (if article
 904                 (setq num (nnmaildir--art-get-num article)
 905                       ranges (gnus-add-to-range ranges (list num))))))
 906         (if (eq mark-sym 'read) (setq read ranges)
 907           (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
 908       (gnus-info-set-read info read)
 909       (gnus-info-set-marks info marks 'extend)
 910       (nnmaildir--grp-set-mmth group new-mmth)
 911       info)))
 912
 913 (defun nnmaildir-request-group (gname &optional server fast)
 914   (nnmaildir-request-scan gname server)
 915   (let ((group (nnmaildir--prepare server gname))
 916         ct-min deactivate-mark)
 917     (save-excursion
 918       (set-buffer nntp-server-buffer)
 919       (erase-buffer)
 920       (catch 'return
 921         (if group nil
 922           (insert "411 no such news group\n")
 923           (nnmaildir--srv-set-error nnmaildir--cur-server
 924                                     (concat "No such group: " gname))
 925           (throw 'return nil))
 926         (nnmaildir--srv-set-curgrp nnmaildir--cur-server group)
 927         (if fast (throw 'return t))
 928         (setq ct-min (nnmaildir--article-count group))
 929         (insert "211 ")
 930         (princ (car ct-min) nntp-server-buffer)
 931         (insert " ")
 932         (princ (cdr ct-min) nntp-server-buffer)
 933         (insert " ")
 934         (princ (nnmaildir--nlist-last-num
 935                  (nnmaildir--lists-get-nlist
 936                   (nnmaildir--grp-get-lists group)))
 937                nntp-server-buffer)
 938         (insert " " gname "\n")
 939         t))))
 940
 941 (defun nnmaildir-request-create-group (gname &optional server args)
 942   (nnmaildir--prepare server nil)
 943   (catch 'return
 944     (let ((create-dir (nnmaildir--srv-get-create-dir nnmaildir--cur-server))
 945           srv-dir dir groups)
 946       (when (zerop (length gname))
 947         (nnmaildir--srv-set-error nnmaildir--cur-server
 948                                   "Invalid (empty) group name")
 949         (throw 'return nil))
 950       (when (eq (aref "." 0) (aref gname 0))
 951         (nnmaildir--srv-set-error nnmaildir--cur-server
 952                                   "Group names may not start with \".\"")
 953         (throw 'return nil))
 954       (when (save-match-data (string-match "[\0/\t]" gname))
 955         (nnmaildir--srv-set-error nnmaildir--cur-server
 956           (concat "Illegal characters (null, tab, or /) in group name: "
 957                   gname))
 958         (throw 'return nil))
 959       (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server))
 960       (when (intern-soft gname groups)
 961         (nnmaildir--srv-set-error nnmaildir--cur-server
 962                                   (concat "Group already exists: " gname))
 963         (throw 'return nil))
 964       (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server))
 965       (if (file-name-absolute-p create-dir)
 966           (setq dir (expand-file-name create-dir))
 967         (setq dir srv-dir
 968               dir (file-truename dir)
 969               dir (concat dir create-dir)))
 970       (setq dir (file-name-as-directory dir)
 971             dir (concat dir gname))
 972       (nnmaildir--mkdir dir)
 973       (setq dir (file-name-as-directory dir))
 974       (nnmaildir--mkdir (concat dir "tmp"))
 975       (nnmaildir--mkdir (concat dir "new"))
 976       (nnmaildir--mkdir (concat dir "cur"))
 977       (setq create-dir (file-name-as-directory create-dir))
 978       (make-symbolic-link (concat create-dir gname) (concat srv-dir gname))
 979       (nnmaildir-request-scan 'find-new-groups))))
 980
 981 (defun nnmaildir-request-rename-group (gname new-name &optional server)
 982   (let ((group (nnmaildir--prepare server gname))
 983         (coding-system-for-write nnheader-file-coding-system)
 984         (buffer-file-coding-system nil)
 985         (file-coding-system-alist nil)
 986         srv-dir x groups)
 987     (catch 'return
 988       (if group nil
 989         (nnmaildir--srv-set-error nnmaildir--cur-server
 990                                   (concat "No such group: " gname))
 991         (throw 'return nil))
 992       (when (zerop (length new-name))
 993         (nnmaildir--srv-set-error nnmaildir--cur-server
 994                                   "Invalid (empty) group name")
 995         (throw 'return nil))
 996       (when (eq (aref "." 0) (aref new-name 0))
 997         (nnmaildir--srv-set-error nnmaildir--cur-server
 998                                   "Group names may not start with \".\"")
 999         (throw 'return nil))
1000       (when (save-match-data (string-match "[\0/\t]" new-name))
1001         (nnmaildir--srv-set-error nnmaildir--cur-server
1002           (concat "Illegal characters (null, tab, or /) in group name: "
1003                   new-name))
1004         (throw 'return nil))
1005       (if (string-equal gname new-name) (throw 'return t))
1006       (when (intern-soft new-name
1007                          (nnmaildir--srv-get-groups nnmaildir--cur-server))
1008         (nnmaildir--srv-set-error nnmaildir--cur-server
1009                                   (concat "Group already exists: " new-name))
1010         (throw 'return nil))
1011       (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server))
1012       (condition-case err
1013           (rename-file (concat srv-dir gname)
1014                        (concat srv-dir new-name))
1015         (error
1016          (nnmaildir--srv-set-error nnmaildir--cur-server
1017                                    (concat "Error renaming link: "
1018                                            (prin1-to-string err)))
1019          (throw 'return nil)))
1020       (setq x (nnmaildir--srv-get-groups nnmaildir--cur-server)
1021             groups (make-vector (length x) 0))
1022       (mapatoms (lambda (sym)
1023                   (if (eq (symbol-value sym) group) nil
1024                     (set (intern (symbol-name sym) groups)
1025                          (symbol-value sym))))
1026                 x)
1027       (setq group (copy-sequence group))
1028       (nnmaildir--grp-set-name group new-name)
1029       (set (intern new-name groups) group)
1030       (nnmaildir--srv-set-groups nnmaildir--cur-server groups)
1031       t)))
1032
1033 (defun nnmaildir-request-delete-group (gname force &optional server)
1034   (let ((group (nnmaildir--prepare server gname))
1035         pgname grp-dir dir dirs files ls deactivate-mark)
1036     (catch 'return
1037       (if group nil
1038         (nnmaildir--srv-set-error nnmaildir--cur-server
1039                                   (concat "No such group: " gname))
1040         (throw 'return nil))
1041       (if (eq group (nnmaildir--srv-get-curgrp nnmaildir--cur-server))
1042           (nnmaildir--srv-set-curgrp nnmaildir--cur-server nil))
1043       (setq gname (nnmaildir--grp-get-name group)
1044             pgname (nnmaildir--grp-get-pname group))
1045       (unintern gname (nnmaildir--srv-get-groups nnmaildir--cur-server))
1046       (setq grp-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1047             grp-dir (nnmaildir--srv-grp-dir grp-dir gname))
1048       (if (not force) (setq grp-dir (directory-file-name grp-dir))
1049         (if (nnmaildir--param pgname 'read-only)
1050             (progn (delete-directory  (nnmaildir--tmp grp-dir))
1051                    (nnmaildir--unlink (nnmaildir--new grp-dir))
1052                    (delete-directory  (nnmaildir--cur grp-dir)))
1053           (save-excursion
1054             (set-buffer (get-buffer-create " *nnmaildir work*"))
1055             (erase-buffer)
1056             (setq ls (or (nnmaildir--param pgname 'directory-files)
1057                          (nnmaildir--srv-get-ls nnmaildir--cur-server))
1058                   files (funcall ls (nnmaildir--tmp grp-dir) 'full "\\`[^.]"
1059                                  'nosort))
1060             (while files
1061               (delete-file (car files))
1062               (setq files (cdr files)))
1063             (delete-directory (concat grp-dir "tmp"))
1064             (setq files (funcall ls (nnmaildir--new grp-dir) 'full "\\`[^.]"
1065                                  'nosort))
1066             (while files
1067               (delete-file (car files))
1068               (setq files (cdr files)))
1069             (delete-directory (concat grp-dir "new"))
1070             (setq files (funcall ls (nnmaildir--cur grp-dir) 'full "\\`[^.]"
1071                                  'nosort))
1072             (while files
1073               (delete-file (car files))
1074               (setq files (cdr files)))
1075             (delete-directory (concat grp-dir "cur"))))
1076         (setq dir (nnmaildir--nndir grp-dir)
1077               dirs (cons (concat dir "nov")
1078                          (funcall ls (concat dir "marks") 'full "\\`[^.]"
1079                                   'nosort)))
1080         (while dirs
1081           (setq dir (car dirs) dirs (cdr dirs)
1082                 files (funcall ls dir 'full "\\`[^.]" 'nosort))
1083           (while files
1084             (delete-file (car files))
1085             (setq files (cdr files)))
1086           (delete-directory dir))
1087         (setq dir (nnmaildir--nndir grp-dir)
1088               files (concat dir "markfile"))
1089         (nnmaildir--unlink files)
1090         (delete-directory (concat dir "marks"))
1091         (delete-directory dir)
1092         (setq grp-dir (directory-file-name grp-dir)
1093               dir (car (file-attributes grp-dir)))
1094         (if (eq (aref "/" 0) (aref dir 0)) nil
1095           (setq dir (concat (file-truename
1096                               (nnmaildir--srv-get-dir nnmaildir--cur-server))
1097                             dir)))
1098         (delete-directory dir))
1099       (nnmaildir--unlink grp-dir)
1100       t)))
1101
1102 (defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
1103   (let ((group (nnmaildir--prepare server gname))
1104         srv-dir dir nlist mlist article num stop nov nlist2 deactivate-mark)
1105     (catch 'return
1106       (if group nil
1107         (nnmaildir--srv-set-error nnmaildir--cur-server
1108                                   (if gname (concat "No such group: " gname)
1109                                     "No current group"))
1110         (throw 'return nil))
1111       (save-excursion
1112         (set-buffer nntp-server-buffer)
1113         (erase-buffer)
1114         (setq nlist (nnmaildir--grp-get-lists group)
1115               mlist (nnmaildir--lists-get-mlist nlist)
1116               nlist (nnmaildir--lists-get-nlist nlist)
1117               gname (nnmaildir--grp-get-name group)
1118               srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1119               dir (nnmaildir--srv-grp-dir srv-dir gname))
1120         (cond
1121          ((null nlist))
1122          ((and fetch-old (not (numberp fetch-old)))
1123           (while nlist
1124             (setq article (car nlist) nlist (cdr nlist)
1125                   nov (nnmaildir--update-nov srv-dir group article))
1126             (when nov
1127               (nnmaildir--cache-nov group article nov)
1128               (setq num (nnmaildir--art-get-num article))
1129               (princ num nntp-server-buffer)
1130               (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
1131                       (nnmaildir--art-get-msgid article) "\t"
1132                       (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
1133                       ":")
1134               (princ num nntp-server-buffer)
1135               (insert "\t" (nnmaildir--nov-get-end nov) "\n")
1136               (goto-char (point-min)))))
1137          ((null articles))
1138          ((stringp (car articles))
1139           (while articles
1140             (setq article (car articles) articles (cdr articles)
1141                   article (nnmaildir--mlist-art mlist article))
1142             (when (and article
1143                        (setq nov (nnmaildir--update-nov srv-dir group
1144                                                         article)))
1145               (nnmaildir--cache-nov group article nov)
1146               (setq num (nnmaildir--art-get-num article))
1147               (princ num nntp-server-buffer)
1148               (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
1149                       (nnmaildir--art-get-msgid article) "\t"
1150                       (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
1151                       ":")
1152               (princ num nntp-server-buffer)
1153               (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
1154          (t
1155           (if fetch-old
1156               ;; Assume the article range is sorted ascending
1157               (setq stop (car articles)
1158                     num  (car (last articles))
1159                     stop (if (numberp stop) stop (car stop))
1160                     num  (if (numberp num)  num  (cdr num))
1161                     stop (- stop fetch-old)
1162                     stop (if (< stop 1) 1 stop)
1163                     articles (list (cons stop num))))
1164           (while articles
1165             (setq stop (car articles) articles (cdr articles))
1166             (while (eq stop (car articles))
1167               (setq articles (cdr articles)))
1168             (if (numberp stop) (setq num stop)
1169               (setq num (cdr stop) stop (car stop)))
1170             (setq nlist2 (nthcdr (- (nnmaildir--art-get-num (car nlist)) num)
1171                                  nlist))
1172             (while (and nlist2
1173                         (setq article (car nlist2)
1174                               num (nnmaildir--art-get-num article))
1175                         (>= num stop))
1176               (setq nlist2 (cdr nlist2)
1177                     nov (nnmaildir--update-nov srv-dir group article))
1178               (when nov
1179                 (nnmaildir--cache-nov group article nov)
1180                 (princ num nntp-server-buffer)
1181                 (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
1182                         (nnmaildir--art-get-msgid article) "\t"
1183                         (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
1184                         ":")
1185                 (princ num nntp-server-buffer)
1186                 (insert "\t" (nnmaildir--nov-get-end nov) "\n")
1187                 (goto-char (point-min)))))))
1188         (sort-numeric-fields 1 (point-min) (point-max))
1189         'nov))))
1190
1191 (defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
1192   (let ((group (nnmaildir--prepare server gname))
1193         (case-fold-search t)
1194         list article suffix dir deactivate-mark)
1195     (catch 'return
1196       (if group nil
1197         (nnmaildir--srv-set-error nnmaildir--cur-server
1198                                   (if gname (concat "No such group: " gname)
1199                                     "No current group"))
1200         (throw 'return nil))
1201       (setq list (nnmaildir--grp-get-lists group))
1202       (if (numberp num-msgid)
1203           (setq list (nnmaildir--lists-get-nlist list)
1204                 article (nnmaildir--nlist-art list num-msgid))
1205         (setq list (nnmaildir--lists-get-mlist list)
1206               article (nnmaildir--mlist-art list num-msgid))
1207         (if article (setq num-msgid (nnmaildir--art-get-num article))
1208           (catch 'found
1209             (mapatoms
1210               (lambda (grp)
1211                 (setq group (symbol-value grp)
1212                       list (nnmaildir--grp-get-lists group)
1213                       list (nnmaildir--lists-get-mlist list)
1214                       article (nnmaildir--mlist-art list num-msgid))
1215                 (when article
1216                   (setq num-msgid (nnmaildir--art-get-num article))
1217                   (throw 'found nil)))
1218               (nnmaildir--srv-get-groups nnmaildir--cur-server)))))
1219       (if article nil
1220         (nnmaildir--srv-set-error nnmaildir--cur-server "No such article")
1221         (throw 'return nil))
1222       (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil
1223         (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1224         (throw 'return nil))
1225       (setq gname (nnmaildir--grp-get-name group)
1226             dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1227             dir (nnmaildir--srv-grp-dir dir gname)
1228             group (if (nnmaildir--param (nnmaildir--grp-get-pname group)
1229                                         'read-only)
1230                       (nnmaildir--new dir) (nnmaildir--cur dir))
1231             nnmaildir-article-file-name (concat group
1232                                                 (nnmaildir--art-get-prefix
1233                                                   article)
1234                                                 suffix))
1235       (if (file-exists-p nnmaildir-article-file-name) nil
1236         (nnmaildir--art-set-suffix article 'expire)
1237         (nnmaildir--art-set-nov article nil)
1238         (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1239         (throw 'return nil))
1240       (save-excursion
1241         (set-buffer (or to-buffer nntp-server-buffer))
1242         (erase-buffer)
1243         (nnheader-insert-file-contents nnmaildir-article-file-name))
1244       (cons gname num-msgid))))
1245
1246 (defun nnmaildir-request-post (&optional server)
1247   (let (message-required-mail-headers)
1248     (funcall message-send-mail-function)))
1249
1250 (defun nnmaildir-request-replace-article (article gname buffer)
1251   (let ((group (nnmaildir--prepare nil gname))
1252         (coding-system-for-write nnheader-file-coding-system)
1253         (buffer-file-coding-system nil)
1254         (file-coding-system-alist nil)
1255         file dir suffix tmpfile deactivate-mark)
1256     (catch 'return
1257       (if group nil
1258         (nnmaildir--srv-set-error nnmaildir--cur-server
1259                                   (concat "No such group: " gname))
1260         (throw 'return nil))
1261       (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only)
1262         (nnmaildir--srv-set-error nnmaildir--cur-server
1263                                   (concat "Read-only group: " group))
1264         (throw 'return nil))
1265       (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1266             dir (nnmaildir--srv-grp-dir dir gname)
1267             file (nnmaildir--grp-get-lists group)
1268             file (nnmaildir--lists-get-nlist file)
1269             file (nnmaildir--nlist-art file article))
1270       (if (and file (stringp (setq suffix (nnmaildir--art-get-suffix file))))
1271           nil
1272         (nnmaildir--srv-set-error nnmaildir--cur-server
1273                                   (format "No such article: %d" article))
1274         (throw 'return nil))
1275       (save-excursion
1276         (set-buffer buffer)
1277         (setq article file
1278               file (nnmaildir--art-get-prefix article)
1279               tmpfile (concat (nnmaildir--tmp dir) file))
1280         (when (file-exists-p tmpfile)
1281           (nnmaildir--srv-set-error nnmaildir--cur-server
1282                                     (concat "File exists: " tmpfile))
1283           (throw 'return nil))
1284         (write-region (point-min) (point-max) tmpfile nil 'no-message nil
1285                       'confirm-overwrite)) ;; error would be preferred :(
1286       (unix-sync) ;; no fsync :(
1287       (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace)
1288       t)))
1289
1290 (defun nnmaildir-request-move-article (article gname server accept-form
1291                                        &optional last)
1292   (let ((group (nnmaildir--prepare server gname))
1293         pgname list suffix result nnmaildir--file deactivate-mark)
1294     (catch 'return
1295       (if group nil
1296         (nnmaildir--srv-set-error nnmaildir--cur-server
1297                                   (concat "No such group: " gname))
1298         (throw 'return nil))
1299       (setq gname (nnmaildir--grp-get-name group)
1300             pgname (nnmaildir--grp-get-pname group)
1301             list (nnmaildir--grp-get-lists group)
1302             list (nnmaildir--lists-get-nlist list)
1303             article (nnmaildir--nlist-art list article))
1304       (if article nil
1305         (nnmaildir--srv-set-error nnmaildir--cur-server "No such article")
1306         (throw 'return nil))
1307       (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil
1308         (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1309         (throw 'return nil))
1310       (setq nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server)
1311             nnmaildir--file (nnmaildir--srv-grp-dir nnmaildir--file gname)
1312             nnmaildir--file (if (nnmaildir--param pgname 'read-only)
1313                                 (nnmaildir--new nnmaildir--file)
1314                               (nnmaildir--cur nnmaildir--file))
1315             nnmaildir--file (concat nnmaildir--file
1316                                     (nnmaildir--art-get-prefix article)
1317                                     suffix))
1318       (if (file-exists-p nnmaildir--file) nil
1319         (nnmaildir--art-set-suffix article 'expire)
1320         (nnmaildir--art-set-nov article nil)
1321         (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1322         (throw 'return nil))
1323       (save-excursion
1324         (set-buffer (get-buffer-create " *nnmaildir move*"))
1325         (erase-buffer)
1326         (nnheader-insert-file-contents nnmaildir--file)
1327         (setq result (eval accept-form)))
1328       (if (or (null result) (nnmaildir--param pgname 'read-only)) nil
1329         (nnmaildir--unlink nnmaildir--file)
1330         (nnmaildir--art-set-suffix article 'expire)
1331         (nnmaildir--art-set-nov article nil))
1332       result)))
1333
1334 (defun nnmaildir-request-accept-article (gname &optional server last)
1335   (let ((group (nnmaildir--prepare server gname))
1336         (coding-system-for-write nnheader-file-coding-system)
1337         (buffer-file-coding-system nil)
1338         (file-coding-system-alist nil)
1339         srv-dir dir file tmpfile curfile 24h num article)
1340     (catch 'return
1341       (if group nil
1342         (nnmaildir--srv-set-error nnmaildir--cur-server
1343                                   (concat "No such group: " gname))
1344         (throw 'return nil))
1345       (setq gname (nnmaildir--grp-get-name group))
1346       (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only)
1347         (nnmaildir--srv-set-error nnmaildir--cur-server
1348                                   (concat "Read-only group: " gname))
1349         (throw 'return nil))
1350       (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1351             dir (nnmaildir--srv-grp-dir srv-dir gname)
1352             file (format-time-string "%s" nil))
1353       (if (string= nnmaildir--delivery-time file) nil
1354         (setq nnmaildir--delivery-time file
1355               nnmaildir--delivery-ct 0))
1356       (setq file (concat file "." nnmaildir--delivery-pid))
1357       (if (zerop nnmaildir--delivery-ct) nil
1358         (setq file (concat file "_"
1359                            (number-to-string nnmaildir--delivery-ct))))
1360       (setq file (concat file "." (system-name))
1361             tmpfile (concat (nnmaildir--tmp dir) file)
1362             curfile (concat (nnmaildir--cur dir) file ":2,"))
1363       (when (file-exists-p tmpfile)
1364         (nnmaildir--srv-set-error nnmaildir--cur-server
1365                                   (concat "File exists: " tmpfile))
1366         (throw 'return nil))
1367       (when (file-exists-p curfile)
1368         (nnmaildir--srv-set-error nnmaildir--cur-server
1369                                   (concat "File exists: " curfile))
1370         (throw 'return nil))
1371       (setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct)
1372             24h (run-with-timer 86400 nil
1373                                 (lambda ()
1374                                   (nnmaildir--unlink tmpfile)
1375                                   (nnmaildir--srv-set-error
1376                                     nnmaildir--cur-server
1377                                     "24-hour timer expired")
1378                                   (throw 'return nil))))
1379       (condition-case nil
1380           (add-name-to-file nnmaildir--file tmpfile)
1381         (error
1382          (write-region (point-min) (point-max) tmpfile nil 'no-message nil
1383                        'confirm-overwrite) ;; error would be preferred :(
1384          (unix-sync))) ;; no fsync :(
1385       (cancel-timer 24h)
1386       (condition-case err
1387           (add-name-to-file tmpfile curfile)
1388         (error
1389          (nnmaildir--srv-set-error nnmaildir--cur-server
1390                                    (concat "Error linking: "
1391                                            (prin1-to-string err)))
1392          (nnmaildir--unlink tmpfile)
1393          (throw 'return nil)))
1394       (nnmaildir--unlink tmpfile)
1395       (setq article (nnmaildir--art-new)
1396             num (nnmaildir--grp-get-lists group)
1397             num (nnmaildir--lists-get-nlist num)
1398             num (1+ (nnmaildir--nlist-last-num num)))
1399       (nnmaildir--art-set-prefix article file)
1400       (nnmaildir--art-set-suffix article ":2,")
1401       (nnmaildir--art-set-num article num)
1402       (if (nnmaildir--grp-add-art srv-dir group article) (cons gname num)))))
1403
1404 (defun nnmaildir-save-mail (group-art)
1405   (catch 'return
1406     (if group-art nil
1407       (throw 'return nil))
1408     (let ((ret group-art)
1409           ga gname x groups nnmaildir--file deactivate-mark)
1410       (save-excursion
1411         (goto-char (point-min))
1412         (save-match-data
1413           (while (looking-at "From ")
1414             (replace-match "X-From-Line: ")
1415             (forward-line 1))))
1416       (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server)
1417             ga (car group-art) group-art (cdr group-art)
1418             gname (car ga))
1419       (or (intern-soft gname groups)
1420           (nnmaildir-request-create-group gname)
1421           (throw 'return nil)) ;; not that nnmail bothers to check :(
1422       (if (nnmaildir-request-accept-article gname) nil
1423         (throw 'return nil))
1424       (setq x (nnmaildir--prepare nil gname)
1425             nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server)
1426             nnmaildir--file (concat nnmaildir--file
1427                                     (nnmaildir--grp-get-name x))
1428             nnmaildir--file (file-name-as-directory nnmaildir--file)
1429             x (nnmaildir--grp-get-lists x)
1430             x (nnmaildir--lists-get-nlist x)
1431             x (car x)
1432             nnmaildir--file (concat nnmaildir--file
1433                                     (nnmaildir--art-get-prefix x)
1434                                     (nnmaildir--art-get-suffix x)))
1435       (while group-art
1436         (setq ga (car group-art) group-art (cdr group-art)
1437               gname (car ga))
1438         (if (and (or (intern-soft gname groups)
1439                      (nnmaildir-request-create-group gname))
1440                  (nnmaildir-request-accept-article gname)) nil
1441           (setq ret (delq ga ret)))) ;; We'll still try the other groups
1442       ret)))
1443
1444 (defun nnmaildir-active-number (group)
1445   (let ((x (nnmaildir--prepare nil group)))
1446     (catch 'return
1447       (if x nil
1448         (nnmaildir--srv-set-error nnmaildir--cur-server
1449                                   (concat "No such group: " group))
1450         (throw 'return nil))
1451       (setq x (nnmaildir--grp-get-lists x)
1452             x (nnmaildir--lists-get-nlist x))
1453       (if x
1454           (setq x (car x)
1455                 x (nnmaildir--art-get-num x)
1456                 x (1+ x))
1457         1))))
1458
1459 (defun nnmaildir-request-expire-articles (ranges &optional gname server force)
1460   (let ((no-force (not force))
1461         (group (nnmaildir--prepare server gname))
1462         pgname time boundary time-iter bound-iter high low target dir nlist
1463         stop number article didnt suffix nnmaildir--file
1464         nnmaildir-article-file-name deactivate-mark)
1465     (catch 'return
1466       (if group nil
1467         (nnmaildir--srv-set-error nnmaildir--cur-server
1468                                   (if gname (concat "No such group: " gname)
1469                                     "No current group"))
1470         (throw 'return (gnus-uncompress-range ranges)))
1471       (setq gname (nnmaildir--grp-get-name group)
1472             pgname (nnmaildir--grp-get-pname group))
1473       (if (nnmaildir--param pgname 'read-only)
1474           (throw 'return (gnus-uncompress-range ranges)))
1475       (setq time (or (nnmaildir--param pgname 'expire-age) 604800))
1476       (if (or force (integerp time)) nil
1477         (throw 'return (gnus-uncompress-range ranges)))
1478       (setq boundary (current-time)
1479             high (- (car boundary) (/ time 65536))
1480             low (- (cadr boundary) (% time 65536)))
1481       (if (< low 0)
1482           (setq low (+ low 65536)
1483                 high (1- high)))
1484       (setcar (cdr boundary) low)
1485       (setcar boundary high)
1486       (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1487             dir (nnmaildir--srv-grp-dir dir gname)
1488             dir (nnmaildir--cur dir)
1489             nlist (nnmaildir--grp-get-lists group)
1490             nlist (nnmaildir--lists-get-nlist nlist)
1491             ranges (reverse ranges))
1492       (save-excursion
1493         (set-buffer (get-buffer-create " *nnmaildir move*"))
1494         (while ranges
1495           (setq number (car ranges) ranges (cdr ranges))
1496           (while (eq number (car ranges))
1497             (setq ranges (cdr ranges)))
1498           (if (numberp number) (setq stop number)
1499             (setq stop (car number) number (cdr number)))
1500           (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) number)
1501                               nlist))
1502           (while (and nlist
1503                       (setq article (car nlist)
1504                             number (nnmaildir--art-get-num article))
1505                       (>= number stop))
1506             (setq nlist (cdr nlist)
1507                   suffix (nnmaildir--art-get-suffix article))
1508             (catch 'continue
1509               (if (stringp suffix) nil
1510                 (nnmaildir--art-set-suffix article 'expire)
1511                 (nnmaildir--art-set-nov article nil)
1512                 (throw 'continue nil))
1513               (setq nnmaildir--file (nnmaildir--art-get-prefix article)
1514                     nnmaildir--file (concat dir nnmaildir--file suffix)
1515                     time (file-attributes nnmaildir--file))
1516               (if time nil
1517                 (nnmaildir--art-set-suffix article 'expire)
1518                 (nnmaildir--art-set-nov article nil)
1519                 (throw 'continue nil))
1520               (setq time (nth 5 time)
1521                     time-iter time
1522                     bound-iter boundary)
1523               (if (and no-force
1524                        (progn
1525                          (while (and bound-iter time-iter
1526                                      (= (car bound-iter) (car time-iter)))
1527                            (setq bound-iter (cdr bound-iter)
1528                                  time-iter (cdr time-iter)))
1529                          (and bound-iter time-iter
1530                               (car-less-than-car bound-iter time-iter))))
1531                   (setq didnt (cons number didnt))
1532                 (save-excursion
1533                   (setq nnmaildir-article-file-name nnmaildir--file
1534                         target (nnmaildir--param pgname 'expire-group)))
1535                 (when (and (stringp target)
1536                            (not (string-equal target pgname))) ;; Move it.
1537                   (erase-buffer)
1538                   (nnheader-insert-file-contents nnmaildir--file)
1539                   (gnus-request-accept-article target nil nil 'no-encode))
1540                 (if (equal target pgname)
1541                     (setq didnt (cons number didnt)) ;; Leave it here.
1542                   (nnmaildir--unlink nnmaildir--file)
1543                   (nnmaildir--art-set-suffix article 'expire)
1544                   (nnmaildir--art-set-nov article nil))))))
1545         (erase-buffer))
1546       didnt)))
1547
1548 (defun nnmaildir-request-set-mark (gname actions &optional server)
1549   (let ((group (nnmaildir--prepare server gname))
1550         (coding-system-for-write nnheader-file-coding-system)
1551         (buffer-file-coding-system nil)
1552         (file-coding-system-alist nil)
1553         del-mark add-marks marksdir markfile action group-nlist nlist ranges
1554         begin end article all-marks todo-marks did-marks marks form mdir mfile
1555         deactivate-mark)
1556     (setq del-mark
1557           (lambda ()
1558             (setq mfile (car marks)
1559                   mfile (symbol-name mfile)
1560                   mfile (concat marksdir mfile)
1561                   mfile (file-name-as-directory mfile)
1562                   mfile (concat mfile (nnmaildir--art-get-prefix article)))
1563             (nnmaildir--unlink mfile))
1564           add-marks
1565           (lambda ()
1566             (while marks
1567               (setq mdir (concat marksdir (symbol-name (car marks)))
1568                     mfile (concat (file-name-as-directory mdir)
1569                                   (nnmaildir--art-get-prefix article)))
1570               (if (memq (car marks) did-marks) nil
1571                 (nnmaildir--mkdir mdir)
1572                 (setq did-marks (cons (car marks) did-marks)))
1573               (if (file-exists-p mfile) nil
1574                 (condition-case nil
1575                     (add-name-to-file markfile mfile)
1576                   (file-error ;; too many links, probably
1577                    (if (file-exists-p mfile) nil
1578                      (nnmaildir--unlink markfile)
1579                      (write-region "" nil markfile nil 'no-message)
1580                      (add-name-to-file markfile mfile
1581                                        'ok-if-already-exists)))))
1582               (setq marks (cdr marks)))))
1583     (catch 'return
1584       (if group nil
1585         (nnmaildir--srv-set-error nnmaildir--cur-server
1586                                   (concat "No such group: " gname))
1587         (while actions
1588           (setq ranges (gnus-range-add ranges (caar actions))
1589                 actions (cdr actions)))
1590         (throw 'return ranges))
1591       (setq group-nlist (nnmaildir--grp-get-lists group)
1592             group-nlist (nnmaildir--lists-get-nlist group-nlist)
1593             marksdir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1594             marksdir (nnmaildir--srv-grp-dir marksdir gname)
1595             marksdir (nnmaildir--nndir marksdir)
1596             markfile (concat marksdir "markfile")
1597             marksdir (concat marksdir "marks")
1598             marksdir (file-name-as-directory marksdir)
1599             gname (nnmaildir--grp-get-name group)
1600             all-marks (nnmaildir--grp-get-pname group)
1601             all-marks (or (nnmaildir--param all-marks 'directory-files)
1602                           (nnmaildir--srv-get-ls nnmaildir--cur-server))
1603             all-marks (funcall all-marks marksdir nil "\\`[^.]" 'nosort)
1604             marks all-marks)
1605       (while marks
1606         (setcar marks (intern (car marks)))
1607         (setq marks (cdr marks)))
1608       (while actions
1609         (setq action (car actions) actions (cdr actions)
1610               nlist group-nlist
1611               ranges (car action)
1612               todo-marks (caddr action)
1613               marks todo-marks)
1614         (while marks
1615           (if (memq (car marks) all-marks) nil
1616             (setq all-marks (cons (car marks) all-marks)))
1617           (setq marks (cdr marks)))
1618         (setq form
1619               (cond
1620                ((eq 'del (cadr action))
1621                 '(while marks
1622                    (funcall del-mark)
1623                    (setq marks (cdr marks))))
1624                ((eq 'add (cadr action)) '(funcall add-marks))
1625                (t
1626                 '(progn
1627                    (funcall add-marks)
1628                    (setq marks all-marks)
1629                    (while marks
1630                      (if (memq (car marks) todo-marks) nil
1631                        (funcall del-mark))
1632                      (setq marks (cdr marks)))))))
1633         (if (numberp (cdr ranges)) (setq ranges (list ranges))
1634           (setq ranges (reverse ranges)))
1635         (while ranges
1636           (setq begin (car ranges) ranges (cdr ranges))
1637           (while (eq begin (car ranges))
1638             (setq ranges (cdr ranges)))
1639           (if (numberp begin) (setq end begin)
1640             (setq end (cdr begin) begin (car begin)))
1641           (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) end)
1642                               nlist))
1643           (while (and nlist
1644                       (setq article (car nlist))
1645                       (>= (nnmaildir--art-get-num article) begin))
1646             (setq nlist (cdr nlist))
1647             (when (stringp (nnmaildir--art-get-suffix article))
1648               (setq marks todo-marks)
1649               (eval form)))))
1650       nil)))
1651
1652 (defun nnmaildir-close-group (group &optional server)
1653   t)
1654
1655 (defun nnmaildir-close-server (&optional server)
1656   (let (srv-ls flist ls dirs dir files file x)
1657     (nnmaildir--prepare server nil)
1658     (setq server nnmaildir--cur-server)
1659     (when server
1660       (setq nnmaildir--cur-server nil
1661             srv-ls (nnmaildir--srv-get-ls server))
1662       (save-match-data
1663         (mapatoms
1664           (lambda (group)
1665             (setq group (symbol-value group)
1666                   x (nnmaildir--grp-get-pname group)
1667                   ls (nnmaildir--param x 'directory-files)
1668                   ls (or ls srv-ls)
1669                   dir (nnmaildir--srv-get-dir server)
1670                   dir (nnmaildir--srv-grp-dir
1671                         dir (nnmaildir--grp-get-name group))
1672                   x (nnmaildir--param x 'read-only)
1673                   x (if x (nnmaildir--new dir) (nnmaildir--cur dir))
1674                   files (funcall ls x nil "\\`[^.]" 'nosort)
1675                   x (length files)
1676                   flist 1)
1677             (while (<= flist x) (setq flist (* 2 flist)))
1678             (if (/= flist 1) (setq flist (1- flist)))
1679             (setq flist (make-vector flist 0))
1680             (while files
1681               (setq file (car files) files (cdr files))
1682               (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
1683               (intern (match-string 1 file) flist))
1684             (setq dir (nnmaildir--nndir dir)
1685                   dirs (cons (concat dir "nov")
1686                              (funcall ls (concat dir "marks") 'full "\\`[^.]"
1687                                       'nosort)))
1688             (while dirs
1689               (setq dir (car dirs) dirs (cdr dirs)
1690                     files (funcall ls dir nil "\\`[^.]" 'nosort)
1691                     dir (file-name-as-directory dir))
1692               (while files
1693                 (setq file (car files) files (cdr files))
1694                 (if (intern-soft file flist) nil
1695                   (setq file (concat dir file))
1696                   (delete-file file)))))
1697           (nnmaildir--srv-get-groups server)))
1698       (unintern (nnmaildir--srv-get-name server) nnmaildir--servers)))
1699   t)
1700
1701 (defun nnmaildir-request-close ()
1702   (let (servers buffer)
1703     (mapatoms (lambda (server)
1704                 (setq servers (cons (symbol-name server) servers)))
1705               nnmaildir--servers)
1706     (while servers
1707       (nnmaildir-close-server (car servers))
1708       (setq servers (cdr servers)))
1709     (setq buffer (get-buffer " *nnmaildir work*"))
1710     (if buffer (kill-buffer buffer))
1711     (setq buffer (get-buffer " *nnmaildir nov*"))
1712     (if buffer (kill-buffer buffer))
1713     (setq buffer (get-buffer " *nnmaildir move*"))
1714     (if buffer (kill-buffer buffer)))
1715   t)
1716
1717 (provide 'nnmaildir)
1718
1719 ;;; nnmaildir.el ends here