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

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