cgit.sxemacs.org Git - gnus/blob - lisp/nnmaildir.el

   1 ;;; nnmaildir.el --- maildir backend for Gnus
   2
   3 ;; This file is in the public domain.
   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 3 of the License, or
  12 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
  25 ;; and in the maildir(5) man page from qmail (available at
  26 ;; <URL:http://www.qmail.org/man/man5/maildir.html>).  nnmaildir also stores
  27 ;; extra information in the .nnmaildir/ directory within a maildir.
  28 ;;
  29 ;; Some goals of nnmaildir:
  30 ;; * Everything Just Works, and correctly.  E.g., NOV data is automatically
  31 ;;   regenerated when stale; no need for manually running
  32 ;;   *-generate-nov-databases.
  33 ;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
  34 ;;   SIGKILL will never corrupt its data in the filesystem.
  35 ;; * Allow concurrent operation as much as possible.  If files change out
  36 ;;   from under us, adapt to the changes or degrade gracefully.
  37 ;; * We use the filesystem as a database, so that, e.g., it's easy to
  38 ;;   manipulate marks from outside Gnus.
  39 ;; * All information about a group is stored in the maildir, for easy backup,
  40 ;;   copying, restoring, etc.
  41 ;;
  42 ;; Todo:
  43 ;; * When moving an article for expiry, copy all the marks except 'expire
  44 ;;   from the original article.
  45 ;; * Add a hook for when moving messages from new/ to cur/, to support
  46 ;;   nnmail's duplicate detection.
  47 ;; * Improve generated Xrefs, so crossposts are detectable.
  48 ;; * Improve code readability.
  49
  50 ;;; Code:
  51
  52 ;; eval this before editing
  53 [(progn
  54    (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
  55    (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
  56    (put 'nnmaildir--with-nov-buffer  'lisp-indent-function 0)
  57    (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
  58    (put 'nnmaildir--condcase         'lisp-indent-function 2)
  59    )
  60 ]
  61
  62 ;; For Emacs < 22.2.
  63 (eval-and-compile
  64   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  65
  66 (eval-and-compile
  67   (require 'nnheader)
  68   (require 'gnus)
  69   (require 'gnus-util)
  70   (require 'gnus-range)
  71   (require 'gnus-start)
  72   (require 'gnus-int)
  73   (require 'message))
  74 (eval-when-compile
  75   (require 'cl)
  76   (require 'nnmail))
  77
  78 (defconst nnmaildir-version "Gnus")
  79
  80 (defvar nnmaildir-article-file-name nil
  81   "*The filename of the most recently requested article.  This variable is set
  82 by nnmaildir-request-article.")
  83
  84 ;; The filename of the article being moved/copied:
  85 (defvar nnmaildir--file nil)
  86
  87 ;; Variables to generate filenames of messages being delivered:
  88 (defvar   nnmaildir--delivery-time "")
  89 (defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
  90 (defvar   nnmaildir--delivery-count nil)
  91
  92 ;; An obarry containing symbols whose names are server names and whose values
  93 ;; are servers:
  94 (defvar nnmaildir--servers (make-vector 3 0))
  95 ;; The current server:
  96 (defvar nnmaildir--cur-server nil)
  97
  98 ;; A copy of nnmail-extra-headers
  99 (defvar nnmaildir--extra nil)
 100
 101 ;; A NOV structure looks like this (must be prin1-able, so no defstruct):
 102 ["subject\tfrom\tdate"
 103  "references\tchars\lines"
 104  "To: you\tIn-Reply-To: <your.mess@ge>"
 105  (12345 67890)     ;; modtime of the corresponding article file
 106  (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
 107 (defconst nnmaildir--novlen 5)
 108 (defmacro nnmaildir--nov-new (beg mid end mtime extra)
 109   `(vector ,beg ,mid ,end ,mtime ,extra))
 110 (defmacro nnmaildir--nov-get-beg   (nov) `(aref ,nov 0))
 111 (defmacro nnmaildir--nov-get-mid   (nov) `(aref ,nov 1))
 112 (defmacro nnmaildir--nov-get-end   (nov) `(aref ,nov 2))
 113 (defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
 114 (defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
 115 (defmacro nnmaildir--nov-set-beg   (nov value) `(aset ,nov 0 ,value))
 116 (defmacro nnmaildir--nov-set-mid   (nov value) `(aset ,nov 1 ,value))
 117 (defmacro nnmaildir--nov-set-end   (nov value) `(aset ,nov 2 ,value))
 118 (defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
 119 (defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
 120
 121 (defstruct nnmaildir--art
 122   (prefix nil :type string)  ;; "time.pid.host"
 123   (suffix nil :type string)  ;; ":2,flags"
 124   (num    nil :type natnum)  ;; article number
 125   (msgid  nil :type string)  ;; "<mess.age@id>"
 126   (nov    nil :type vector)) ;; cached nov structure, or nil
 127
 128 (defstruct nnmaildir--grp
 129   (name  nil :type string)  ;; "group.name"
 130   (new   nil :type list)    ;; new/ modtime
 131   (cur   nil :type list)    ;; cur/ modtime
 132   (min   1   :type natnum)  ;; minimum article number
 133   (count 0   :type natnum)  ;; count of articles
 134   (nlist nil :type list)    ;; list of articles, ordered descending by number
 135   (flist nil :type vector)  ;; obarray mapping filename prefix->article
 136   (mlist nil :type vector)  ;; obarray mapping message-id->article
 137   (cache nil :type vector)  ;; nov cache
 138   (index nil :type natnum)  ;; index of next cache entry to replace
 139   (mmth  nil :type vector)) ;; obarray mapping mark name->dir modtime
 140                                         ; ("Mark Mod Time Hash")
 141
 142 (defstruct nnmaildir--srv
 143   (address       nil :type string)         ;; server address string
 144   (method        nil :type list)           ;; (nnmaildir "address" ...)
 145   (prefix        nil :type string)         ;; "nnmaildir+address:"
 146   (dir           nil :type string)         ;; "/expanded/path/to/server/dir/"
 147   (ls            nil :type function)       ;; directory-files function
 148   (groups        nil :type vector)         ;; obarray mapping group name->group
 149   (curgrp        nil :type nnmaildir--grp) ;; current group, or nil
 150   (error         nil :type string)         ;; last error message, or nil
 151   (mtime         nil :type list)           ;; modtime of dir
 152   (gnm           nil)                      ;; flag: split from mail-sources?
 153   (target-prefix nil :type string))        ;; symlink target prefix
 154
 155 (defun nnmaildir--expired-article (group article)
 156   (setf (nnmaildir--art-nov article) nil)
 157   (let ((flist  (nnmaildir--grp-flist group))
 158         (mlist  (nnmaildir--grp-mlist group))
 159         (min    (nnmaildir--grp-min   group))
 160         (count  (1- (nnmaildir--grp-count group)))
 161         (prefix (nnmaildir--art-prefix article))
 162         (msgid  (nnmaildir--art-msgid  article))
 163         (new-nlist nil)
 164         (nlist-pre '(nil . nil))
 165         nlist-post num)
 166     (unless (zerop count)
 167       (setq nlist-post (nnmaildir--grp-nlist group)
 168             num (nnmaildir--art-num article))
 169       (if (eq num (caar nlist-post))
 170           (setq new-nlist (cdr nlist-post))
 171         (setq new-nlist nlist-post
 172               nlist-pre nlist-post
 173               nlist-post (cdr nlist-post))
 174         (while (/= num (caar nlist-post))
 175           (setq nlist-pre nlist-post
 176                 nlist-post (cdr nlist-post)))
 177         (setq nlist-post (cdr nlist-post))
 178         (if (eq num min)
 179             (setq min (caar nlist-pre)))))
 180     (let ((inhibit-quit t))
 181       (setf (nnmaildir--grp-min   group) min)
 182       (setf (nnmaildir--grp-count group) count)
 183       (setf (nnmaildir--grp-nlist group) new-nlist)
 184       (setcdr nlist-pre nlist-post)
 185       (unintern prefix flist)
 186       (unintern msgid mlist))))
 187
 188 (defun nnmaildir--nlist-art (group num)
 189   (let ((entry (assq num (nnmaildir--grp-nlist group))))
 190     (if entry
 191         (cdr entry))))
 192 (defmacro nnmaildir--flist-art (list file)
 193   `(symbol-value (intern-soft ,file ,list)))
 194 (defmacro nnmaildir--mlist-art (list msgid)
 195   `(symbol-value (intern-soft ,msgid ,list)))
 196
 197 (defun nnmaildir--pgname (server gname)
 198   (let ((prefix (nnmaildir--srv-prefix server)))
 199     (if prefix (concat prefix gname)
 200       (setq gname (gnus-group-prefixed-name gname
 201                                             (nnmaildir--srv-method server)))
 202       (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
 203       gname)))
 204
 205 (defun nnmaildir--param (pgname param)
 206   (setq param (gnus-group-find-parameter pgname param 'allow-list))
 207   (if (vectorp param) (setq param (aref param 0)))
 208   (eval param))
 209
 210 (defmacro nnmaildir--with-nntp-buffer (&rest body)
 211   `(with-current-buffer nntp-server-buffer
 212      ,@body))
 213 (defmacro nnmaildir--with-work-buffer (&rest body)
 214   `(with-current-buffer (get-buffer-create " *nnmaildir work*")
 215      ,@body))
 216 (defmacro nnmaildir--with-nov-buffer (&rest body)
 217   `(with-current-buffer (get-buffer-create " *nnmaildir nov*")
 218      ,@body))
 219 (defmacro nnmaildir--with-move-buffer (&rest body)
 220   `(with-current-buffer (get-buffer-create " *nnmaildir move*")
 221      ,@body))
 222
 223 (defmacro nnmaildir--subdir (dir subdir)
 224   `(file-name-as-directory (concat ,dir ,subdir)))
 225 (defmacro nnmaildir--srvgrp-dir (srv-dir gname)
 226   `(nnmaildir--subdir ,srv-dir ,gname))
 227 (defmacro nnmaildir--tmp       (dir) `(nnmaildir--subdir ,dir "tmp"))
 228 (defmacro nnmaildir--new       (dir) `(nnmaildir--subdir ,dir "new"))
 229 (defmacro nnmaildir--cur       (dir) `(nnmaildir--subdir ,dir "cur"))
 230 (defmacro nnmaildir--nndir     (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
 231 (defmacro nnmaildir--nov-dir   (dir) `(nnmaildir--subdir ,dir "nov"))
 232 (defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
 233 (defmacro nnmaildir--num-dir   (dir) `(nnmaildir--subdir ,dir "num"))
 234
 235 (defmacro nnmaildir--unlink (file-arg)
 236   `(let ((file ,file-arg))
 237      (if (file-attributes file) (delete-file file))))
 238 (defun nnmaildir--mkdir (dir)
 239   (or (file-exists-p (file-name-as-directory dir))
 240       (make-directory-internal (directory-file-name dir))))
 241 (defun nnmaildir--mkfile (file)
 242   (write-region "" nil file nil 'no-message))
 243 (defun nnmaildir--delete-dir-files (dir ls)
 244   (when (file-attributes dir)
 245     (mapc 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
 246     (delete-directory dir)))
 247
 248 (defun nnmaildir--group-maxnum (server group)
 249   (catch 'return
 250     (if (zerop (nnmaildir--grp-count group)) (throw 'return 0))
 251     (let ((dir (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
 252                                     (nnmaildir--grp-name group)))
 253           (number-opened 1)
 254           attr ino-opened nlink number-linked)
 255       (setq dir (nnmaildir--nndir dir)
 256             dir (nnmaildir--num-dir dir))
 257       (while t
 258         (setq attr (file-attributes
 259                     (concat dir (number-to-string number-opened))))
 260         (or attr (throw 'return (1- number-opened)))
 261         (setq ino-opened (nth 10 attr)
 262               nlink (nth 1 attr)
 263               number-linked (+ number-opened nlink))
 264         (if (or (< nlink 1) (< number-linked nlink))
 265             (signal 'error '("Arithmetic overflow")))
 266         (setq attr (file-attributes
 267                     (concat dir (number-to-string number-linked))))
 268         (or attr (throw 'return (1- number-linked)))
 269         (unless (equal ino-opened (nth 10 attr))
 270           (setq number-opened number-linked))))))
 271
 272 ;; Make the given server, if non-nil, be the current server.  Then make the
 273 ;; given group, if non-nil, be the current group of the current server.  Then
 274 ;; return the group object for the current group.
 275 (defun nnmaildir--prepare (server group)
 276   (let (x groups)
 277     (catch 'return
 278       (if (null server)
 279           (unless (setq server nnmaildir--cur-server)
 280             (throw 'return nil))
 281         (unless (setq server (intern-soft server nnmaildir--servers))
 282           (throw 'return nil))
 283         (setq server (symbol-value server)
 284               nnmaildir--cur-server server))
 285       (unless (setq groups (nnmaildir--srv-groups server))
 286         (throw 'return nil))
 287       (unless (nnmaildir--srv-method server)
 288         (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
 289               x (gnus-server-to-method x))
 290         (unless x (throw 'return nil))
 291         (setf (nnmaildir--srv-method server) x))
 292       (if (null group)
 293           (unless (setq group (nnmaildir--srv-curgrp server))
 294             (throw 'return nil))
 295         (unless (setq group (intern-soft group groups))
 296           (throw 'return nil))
 297         (setq group (symbol-value group)))
 298       group)))
 299
 300 (defun nnmaildir--tab-to-space (string)
 301   (let ((pos 0))
 302     (while (string-match "\t" string pos)
 303       (aset string (match-beginning 0) ? )
 304       (setq pos (match-end 0))))
 305   string)
 306
 307 (defmacro nnmaildir--condcase (errsym body &rest handler)
 308   `(condition-case ,errsym
 309        (let ((system-messages-locale "C")) ,body)
 310      (error . ,handler)))
 311
 312 (defun nnmaildir--emlink-p (err)
 313   (and (eq (car err) 'file-error)
 314        (string= (downcase (caddr err)) "too many links")))
 315
 316 (defun nnmaildir--enoent-p (err)
 317   (and (eq (car err) 'file-error)
 318        (string= (downcase (caddr err)) "no such file or directory")))
 319
 320 (defun nnmaildir--eexist-p (err)
 321   (eq (car err) 'file-already-exists))
 322
 323 (defun nnmaildir--new-number (nndir)
 324   "Allocate a new article number by atomically creating a file under NNDIR."
 325   (let ((numdir (nnmaildir--num-dir nndir))
 326         (make-new-file t)
 327         (number-open 1)
 328         number-link previous-number-link path-open path-link ino-open)
 329     (nnmaildir--mkdir numdir)
 330     (catch 'return
 331       (while t
 332         (setq path-open (concat numdir (number-to-string number-open)))
 333         (if (not make-new-file)
 334             (setq previous-number-link number-link)
 335           (nnmaildir--mkfile path-open)
 336           ;; If Emacs had O_CREAT|O_EXCL, we could return number-open here.
 337           (setq make-new-file nil
 338                 previous-number-link 0))
 339         (let* ((attr (file-attributes path-open))
 340                (nlink (nth 1 attr)))
 341           (setq ino-open (nth 10 attr)
 342                 number-link (+ number-open nlink))
 343           (if (or (< nlink 1) (< number-link nlink))
 344               (signal 'error '("Arithmetic overflow"))))
 345         (if (= number-link previous-number-link)
 346             ;; We've already tried this number, in the previous loop iteration,
 347             ;; and failed.
 348             (signal 'error `("Corrupt internal nnmaildir data" ,path-open)))
 349         (setq path-link (concat numdir (number-to-string number-link)))
 350         (nnmaildir--condcase err
 351             (progn
 352               (add-name-to-file path-open path-link)
 353               (throw 'return number-link))
 354           (cond
 355            ((nnmaildir--emlink-p err)
 356             (setq make-new-file t
 357                   number-open number-link))
 358            ((nnmaildir--eexist-p err)
 359             (let ((attr (file-attributes path-link)))
 360               (unless (equal (nth 10 attr) ino-open)
 361                 (setq number-open number-link
 362                       number-link 0))))
 363            (t (signal (car err) (cdr err)))))))))
 364
 365 (defun nnmaildir--update-nov (server group article)
 366   (let ((nnheader-file-coding-system 'binary)
 367         (srv-dir (nnmaildir--srv-dir server))
 368         (storage-version 1) ;; [version article-number msgid [...nov...]]
 369         dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
 370         nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
 371         deactivate-mark)
 372     (catch 'return
 373       (setq gname (nnmaildir--grp-name group)
 374             pgname (nnmaildir--pgname server gname)
 375             dir (nnmaildir--srvgrp-dir srv-dir gname)
 376             msgdir (if (nnmaildir--param pgname 'read-only)
 377                        (nnmaildir--new dir) (nnmaildir--cur dir))
 378             prefix (nnmaildir--art-prefix article)
 379             suffix (nnmaildir--art-suffix article)
 380             file (concat msgdir prefix suffix)
 381             attr (file-attributes file))
 382       (unless attr
 383         (nnmaildir--expired-article group article)
 384         (throw 'return nil))
 385       (setq mtime (nth 5 attr)
 386             attr (nth 7 attr)
 387             nov (nnmaildir--art-nov article)
 388             dir (nnmaildir--nndir dir)
 389             novdir (nnmaildir--nov-dir dir)
 390             novfile (concat novdir prefix))
 391       (unless (equal nnmaildir--extra nnmail-extra-headers)
 392         (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
 393       (nnmaildir--with-nov-buffer
 394         ;; First we'll check for already-parsed NOV data.
 395         (cond ((not (file-exists-p novfile))
 396                ;; The NOV file doesn't exist; we have to parse the message.
 397                (setq nov nil))
 398               ((not nov)
 399                ;; The file exists, but the data isn't in memory; read the file.
 400                (erase-buffer)
 401                (nnheader-insert-file-contents novfile)
 402                (setq nov (read (current-buffer)))
 403                (if (not (and (vectorp nov)
 404                              (/= 0 (length nov))
 405                              (equal storage-version (aref nov 0))))
 406                    ;; This NOV data seems to be in the wrong format.
 407                    (setq nov nil)
 408                  (unless (nnmaildir--art-num   article)
 409                    (setf (nnmaildir--art-num   article) (aref nov 1)))
 410                  (unless (nnmaildir--art-msgid article)
 411                    (setf (nnmaildir--art-msgid article) (aref nov 2)))
 412                  (setq nov (aref nov 3)))))
 413         ;; Now check whether the already-parsed data (if we have any) is
 414         ;; usable: if the message has been edited or if nnmail-extra-headers
 415         ;; has been augmented since this data was parsed from the message,
 416         ;; then we have to reparse.  Otherwise it's up-to-date.
 417         (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov)))
 418           ;; The timestamp matches.  Now check nnmail-extra-headers.
 419           (setq old-extra (nnmaildir--nov-get-extra nov))
 420           (when (equal nnmaildir--extra old-extra) ;; common case
 421             ;; Save memory; use a single copy of the list value.
 422             (nnmaildir--nov-set-extra nov nnmaildir--extra)
 423             (throw 'return nov))
 424           ;; They're not equal, but maybe the new is a subset of the old.
 425           (if (null nnmaildir--extra)
 426               ;; The empty set is a subset of every set.
 427               (throw 'return nov))
 428           (if (not (memq nil (mapcar (lambda (e) (memq e old-extra))
 429                                      nnmaildir--extra)))
 430               (throw 'return nov)))
 431         ;; Parse the NOV data out of the message.
 432         (erase-buffer)
 433         (nnheader-insert-file-contents file)
 434         (insert "\n")
 435         (goto-char (point-min))
 436         (save-restriction
 437           (if (search-forward "\n\n" nil 'noerror)
 438               (progn
 439                 (setq nov-mid (count-lines (point) (point-max)))
 440                 (narrow-to-region (point-min) (1- (point))))
 441             (setq nov-mid 0))
 442           (goto-char (point-min))
 443           (delete-char 1)
 444           (setq nov (nnheader-parse-naked-head)
 445                 field (or (mail-header-lines nov) 0)))
 446         (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
 447           (setq nov-mid field))
 448         (setq nov-mid (number-to-string nov-mid)
 449               nov-mid (concat (number-to-string attr) "\t" nov-mid))
 450         (save-match-data
 451           (setq field (or (mail-header-references nov) ""))
 452           (nnmaildir--tab-to-space field)
 453           (setq nov-mid (concat field "\t" nov-mid)
 454                 nov-beg (mapconcat
 455                           (lambda (f) (nnmaildir--tab-to-space (or f "")))
 456                           (list (mail-header-subject nov)
 457                                 (mail-header-from nov)
 458                                 (mail-header-date nov)) "\t")
 459                 nov-end (mapconcat
 460                           (lambda (extra)
 461                             (setq field (symbol-name (car extra))
 462                                   val (cdr extra))
 463                             (nnmaildir--tab-to-space field)
 464                             (nnmaildir--tab-to-space val)
 465                             (concat field ": " val))
 466                           (mail-header-extra nov) "\t")))
 467         (setq msgid (mail-header-id nov))
 468         (if (or (null msgid) (nnheader-fake-message-id-p msgid))
 469             (setq msgid (concat "<" prefix "@nnmaildir>")))
 470         (nnmaildir--tab-to-space msgid)
 471         ;; The data is parsed; create an nnmaildir NOV structure.
 472         (setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime
 473                                       nnmaildir--extra)
 474               num (nnmaildir--art-num article))
 475         (unless num
 476           (setq num (nnmaildir--new-number dir))
 477           (setf (nnmaildir--art-num article) num))
 478         ;; Store this new NOV data in a file
 479         (erase-buffer)
 480         (prin1 (vector storage-version num msgid nov) (current-buffer))
 481         (setq file (concat novfile ":"))
 482         (nnmaildir--unlink file)
 483         (gmm-write-region (point-min) (point-max) file nil 'no-message nil
 484                           'excl))
 485       (rename-file file novfile 'replace)
 486       (setf (nnmaildir--art-msgid article) msgid)
 487       nov)))
 488
 489 (defun nnmaildir--cache-nov (group article nov)
 490   (let ((cache (nnmaildir--grp-cache group))
 491         (index (nnmaildir--grp-index group))
 492         goner)
 493     (unless (nnmaildir--art-nov article)
 494       (setq goner (aref cache index))
 495       (if goner (setf (nnmaildir--art-nov goner) nil))
 496       (aset cache index article)
 497       (setf (nnmaildir--grp-index group) (% (1+ index) (length cache))))
 498     (setf (nnmaildir--art-nov article) nov)))
 499
 500 (defun nnmaildir--grp-add-art (server group article)
 501   (let ((nov (nnmaildir--update-nov server group article))
 502         count num min nlist nlist-cdr insert-nlist)
 503     (when nov
 504       (setq count (1+ (nnmaildir--grp-count group))
 505             num (nnmaildir--art-num article)
 506             min (if (= count 1) num
 507                   (min num (nnmaildir--grp-min group)))
 508             nlist (nnmaildir--grp-nlist group))
 509       (if (or (null nlist) (> num (caar nlist)))
 510           (setq nlist (cons (cons num article) nlist))
 511         (setq insert-nlist t
 512               nlist-cdr (cdr nlist))
 513         (while (and nlist-cdr (< num (caar nlist-cdr)))
 514           (setq nlist nlist-cdr
 515                 nlist-cdr (cdr nlist))))
 516       (let ((inhibit-quit t))
 517         (setf (nnmaildir--grp-count group) count)
 518         (setf (nnmaildir--grp-min group) min)
 519         (if insert-nlist
 520             (setcdr nlist (cons (cons num article) nlist-cdr))
 521           (setf (nnmaildir--grp-nlist group) nlist))
 522         (set (intern (nnmaildir--art-prefix article)
 523                      (nnmaildir--grp-flist group))
 524              article)
 525         (set (intern (nnmaildir--art-msgid article)
 526                      (nnmaildir--grp-mlist group))
 527              article)
 528         (set (intern (nnmaildir--grp-name group)
 529                      (nnmaildir--srv-groups server))
 530              group))
 531       (nnmaildir--cache-nov group article nov)
 532       t)))
 533
 534 (defun nnmaildir--group-ls (server pgname)
 535   (or (nnmaildir--param pgname 'directory-files)
 536       (nnmaildir--srv-ls server)))
 537
 538 (defun nnmaildir-article-number-to-file-name
 539   (number group-name server-address-string)
 540   (let ((group (nnmaildir--prepare server-address-string group-name))
 541         article dir pgname)
 542     (catch 'return
 543       (unless group
 544         ;; The given group or server does not exist.
 545         (throw 'return nil))
 546       (setq article (nnmaildir--nlist-art group number))
 547       (unless article
 548         ;; The given article number does not exist in this group.
 549         (throw 'return nil))
 550       (setq pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
 551             dir (nnmaildir--srv-dir nnmaildir--cur-server)
 552             dir (nnmaildir--srvgrp-dir dir group-name)
 553             dir (if (nnmaildir--param pgname 'read-only)
 554                     (nnmaildir--new dir) (nnmaildir--cur dir)))
 555       (concat dir (nnmaildir--art-prefix article)
 556               (nnmaildir--art-suffix article)))))
 557
 558 (defun nnmaildir-article-number-to-base-name
 559   (number group-name server-address-string)
 560   (let ((x (nnmaildir--prepare server-address-string group-name)))
 561     (when x
 562       (setq x (nnmaildir--nlist-art x number))
 563       (and x (cons (nnmaildir--art-prefix x)
 564                    (nnmaildir--art-suffix x))))))
 565
 566 (defun nnmaildir-base-name-to-article-number
 567   (base-name group-name server-address-string)
 568   (let ((x (nnmaildir--prepare server-address-string group-name)))
 569     (when x
 570       (setq x (nnmaildir--grp-flist x)
 571             x (nnmaildir--flist-art x base-name))
 572       (and x (nnmaildir--art-num x)))))
 573
 574 (defun nnmaildir--nlist-iterate (nlist ranges func)
 575   (let (entry high low nlist2)
 576     (if (eq ranges 'all)
 577         (setq ranges `((1 . ,(caar nlist)))))
 578     (while ranges
 579       (setq entry (car ranges) ranges (cdr ranges))
 580       (while (and ranges (eq entry (car ranges)))
 581         (setq ranges (cdr ranges))) ;; skip duplicates
 582       (if (numberp entry)
 583           (setq low entry
 584                 high entry)
 585         (setq low (car entry)
 586               high (cdr entry)))
 587   &