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

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