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

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