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