/[emacs]/emacs/lisp/gnus/nnmaildir.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nnmaildir.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26