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