code.delx.au - gnu-emacs/blob - lisp/gnus/nnmaildir.el

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