1 ;;; nnmaildir.el --- maildir backend for Gnus
2 ;; Copyright (c) 2001 Free Software Foundation, Inc.
3 ;; Copyright (c) 2000, 2001 Paul Jarc <prj@po.cwru.edu>
5 ;; Author: Paul Jarc <prj@po.cwru.edu>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
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.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; Maildir format is documented in the maildir(5) man page from qmail
27 ;; and at <URL:http://cr.yp.to/proto/maildir.html>. nnmaildir also
28 ;; stores extra information in the .nnmaildir/ directory within a
31 ;; Some goals of nnmaildir:
32 ;; * Everything Just Works, and correctly. E.g., stale NOV data is
33 ;; ignored when articles have been edited; no need for
34 ;; -generate-nov-databases.
35 ;; * Perfect reliability: [C-g] will never corrupt its data in memory,
36 ;; and SIGKILL will never corrupt its data in the filesystem.
37 ;; * We make it easy to manipulate marks, etc., from outside Gnus.
38 ;; * All information about a group is stored in the maildir, for easy
39 ;; backup and restoring.
40 ;; * We use the filesystem as a database.
43 ;; * Ignore old NOV data when gnus-extra-headers has changed.
44 ;; * Don't force article renumbering, so nnmaildir can be used with
45 ;; the cache and agent. Alternatively, completely rewrite the Gnus
46 ;; backend interface, which would have other advantages.
48 ;; See also <URL:http://multivac.cwru.edu./nnmaildir/> until that
49 ;; information is added to the Gnus manual.
65 (defconst nnmaildir-version "Gnus")
67 (defvar nnmaildir-article-file-name nil
68 "*The filename of the most recently requested article. This variable is set
69 by nnmaildir-request-article.")
71 ;; The filename of the article being moved/copied:
72 (defvar nnmaildir--file nil)
74 ;; Variables to generate filenames of messages being delivered:
75 (defvar nnmaildir--delivery-time "")
76 (defconst nnmaildir--delivery-pid (number-to-string (emacs-pid)))
77 (defvar nnmaildir--delivery-ct nil)
79 ;; An obarry containing symbols whose names are server names and whose values
81 (defvar nnmaildir--servers (make-vector 3 0))
82 ;; A server which has not necessarily been added to nnmaildir--servers, or nil:
83 (defvar nnmaildir--tmp-server nil)
84 ;; The current server:
85 (defvar nnmaildir--cur-server nil)
87 ;; A server is a vector:
90 "/expanded/path/to/directory/containing/symlinks/to/maildirs/"
91 directory-files-function
92 group-name-transformation-function
93 ;; An obarray containing symbols whose names are group names and whose values
96 ;; A group which has not necessarily been added to the group hash, or nil:
98 current-group ;; or nil
99 "Last error message, or nil"
101 get-new-mail-p ;; Should we split mail from mail-sources?
102 "new/group/creation/directory"]
104 ;; A group is a vector:
106 "prefixed:group.name"
107 ;; Modification times of the "new", and "cur" directories:
110 ;; A vector containing lists of articles:
111 [;; A list of articles, with article numbers in descending order, ending with
114 ;; An obarray containing symbols whose names are filename prefixes and whose
115 ;; values are articles:
117 ;; Same as above, but keyed on Message-ID:
119 ;; An article which has not necessarily been added to the file and msgid
122 ;; A vector containing nil, or articles with NOV data:
124 ;; The index of the next nov-cache entry to be replaced:
126 ;; An obarray containing symbols whose names are mark names and whose values
127 ;; are modtimes of mark directories:
130 ;; An article is a vector:
132 ":2,suffix" ;; or 'expire if expired
135 ;; A NOV data vector, or nil:
136 ["subject\tfrom\tdate"
137 "references\tchars\lines"
139 article-file-modtime]]
141 (defmacro nnmaildir--srv-new () '(make-vector 11 nil))
142 (defmacro nnmaildir--srv-get-name (server) `(aref ,server 0))
143 (defmacro nnmaildir--srv-get-method (server) `(aref ,server 1))
144 (defmacro nnmaildir--srv-get-dir (server) `(aref ,server 2))
145 (defmacro nnmaildir--srv-get-ls (server) `(aref ,server 3))
146 (defmacro nnmaildir--srv-get-groups (server) `(aref ,server 4))
147 (defmacro nnmaildir--srv-get-tmpgrp (server) `(aref ,server 5))
148 (defmacro nnmaildir--srv-get-curgrp (server) `(aref ,server 6))
149 (defmacro nnmaildir--srv-get-error (server) `(aref ,server 7))
150 (defmacro nnmaildir--srv-get-mtime (server) `(aref ,server 8))
151 (defmacro nnmaildir--srv-get-gnm (server) `(aref ,server 9))
152 (defmacro nnmaildir--srv-get-create-dir (server) `(aref ,server 10))
153 (defmacro nnmaildir--srv-set-name (server val) `(aset ,server 0 ,val))
154 (defmacro nnmaildir--srv-set-method (server val) `(aset ,server 1 ,val))
155 (defmacro nnmaildir--srv-set-dir (server val) `(aset ,server 2 ,val))
156 (defmacro nnmaildir--srv-set-ls (server val) `(aset ,server 3 ,val))
157 (defmacro nnmaildir--srv-set-groups (server val) `(aset ,server 4 ,val))
158 (defmacro nnmaildir--srv-set-tmpgrp (server val) `(aset ,server 5 ,val))
159 (defmacro nnmaildir--srv-set-curgrp (server val) `(aset ,server 6 ,val))
160 (defmacro nnmaildir--srv-set-error (server val) `(aset ,server 7 ,val))
161 (defmacro nnmaildir--srv-set-mtime (server val) `(aset ,server 8 ,val))
162 (defmacro nnmaildir--srv-set-gnm (server val) `(aset ,server 9 ,val))
163 (defmacro nnmaildir--srv-set-create-dir (server val) `(aset ,server 10 ,val))
165 (defmacro nnmaildir--grp-new () '(make-vector 8 nil))
166 (defmacro nnmaildir--grp-get-name (group) `(aref ,group 0))
167 (defmacro nnmaildir--grp-get-pname (group) `(aref ,group 1))
168 (defmacro nnmaildir--grp-get-new (group) `(aref ,group 2))
169 (defmacro nnmaildir--grp-get-cur (group) `(aref ,group 3))
170 (defmacro nnmaildir--grp-get-lists (group) `(aref ,group 4))
171 (defmacro nnmaildir--grp-get-cache (group) `(aref ,group 5))
172 (defmacro nnmaildir--grp-get-index (group) `(aref ,group 6))
173 (defmacro nnmaildir--grp-get-mmth (group) `(aref ,group 7))
174 (defmacro nnmaildir--grp-set-name (group val) `(aset ,group 0 ,val))
175 (defmacro nnmaildir--grp-set-pname (group val) `(aset ,group 1 ,val))
176 (defmacro nnmaildir--grp-set-new (group val) `(aset ,group 2 ,val))
177 (defmacro nnmaildir--grp-set-cur (group val) `(aset ,group 3 ,val))
178 (defmacro nnmaildir--grp-set-lists (group val) `(aset ,group 4 ,val))
179 (defmacro nnmaildir--grp-set-cache (group val) `(aset ,group 5 ,val))
180 (defmacro nnmaildir--grp-set-index (group val) `(aset ,group 6 ,val))
181 (defmacro nnmaildir--grp-set-mmth (group val) `(aset ,group 7 ,val))
183 (defmacro nnmaildir--lists-new () '(make-vector 4 nil))
184 (defmacro nnmaildir--lists-get-nlist (lists) `(aref ,lists 0))
185 (defmacro nnmaildir--lists-get-flist (lists) `(aref ,lists 1))
186 (defmacro nnmaildir--lists-get-mlist (lists) `(aref ,lists 2))
187 (defmacro nnmaildir--lists-get-tmpart (lists) `(aref ,lists 3))
188 (defmacro nnmaildir--lists-set-nlist (lists val) `(aset ,lists 0 ,val))
189 (defmacro nnmaildir--lists-set-flist (lists val) `(aset ,lists 1 ,val))
190 (defmacro nnmaildir--lists-set-mlist (lists val) `(aset ,lists 2 ,val))
191 (defmacro nnmaildir--lists-set-tmpart (lists val) `(aset ,lists 3 ,val))
193 (defmacro nnmaildir--nlist-last-num (list)
194 `(if ,list (nnmaildir--art-get-num (car ,list)) 0))
195 (defmacro nnmaildir--nlist-art (list num)
197 (>= (nnmaildir--art-get-num (car ,list)) ,num)
198 (nth (- (nnmaildir--art-get-num (car ,list)) ,num) ,list)))
199 (defmacro nnmaildir--flist-art (list file)
200 `(symbol-value (intern-soft ,file ,list)))
201 (defmacro nnmaildir--mlist-art (list msgid)
202 `(symbol-value (intern-soft ,msgid ,list)))
204 (defmacro nnmaildir--art-new () '(make-vector 5 nil))
205 (defmacro nnmaildir--art-get-prefix (article) `(aref ,article 0))
206 (defmacro nnmaildir--art-get-suffix (article) `(aref ,article 1))
207 (defmacro nnmaildir--art-get-num (article) `(aref ,article 2))
208 (defmacro nnmaildir--art-get-msgid (article) `(aref ,article 3))
209 (defmacro nnmaildir--art-get-nov (article) `(aref ,article 4))
210 (defmacro nnmaildir--art-set-prefix (article val) `(aset ,article 0 ,val))
211 (defmacro nnmaildir--art-set-suffix (article val) `(aset ,article 1 ,val))
212 (defmacro nnmaildir--art-set-num (article val) `(aset ,article 2 ,val))
213 (defmacro nnmaildir--art-set-msgid (article val) `(aset ,article 3 ,val))
214 (defmacro nnmaildir--art-set-nov (article val) `(aset ,article 4 ,val))
216 (defmacro nnmaildir--nov-new () '(make-vector 4 nil))
217 (defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
218 (defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
219 (defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
220 (defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
221 (defmacro nnmaildir--nov-set-beg (nov val) `(aset ,nov 0 ,val))
222 (defmacro nnmaildir--nov-set-mid (nov val) `(aset ,nov 1 ,val))
223 (defmacro nnmaildir--nov-set-end (nov val) `(aset ,nov 2 ,val))
224 (defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val))
226 (defmacro nnmaildir--srv-grp-dir (srv-dir gname)
227 `(file-name-as-directory (concat ,srv-dir ,gname)))
229 (defun nnmaildir--param (prefixed-group-name param)
231 (gnus-group-find-parameter prefixed-group-name param 'allow-list)
232 param (if (vectorp param) (aref param 0) param))
235 (defmacro nnmaildir--unlink (file)
236 `(if (file-attributes ,file) (delete-file ,file)))
238 (defmacro nnmaildir--tmp (dir) `(file-name-as-directory (concat ,dir "tmp")))
239 (defmacro nnmaildir--new (dir) `(file-name-as-directory (concat ,dir "new")))
240 (defmacro nnmaildir--cur (dir) `(file-name-as-directory (concat ,dir "cur")))
241 (defmacro nnmaildir--nndir (dir)
242 `(file-name-as-directory (concat ,dir ".nnmaildir")))
244 (defun nnmaildir--lists-fix (lists)
245 (let ((tmp (nnmaildir--lists-get-tmpart lists)))
247 (set (intern (nnmaildir--art-get-prefix tmp)
248 (nnmaildir--lists-get-flist lists))
250 (set (intern (nnmaildir--art-get-msgid tmp)
251 (nnmaildir--lists-get-mlist lists))
253 (nnmaildir--lists-set-tmpart lists nil))))
255 (defun nnmaildir--prepare (server group)
258 (setq x nnmaildir--tmp-server)
260 (set (intern (nnmaildir--srv-get-name x) nnmaildir--servers) x)
261 (setq nnmaildir--tmp-server nil))
263 (or (setq server nnmaildir--cur-server)
265 (or (setq server (intern-soft server nnmaildir--servers))
267 (setq server (symbol-value server)
268 nnmaildir--cur-server server))
269 (setq groups (nnmaildir--srv-get-groups server))
270 (if groups nil (throw 'return nil))
271 (if (nnmaildir--srv-get-method server) nil
272 (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server))
273 x (gnus-server-to-method x))
274 (if x nil (throw 'return nil))
275 (nnmaildir--srv-set-method server x))
276 (setq x (nnmaildir--srv-get-tmpgrp server))
278 (set (intern (nnmaildir--grp-get-name x) groups) x)
279 (nnmaildir--srv-set-tmpgrp server nil))
281 (or (setq group (nnmaildir--srv-get-curgrp server))
283 (setq group (intern-soft group groups))
284 (if group nil (throw 'return nil))
285 (setq group (symbol-value group)))
286 (nnmaildir--lists-fix (nnmaildir--grp-get-lists group))
289 (defun nnmaildir--update-nov (srv-dir group article)
290 (let ((nnheader-file-coding-system 'binary)
291 dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
292 nov msgid nov-beg nov-mid nov-end field pos extra val deactivate-mark)
294 (setq suffix (nnmaildir--art-get-suffix article))
295 (if (stringp suffix) nil
296 (nnmaildir--art-set-nov article nil)
298 (setq gname (nnmaildir--grp-get-name group)
299 pgname (nnmaildir--grp-get-pname group)
300 dir (nnmaildir--srv-grp-dir srv-dir gname)
301 msgdir (if (nnmaildir--param pgname 'read-only)
302 (nnmaildir--new dir) (nnmaildir--cur dir))
303 prefix (nnmaildir--art-get-prefix article)
304 file (concat msgdir prefix suffix)
305 attr (file-attributes file))
307 (nnmaildir--art-set-suffix article 'expire)
308 (nnmaildir--art-set-nov article nil)
310 (setq mtime (nth 5 attr)
312 nov (nnmaildir--art-get-nov article)
313 novdir (concat (nnmaildir--nndir dir) "nov")
314 novdir (file-name-as-directory novdir)
315 novfile (concat novdir prefix))
317 (set-buffer (get-buffer-create " *nnmaildir nov*"))
318 (when (file-exists-p novfile)
320 (equal mtime (nnmaildir--nov-get-mtime nov))
323 (nnheader-insert-file-contents novfile)
324 (setq nov (read (current-buffer)))
325 (nnmaildir--art-set-msgid article (car nov))
326 (setq nov (cadr nov))
327 (and (equal mtime (nnmaildir--nov-get-mtime nov))
328 (throw 'return nov)))
330 (nnheader-insert-file-contents file)
332 (goto-char (point-min))
334 (if (search-forward "\n\n" nil 'noerror)
336 (setq nov-mid (count-lines (point) (point-max)))
337 (narrow-to-region (point-min) (1- (point))))
339 (goto-char (point-min))
341 (nnheader-fold-continuation-lines)
342 (setq nov (nnheader-parse-head 'naked)
343 field (or (mail-header-lines nov) 0)))
344 (if (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) nil
345 (setq nov-mid field))
346 (setq nov-mid (number-to-string nov-mid)
347 nov-mid (concat (number-to-string attr) "\t" nov-mid)
348 field (or (mail-header-references nov) "")
351 (while (string-match "\t" field pos)
352 (aset field (match-beginning 0) ? )
353 (setq pos (match-end 0)))
354 (setq nov-mid (concat field "\t" nov-mid)
355 extra (mail-header-extra nov)
358 (setq field (car extra) extra (cdr extra)
359 val (cdr field) field (symbol-name (car field))
361 (while (string-match "\t" field pos)
362 (aset field (match-beginning 0) ? )
363 (setq pos (match-end 0)))
365 (while (string-match "\t" val pos)
366 (aset val (match-beginning 0) ? )
367 (setq pos (match-end 0)))
368 (setq nov-end (concat nov-end "\t" field ": " val)))
369 (setq nov-end (if (zerop (length nov-end)) "" (substring nov-end 1))
370 field (or (mail-header-subject nov) "")
372 (while (string-match "\t" field pos)
373 (aset field (match-beginning 0) ? )
374 (setq pos (match-end 0)))
376 field (or (mail-header-from nov) "")
378 (while (string-match "\t" field pos)
379 (aset field (match-beginning 0) ? )
380 (setq pos (match-end 0)))
381 (setq nov-beg (concat nov-beg "\t" field)
382 field (or (mail-header-date nov) "")
384 (while (string-match "\t" field pos)
385 (aset field (match-beginning 0) ? )
386 (setq pos (match-end 0)))
387 (setq nov-beg (concat nov-beg "\t" field)
388 field (mail-header-id nov)
390 (while (string-match "\t" field pos)
391 (aset field (match-beginning 0) ? )
392 (setq pos (match-end 0)))
394 (if (or (null msgid) (nnheader-fake-message-id-p msgid))
395 (setq msgid (concat "<" prefix "@nnmaildir>")))
397 (setq nov (nnmaildir--nov-new))
398 (nnmaildir--nov-set-beg nov nov-beg)
399 (nnmaildir--nov-set-mid nov nov-mid)
400 (nnmaildir--nov-set-end nov nov-end)
401 (nnmaildir--nov-set-mtime nov mtime)
402 (prin1 (list msgid nov) (current-buffer))
403 (setq file (concat novdir ":"))
404 (nnmaildir--unlink file)
405 (write-region (point-min) (point-max) file nil 'no-message))
406 (rename-file file novfile 'replace)
407 (nnmaildir--art-set-msgid article msgid)
410 (defun nnmaildir--cache-nov (group article nov)
411 (let ((cache (nnmaildir--grp-get-cache group))
412 (index (nnmaildir--grp-get-index group))
414 (if (nnmaildir--art-get-nov article) nil
415 (setq goner (aref cache index))
416 (if goner (nnmaildir--art-set-nov goner nil))
417 (aset cache index article)
418 (nnmaildir--grp-set-index group (% (1+ index) (length cache))))
419 (nnmaildir--art-set-nov article nov)))
421 (defun nnmaildir--grp-add-art (srv-dir group article)
422 (let ((nov (nnmaildir--update-nov srv-dir group article))
425 (setq old-lists (nnmaildir--grp-get-lists group)
426 new-lists (nnmaildir--lists-new))
427 (nnmaildir--lists-set-nlist
428 new-lists (cons article (nnmaildir--lists-get-nlist old-lists)))
429 (nnmaildir--lists-set-flist new-lists
430 (nnmaildir--lists-get-flist old-lists))
431 (nnmaildir--lists-set-mlist new-lists
432 (nnmaildir--lists-get-mlist old-lists))
433 (nnmaildir--lists-set-tmpart new-lists article)
434 (nnmaildir--grp-set-lists group new-lists)
435 (nnmaildir--lists-fix new-lists)
436 (nnmaildir--cache-nov group article nov)
439 (defun nnmaildir--mkdir (dir)
440 (or (file-exists-p (file-name-as-directory dir))
441 (make-directory-internal (directory-file-name dir))))
443 (defun nnmaildir--article-count (group)
446 (setq group (nnmaildir--grp-get-lists group)
447 group (nnmaildir--lists-get-nlist group))
449 (if (stringp (nnmaildir--art-get-suffix (car group)))
451 min (nnmaildir--art-get-num (car group))))
452 (setq group (cdr group)))
455 (defun nnmaildir-article-number-to-file-name
456 (number group-name server-address-string)
457 (let ((group (nnmaildir--prepare server-address-string group-name))
458 list article suffix dir filename)
461 ;; The given group or server does not exist.
463 (setq list (nnmaildir--grp-get-lists group)
464 list (nnmaildir--lists-get-nlist list)
465 article (nnmaildir--nlist-art list number))
467 ;; The given article number does not exist in this group.
469 (setq suffix (nnmaildir--art-get-suffix article))
470 (if (not (stringp suffix))
471 ;; The article has expired.
473 (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
474 dir (nnmaildir--srv-grp-dir dir group-name)
475 group (if (nnmaildir--param (nnmaildir--grp-get-pname group)
477 (nnmaildir--new dir) (nnmaildir--cur dir))
478 filename (concat group (nnmaildir--art-get-prefix article) suffix))
479 (if (file-exists-p filename)
481 ;; The article disappeared out from under us.
482 (nnmaildir--art-set-suffix article 'expire)
483 (nnmaildir--art-set-nov article nil)
486 (defun nnmaildir-request-type (group &optional article)
489 (defun nnmaildir-status-message (&optional server)
490 (nnmaildir--prepare server nil)
491 (nnmaildir--srv-get-error nnmaildir--cur-server))
493 (defun nnmaildir-server-opened (&optional server)
494 (and nnmaildir--cur-server
497 (nnmaildir--srv-get-name nnmaildir--cur-server))
499 (nnmaildir--srv-get-groups nnmaildir--cur-server)
502 (defun nnmaildir-open-server (server &optional defs)
506 (setq server (intern-soft x nnmaildir--servers))
508 (and (setq server (symbol-value server))
509 (nnmaildir--srv-get-groups server)
510 (setq nnmaildir--cur-server server)
512 (setq server (nnmaildir--srv-new))
513 (nnmaildir--srv-set-name server x)
514 (setq nnmaildir--tmp-server server)
515 (set (intern x nnmaildir--servers) server)
516 (setq nnmaildir--tmp-server nil))
517 (setq dir (assq 'directory defs))
519 (nnmaildir--srv-set-error
520 server "You must set \"directory\" in the select method")
524 dir (expand-file-name dir)
525 dir (file-name-as-directory dir))
526 (if (file-exists-p dir) nil
527 (nnmaildir--srv-set-error server (concat "No such directory: " dir))
529 (nnmaildir--srv-set-dir server dir)
530 (setq x (assq 'directory-files defs))
532 (setq x (symbol-function (if nnheader-directory-files-is-safe
534 'nnheader-directory-files-safe)))
536 (if (functionp x) nil
537 (nnmaildir--srv-set-error
538 server (concat "Not a function: " (prin1-to-string x)))
539 (throw 'return nil)))
540 (nnmaildir--srv-set-ls server x)
541 (setq x (funcall x dir nil "\\`[^.]" 'nosort)
544 (while (<= size x) (setq size (* 2 size)))
545 (if (/= size 1) (setq size (1- size)))
546 (and (setq x (assq 'get-new-mail defs))
549 (nnmaildir--srv-set-gnm server t)
551 (setq x (assq 'create-directory defs))
555 (nnmaildir--srv-set-create-dir server x))
556 (nnmaildir--srv-set-groups server (make-vector size 0))
557 (setq nnmaildir--cur-server server)
560 (defun nnmaildir--parse-filename (file)
561 (let ((prefix (car file))
564 "\\`\\([0-9]+\\)\\.\\([0-9]+\\)\\(_\\([0-9]+\\)\\)?\\(\\..*\\)\\'"
567 (setq timestamp (concat "0000" (match-string 1 prefix))
568 len (- (length timestamp) 4))
569 (vector (string-to-number (substring timestamp 0 len))
570 (string-to-number (substring timestamp len))
571 (string-to-number (match-string 2 prefix))
572 (string-to-number (or (match-string 4 prefix) "-1"))
573 (match-string 5 prefix)
577 (defun nnmaildir--sort-files (a b)
580 (throw 'return (and (consp b) (string-lessp (car a) (car b)))))
581 (if (consp b) (throw 'return t))
582 (if (< (aref a 0) (aref b 0)) (throw 'return t))
583 (if (> (aref a 0) (aref b 0)) (throw 'return nil))
584 (if (< (aref a 1) (aref b 1)) (throw 'return t))
585 (if (> (aref a 1) (aref b 1)) (throw 'return nil))
586 (if (< (aref a 2) (aref b 2)) (throw 'return t))
587 (if (> (aref a 2) (aref b 2)) (throw 'return nil))
588 (if (< (aref a 3) (aref b 3)) (throw 'return t))
589 (if (> (aref a 3) (aref b 3)) (throw 'return nil))
590 (string-lessp (aref a 4) (aref b 4))))
592 (defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls)
594 (let ((36h-ago (- (car (current-time)) 2))
595 absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
596 files file num dir flist group x)
597 (setq absdir (file-name-as-directory (concat srv-dir gname))
598 nndir (nnmaildir--nndir absdir))
599 (if (file-attributes absdir) nil
600 (nnmaildir--srv-set-error nnmaildir--cur-server
601 (concat "No such directory: " absdir))
603 (setq tdir (nnmaildir--tmp absdir)
604 ndir (nnmaildir--new absdir)
605 cdir (nnmaildir--cur absdir)
606 nattr (file-attributes ndir)
607 cattr (file-attributes cdir))
608 (if (and (file-exists-p tdir) nattr cattr) nil
609 (nnmaildir--srv-set-error nnmaildir--cur-server
610 (concat "Not a maildir: " absdir))
612 (setq group (nnmaildir--prepare nil gname))
615 pgname (nnmaildir--grp-get-pname group))
617 group (nnmaildir--grp-new)
618 pgname (gnus-group-prefixed-name gname method))
619 (nnmaildir--grp-set-name group gname)
620 (nnmaildir--grp-set-pname group pgname)
621 (nnmaildir--grp-set-lists group (nnmaildir--lists-new))
622 (nnmaildir--grp-set-index group 0)
623 (nnmaildir--mkdir nndir)
624 (nnmaildir--mkdir (concat nndir "nov"))
625 (nnmaildir--mkdir (concat nndir "marks"))
626 (write-region "" nil (concat nndir "markfile") nil 'no-message))
627 (setq read-only (nnmaildir--param pgname 'read-only)
628 ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
630 (setq x (nth 11 (file-attributes tdir)))
631 (if (and (= x (nth 11 nattr)) (= x (nth 11 cattr))) nil
632 (nnmaildir--srv-set-error nnmaildir--cur-server
633 (concat "Maildir spans filesystems: "
636 (setq files (funcall ls tdir 'full "\\`[^.]" 'nosort))
638 (setq file (car files) files (cdr files)
639 x (file-attributes file))
640 (if (or (< 1 (cadr x)) (> 36h-ago (car (nth 4 x))))
641 (delete-file file))))
645 (setq nattr (nth 5 nattr))
646 (if (equal nattr (nnmaildir--grp-get-new group))
648 (if read-only (setq dir (and (or isnew nattr) ndir))
649 (when (or isnew nattr)
650 (setq files (funcall ls ndir nil "\\`[^.]" 'nosort))
652 (setq file (car files) files (cdr files))
653 (rename-file (concat ndir file) (concat cdir file ":2,")))
654 (nnmaildir--grp-set-new group nattr))
655 (setq cattr (file-attributes cdir)
657 (if (equal cattr (nnmaildir--grp-get-cur group))
659 (setq dir (and (or isnew cattr) cdir)))
660 (if dir nil (throw 'return t))
661 (setq files (funcall ls dir nil "\\`[^.]" 'nosort))
663 (setq x (length files)
665 (while (<= num x) (setq num (* 2 num)))
666 (if (/= num 1) (setq num (1- num)))
667 (setq x (nnmaildir--grp-get-lists group))
668 (nnmaildir--lists-set-flist x (make-vector num 0))
669 (nnmaildir--lists-set-mlist x (make-vector num 0))
670 (nnmaildir--grp-set-mmth group (make-vector 1 0))
671 (setq num (nnmaildir--param pgname 'nov-cache-size))
672 (if (numberp num) (if (< num 1) (setq num 1))
675 cdir (file-name-as-directory (concat nndir "marks"))
676 ndir (file-name-as-directory (concat cdir "tick"))
677 cdir (file-name-as-directory (concat cdir "read")))
679 (setq file (car x) x (cdr x))
680 (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
681 (setq file (match-string 1 file))
682 (if (or (not (file-exists-p (concat cdir file)))
683 (file-exists-p (concat ndir file)))
684 (setq num (1+ num)))))
685 (nnmaildir--grp-set-cache group (make-vector num nil))
686 (nnmaildir--srv-set-tmpgrp nnmaildir--cur-server group)
687 (set (intern gname groups) group)
688 (nnmaildir--srv-set-tmpgrp nnmaildir--cur-server nil)
689 (or scan-msgs (throw 'return t)))
690 (setq flist (nnmaildir--grp-get-lists group)
691 num (nnmaildir--lists-get-nlist flist)
692 flist (nnmaildir--lists-get-flist flist)
693 num (nnmaildir--nlist-last-num num)
697 (setq file (car x) x (cdr x))
698 (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
699 (setq file (cons (match-string 1 file) (match-string 2 file)))
700 (if (nnmaildir--flist-art flist (car file)) nil
701 (setq files (cons file files))))
702 (setq files (mapcar 'nnmaildir--parse-filename files)
703 files (sort files 'nnmaildir--sort-files))
705 (setq file (car files) files (cdr files)
706 file (if (consp file) file (aref file 5))
707 x (nnmaildir--art-new))
708 (nnmaildir--art-set-prefix x (car file))
709 (nnmaildir--art-set-suffix x (cdr file))
710 (nnmaildir--art-set-num x (1+ num))
711 (if (nnmaildir--grp-add-art srv-dir group x)
712 (setq num (1+ num))))
713 (if read-only (nnmaildir--grp-set-new group nattr)
714 (nnmaildir--grp-set-cur group cattr)))
717 (defun nnmaildir-request-scan (&optional scan-group server)
718 (let ((coding-system-for-write nnheader-file-coding-system)
719 (buffer-file-coding-system nil)
720 (file-coding-system-alist nil)
721 (nnmaildir-get-new-mail t)
722 (nnmaildir-group-alist nil)
723 (nnmaildir-active-file nil)
724 x srv-ls srv-dir method groups group dirs grp-dir seen deactivate-mark)
725 (nnmaildir--prepare server nil)
726 (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server)
727 srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
728 method (nnmaildir--srv-get-method nnmaildir--cur-server)
729 groups (nnmaildir--srv-get-groups nnmaildir--cur-server))
731 (set-buffer (get-buffer-create " *nnmaildir work*"))
733 (if (stringp scan-group)
734 (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls)
735 (if (nnmaildir--srv-get-gnm nnmaildir--cur-server)
736 (nnmail-get-new-mail 'nnmaildir nil nil scan-group))
737 (unintern scan-group groups))
738 (setq x (nth 5 (file-attributes srv-dir)))
739 (if (equal x (nnmaildir--srv-get-mtime nnmaildir--cur-server))
741 (mapatoms (lambda (sym)
742 (nnmaildir--scan (symbol-name sym) t groups
743 method srv-dir srv-ls))
745 (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
748 (while (<= seen x) (setq seen (* 2 seen)))
749 (if (/= seen 1) (setq seen (1- seen)))
750 (setq seen (make-vector seen 0)
751 scan-group (null scan-group))
753 (setq grp-dir (car dirs) dirs (cdr dirs))
754 (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
756 (intern grp-dir seen)))
758 (mapatoms (lambda (group)
759 (setq group (symbol-name group))
760 (if (intern-soft group seen) nil
761 (setq x (cons group x))))
764 (unintern (car x) groups)
766 (nnmaildir--srv-set-mtime nnmaildir--cur-server
767 (nth 5 (file-attributes srv-dir))))
768 (if (nnmaildir--srv-get-gnm nnmaildir--cur-server)
769 (nnmail-get-new-mail 'nnmaildir nil nil))))))
772 (defun nnmaildir-request-list (&optional server)
773 (nnmaildir-request-scan 'find-new-groups server)
774 (let (pgname ro ct-min deactivate-mark)
775 (nnmaildir--prepare server nil)
777 (set-buffer nntp-server-buffer)
779 (mapatoms (lambda (group)
780 (setq group (symbol-value group)
781 ro (nnmaildir--param (nnmaildir--grp-get-pname group)
783 ct-min (nnmaildir--article-count group))
784 (insert (nnmaildir--grp-get-name group) " ")
785 (princ (car ct-min) nntp-server-buffer)
787 (princ (cdr ct-min) nntp-server-buffer)
788 (insert " " (if ro "n" "y") "\n"))
789 (nnmaildir--srv-get-groups nnmaildir--cur-server))))
792 (defun nnmaildir-request-newgroups (date &optional server)
793 (nnmaildir-request-list server))
795 (defun nnmaildir-retrieve-groups (groups &optional server)
796 (let (gname group ct-min deactivate-mark)
797 (nnmaildir--prepare server nil)
799 (set-buffer nntp-server-buffer)
802 (setq gname (car groups) groups (cdr groups))
803 (nnmaildir-request-scan gname server)
804 (setq group (nnmaildir--prepare nil gname))
805 (if (null group) (insert "411 no such news group\n")
806 (setq ct-min (nnmaildir--article-count group))
808 (princ (car ct-min) nntp-server-buffer)
810 (princ (cdr ct-min) nntp-server-buffer)
812 (princ (nnmaildir--nlist-last-num
813 (nnmaildir--lists-get-nlist
814 (nnmaildir--grp-get-lists group)))
816 (insert " " gname "\n")))))
819 (defun nnmaildir-request-update-info (gname info &optional server)
820 (nnmaildir-request-scan gname server)
821 (let ((group (nnmaildir--prepare server gname))
822 srv-ls pgname nlist flist last always-marks never-marks old-marks
823 dotfile num dir markdirs marks mark ranges articles article read end
824 new-marks ls old-mmth new-mmth mtime mark-sym deactivate-mark)
827 (nnmaildir--srv-set-error nnmaildir--cur-server
828 (concat "No such group: " gname))
830 (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server)
831 gname (nnmaildir--grp-get-name group)
832 pgname (nnmaildir--grp-get-pname group)
833 nlist (nnmaildir--grp-get-lists group)
834 flist (nnmaildir--lists-get-flist nlist)
835 nlist (nnmaildir--lists-get-nlist nlist))
837 (gnus-info-set-read info nil)
838 (gnus-info-set-marks info nil 'extend)
839 (throw 'return info))
840 (setq old-marks (cons 'read (gnus-info-read info))
841 old-marks (cons old-marks (gnus-info-marks info))
842 last (nnmaildir--nlist-last-num nlist)
843 always-marks (nnmaildir--param pgname 'always-marks)
844 never-marks (nnmaildir--param pgname 'never-marks)
845 dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
846 dir (nnmaildir--srv-grp-dir dir gname)
847 dir (nnmaildir--nndir dir)
848 dir (concat dir "marks")
849 dir (file-name-as-directory dir)
850 ls (nnmaildir--param pgname 'directory-files)
852 markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
853 num (length markdirs)
855 (while (<= new-mmth num) (setq new-mmth (* 2 new-mmth)))
856 (if (/= new-mmth 1) (setq new-mmth (1- new-mmth)))
857 (setq new-mmth (make-vector new-mmth 0)
858 old-mmth (nnmaildir--grp-get-mmth group))
860 (setq mark (car markdirs) markdirs (cdr markdirs)
861 articles (concat dir mark)
862 articles (file-name-as-directory articles)
863 mark-sym (intern mark)
866 (if (memq mark-sym never-marks) (throw 'got-ranges nil))
867 (when (memq mark-sym always-marks)
868 (setq ranges (list (cons 1 last)))
869 (throw 'got-ranges nil))
870 (setq mtime (file-attributes articles)
872 (set (intern mark new-mmth) mtime)
873 (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
874 (setq ranges (assq mark-sym old-marks))
875 (if ranges (setq ranges (cdr ranges)))
876 (throw 'got-ranges nil))
877 (setq articles (funcall ls articles nil "\\`[^.]" 'nosort))
879 (setq article (car articles) articles (cdr articles)
880 article (nnmaildir--flist-art flist article))
882 (setq num (nnmaildir--art-get-num article)
883 ranges (gnus-add-to-range ranges (list num))))))
884 (if (eq mark-sym 'read) (setq read ranges)
885 (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
886 (gnus-info-set-read info read)
887 (gnus-info-set-marks info marks 'extend)
888 (nnmaildir--grp-set-mmth group new-mmth)
891 (defun nnmaildir-request-group (gname &optional server fast)
892 (nnmaildir-request-scan gname server)
893 (let ((group (nnmaildir--prepare server gname))
894 ct-min deactivate-mark)
896 (set-buffer nntp-server-buffer)
900 (insert "411 no such news group\n")
901 (nnmaildir--srv-set-error nnmaildir--cur-server
902 (concat "No such group: " gname))
904 (nnmaildir--srv-set-curgrp nnmaildir--cur-server group)
905 (if fast (throw 'return t))
906 (setq ct-min (nnmaildir--article-count group))
908 (princ (car ct-min) nntp-server-buffer)
910 (princ (cdr ct-min) nntp-server-buffer)
912 (princ (nnmaildir--nlist-last-num
913 (nnmaildir--lists-get-nlist
914 (nnmaildir--grp-get-lists group)))
916 (insert " " gname "\n")
919 (defun nnmaildir-request-create-group (gname &optional server args)
920 (nnmaildir--prepare server nil)
922 (let ((create-dir (nnmaildir--srv-get-create-dir nnmaildir--cur-server))
924 (when (zerop (length gname))
925 (nnmaildir--srv-set-error nnmaildir--cur-server
926 "Invalid (empty) group name")
928 (when (eq (aref "." 0) (aref gname 0))
929 (nnmaildir--srv-set-error nnmaildir--cur-server
930 "Group names may not start with \".\"")
932 (when (save-match-data (string-match "[\0/\t]" gname))
933 (nnmaildir--srv-set-error nnmaildir--cur-server
934 (concat "Illegal characters (null, tab, or /) in group name: "
937 (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server))
938 (when (intern-soft gname groups)
939 (nnmaildir--srv-set-error nnmaildir--cur-server
940 (concat "Group already exists: " gname))
942 (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server))
943 (if (file-name-absolute-p create-dir)
944 (setq dir (expand-file-name create-dir))
946 dir (file-truename dir)
947 dir (concat dir create-dir)))
948 (setq dir (file-name-as-directory dir)
949 dir (concat dir gname))
950 (nnmaildir--mkdir dir)
951 (setq dir (file-name-as-directory dir))
952 (nnmaildir--mkdir (concat dir "tmp"))
953 (nnmaildir--mkdir (concat dir "new"))
954 (nnmaildir--mkdir (concat dir "cur"))
955 (setq create-dir (file-name-as-directory create-dir))
956 (make-symbolic-link (concat create-dir gname) (concat srv-dir gname))
957 (nnmaildir-request-scan 'find-new-groups))))
959 (defun nnmaildir-request-rename-group (gname new-name &optional server)
960 (let ((group (nnmaildir--prepare server gname))
961 (coding-system-for-write nnheader-file-coding-system)
962 (buffer-file-coding-system nil)
963 (file-coding-system-alist nil)
967 (nnmaildir--srv-set-error nnmaildir--cur-server
968 (concat "No such group: " gname))
970 (when (zerop (length new-name))
971 (nnmaildir--srv-set-error nnmaildir--cur-server
972 "Invalid (empty) group name")
974 (when (eq (aref "." 0) (aref new-name 0))
975 (nnmaildir--srv-set-error nnmaildir--cur-server
976 "Group names may not start with \".\"")
978 (when (save-match-data (string-match "[\0/\t]" new-name))
979 (nnmaildir--srv-set-error nnmaildir--cur-server
980 (concat "Illegal characters (null, tab, or /) in group name: "
983 (if (string-equal gname new-name) (throw 'return t))
984 (when (intern-soft new-name
985 (nnmaildir--srv-get-groups nnmaildir--cur-server))
986 (nnmaildir--srv-set-error nnmaildir--cur-server
987 (concat "Group already exists: " new-name))
989 (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server))
991 (rename-file (concat srv-dir gname)
992 (concat srv-dir new-name))
994 (nnmaildir--srv-set-error nnmaildir--cur-server
995 (concat "Error renaming link: "
996 (prin1-to-string err)))
997 (throw 'return nil)))
998 (setq x (nnmaildir--srv-get-groups nnmaildir--cur-server)
999 groups (make-vector (length x) 0))
1000 (mapatoms (lambda (sym)
1001 (if (eq (symbol-value sym) group) nil
1002 (set (intern (symbol-name sym) groups)
1003 (symbol-value sym))))
1005 (setq group (copy-sequence group))
1006 (nnmaildir--grp-set-name group new-name)
1007 (set (intern new-name groups) group)
1008 (nnmaildir--srv-set-groups nnmaildir--cur-server groups)
1011 (defun nnmaildir-request-delete-group (gname force &optional server)
1012 (let ((group (nnmaildir--prepare server gname))
1013 pgname grp-dir dir dirs files ls deactivate-mark)
1016 (nnmaildir--srv-set-error nnmaildir--cur-server
1017 (concat "No such group: " gname))
1018 (throw 'return nil))
1019 (if (eq group (nnmaildir--srv-get-curgrp nnmaildir--cur-server))
1020 (nnmaildir--srv-set-curgrp nnmaildir--cur-server nil))
1021 (setq gname (nnmaildir--grp-get-name group)
1022 pgname (nnmaildir--grp-get-pname group))
1023 (unintern gname (nnmaildir--srv-get-groups nnmaildir--cur-server))
1024 (setq grp-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1025 grp-dir (nnmaildir--srv-grp-dir grp-dir gname))
1026 (if (not force) (setq grp-dir (directory-file-name grp-dir))
1027 (if (nnmaildir--param pgname 'read-only)
1028 (progn (delete-directory (nnmaildir--tmp grp-dir))
1029 (nnmaildir--unlink (nnmaildir--new grp-dir))
1030 (delete-directory (nnmaildir--cur grp-dir)))
1032 (set-buffer (get-buffer-create " *nnmaildir work*"))
1034 (setq ls (or (nnmaildir--param pgname 'directory-files)
1035 (nnmaildir--srv-get-ls nnmaildir--cur-server))
1036 files (funcall ls (nnmaildir--tmp grp-dir) 'full "\\`[^.]"
1039 (delete-file (car files))
1040 (setq files (cdr files)))
1041 (delete-directory (concat grp-dir "tmp"))
1042 (setq files (funcall ls (nnmaildir--new grp-dir) 'full "\\`[^.]"
1045 (delete-file (car files))
1046 (setq files (cdr files)))
1047 (delete-directory (concat grp-dir "new"))
1048 (setq files (funcall ls (nnmaildir--cur grp-dir) 'full "\\`[^.]"
1051 (delete-file (car files))
1052 (setq files (cdr files)))
1053 (delete-directory (concat grp-dir "cur"))))
1054 (setq dir (nnmaildir--nndir grp-dir)
1055 dirs (cons (concat dir "nov")
1056 (funcall ls (concat dir "marks") 'full "\\`[^.]"
1059 (setq dir (car dirs) dirs (cdr dirs)
1060 files (funcall ls dir 'full "\\`[^.]" 'nosort))
1062 (delete-file (car files))
1063 (setq files (cdr files)))
1064 (delete-directory dir))
1065 (setq dir (nnmaildir--nndir grp-dir)
1066 files (concat dir "markfile"))
1067 (nnmaildir--unlink files)
1068 (delete-directory (concat dir "marks"))
1069 (delete-directory dir)
1070 (setq grp-dir (directory-file-name grp-dir)
1071 dir (car (file-attributes grp-dir)))
1072 (if (eq (aref "/" 0) (aref dir 0)) nil
1073 (setq dir (concat (file-truename
1074 (nnmaildir--srv-get-dir nnmaildir--cur-server))
1076 (delete-directory dir))
1077 (nnmaildir--unlink grp-dir)
1080 (defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
1081 (let ((group (nnmaildir--prepare server gname))
1082 srv-dir dir nlist mlist article num stop nov nlist2 deactivate-mark)
1085 (nnmaildir--srv-set-error nnmaildir--cur-server
1086 (if gname (concat "No such group: " gname)
1087 "No current group"))
1088 (throw 'return nil))
1090 (set-buffer nntp-server-buffer)
1092 (setq nlist (nnmaildir--grp-get-lists group)
1093 mlist (nnmaildir--lists-get-mlist nlist)
1094 nlist (nnmaildir--lists-get-nlist nlist)
1095 gname (nnmaildir--grp-get-name group)
1096 srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1097 dir (nnmaildir--srv-grp-dir srv-dir gname))
1100 ((and fetch-old (not (numberp fetch-old)))
1102 (setq article (car nlist) nlist (cdr nlist)
1103 nov (nnmaildir--update-nov srv-dir group article))
1105 (nnmaildir--cache-nov group article nov)
1106 (setq num (nnmaildir--art-get-num article))
1107 (princ num nntp-server-buffer)
1108 (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
1109 (nnmaildir--art-get-msgid article) "\t"
1110 (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
1112 (princ num nntp-server-buffer)
1113 (insert "\t" (nnmaildir--nov-get-end nov) "\n")
1114 (goto-char (point-min)))))
1116 ((stringp (car articles))
1118 (setq article (car articles) articles (cdr articles)
1119 article (nnmaildir--mlist-art mlist article))
1121 (setq nov (nnmaildir--update-nov srv-dir group
1123 (nnmaildir--cache-nov group article nov)
1124 (setq num (nnmaildir--art-get-num article))
1125 (princ num nntp-server-buffer)
1126 (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
1127 (nnmaildir--art-get-msgid article) "\t"
1128 (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
1130 (princ num nntp-server-buffer)
1131 (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
1134 ;; Assume the article range is sorted ascending
1135 (setq stop (car articles)
1136 num (car (last articles))
1137 stop (if (numberp stop) stop (car stop))
1138 num (if (numberp num) num (cdr num))
1139 stop (- stop fetch-old)
1140 stop (if (< stop 1) 1 stop)
1141 articles (list (cons stop num))))
1143 (setq stop (car articles) articles (cdr articles))
1144 (while (eq stop (car articles))
1145 (setq articles (cdr articles)))
1146 (if (numberp stop) (setq num stop)
1147 (setq num (cdr stop) stop (car stop)))
1148 (setq nlist2 (nthcdr (- (nnmaildir--art-get-num (car nlist)) num)
1151 (setq article (car nlist2)
1152 num (nnmaildir--art-get-num article))
1154 (setq nlist2 (cdr nlist2)
1155 nov (nnmaildir--update-nov srv-dir group article))
1157 (nnmaildir--cache-nov group article nov)
1158 (princ num nntp-server-buffer)
1159 (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
1160 (nnmaildir--art-get-msgid article) "\t"
1161 (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
1163 (princ num nntp-server-buffer)
1164 (insert "\t" (nnmaildir--nov-get-end nov) "\n")
1165 (goto-char (point-min)))))))
1166 (sort-numeric-fields 1 (point-min) (point-max))
1169 (defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
1170 (let ((group (nnmaildir--prepare server gname))
1171 (case-fold-search t)
1172 list article suffix dir deactivate-mark)
1175 (nnmaildir--srv-set-error nnmaildir--cur-server
1176 (if gname (concat "No such group: " gname)
1177 "No current group"))
1178 (throw 'return nil))
1179 (setq list (nnmaildir--grp-get-lists group))
1180 (if (numberp num-msgid)
1181 (setq list (nnmaildir--lists-get-nlist list)
1182 article (nnmaildir--nlist-art list num-msgid))
1183 (setq list (nnmaildir--lists-get-mlist list)
1184 article (nnmaildir--mlist-art list num-msgid))
1185 (if article (setq num-msgid (nnmaildir--art-get-num article))
1189 (setq group (symbol-value grp)
1190 list (nnmaildir--grp-get-lists group)
1191 list (nnmaildir--lists-get-mlist list)
1192 article (nnmaildir--mlist-art list num-msgid))
1194 (setq num-msgid (nnmaildir--art-get-num article))
1195 (throw 'found nil)))
1196 (nnmaildir--srv-get-groups nnmaildir--cur-server)))))
1198 (nnmaildir--srv-set-error nnmaildir--cur-server "No such article")
1199 (throw 'return nil))
1200 (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil
1201 (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1202 (throw 'return nil))
1203 (setq gname (nnmaildir--grp-get-name group)
1204 dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1205 dir (nnmaildir--srv-grp-dir dir gname)
1206 group (if (nnmaildir--param (nnmaildir--grp-get-pname group)
1208 (nnmaildir--new dir) (nnmaildir--cur dir))
1209 nnmaildir-article-file-name (concat group
1210 (nnmaildir--art-get-prefix
1213 (if (file-exists-p nnmaildir-article-file-name) nil
1214 (nnmaildir--art-set-suffix article 'expire)
1215 (nnmaildir--art-set-nov article nil)
1216 (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1217 (throw 'return nil))
1219 (set-buffer (or to-buffer nntp-server-buffer))
1221 (nnheader-insert-file-contents nnmaildir-article-file-name))
1222 (cons gname num-msgid))))
1224 (defun nnmaildir-request-post (&optional server)
1225 (let (message-required-mail-headers)
1226 (funcall message-send-mail-function)))
1228 (defun nnmaildir-request-replace-article (article gname buffer)
1229 (let ((group (nnmaildir--prepare nil gname))
1230 (coding-system-for-write nnheader-file-coding-system)
1231 (buffer-file-coding-system nil)
1232 (file-coding-system-alist nil)
1233 file dir suffix tmpfile deactivate-mark)
1236 (nnmaildir--srv-set-error nnmaildir--cur-server
1237 (concat "No such group: " gname))
1238 (throw 'return nil))
1239 (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only)
1240 (nnmaildir--srv-set-error nnmaildir--cur-server
1241 (concat "Read-only group: " group))
1242 (throw 'return nil))
1243 (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1244 dir (nnmaildir--srv-grp-dir dir gname)
1245 file (nnmaildir--grp-get-lists group)
1246 file (nnmaildir--lists-get-nlist file)
1247 file (nnmaildir--nlist-art file article))
1248 (if (and file (stringp (setq suffix (nnmaildir--art-get-suffix file))))
1250 (nnmaildir--srv-set-error nnmaildir--cur-server
1251 (format "No such article: %d" article))
1252 (throw 'return nil))
1256 file (nnmaildir--art-get-prefix article)
1257 tmpfile (concat (nnmaildir--tmp dir) file))
1258 (when (file-exists-p tmpfile)
1259 (nnmaildir--srv-set-error nnmaildir--cur-server
1260 (concat "File exists: " tmpfile))
1261 (throw 'return nil))
1262 (write-region (point-min) (point-max) tmpfile nil 'no-message nil
1263 'confirm-overwrite)) ;; error would be preferred :(
1264 (unix-sync) ;; no fsync :(
1265 (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace)
1268 (defun nnmaildir-request-move-article (article gname server accept-form
1270 (let ((group (nnmaildir--prepare server gname))
1271 pgname list suffix result nnmaildir--file deactivate-mark)
1274 (nnmaildir--srv-set-error nnmaildir--cur-server
1275 (concat "No such group: " gname))
1276 (throw 'return nil))
1277 (setq gname (nnmaildir--grp-get-name group)
1278 pgname (nnmaildir--grp-get-pname group)
1279 list (nnmaildir--grp-get-lists group)
1280 list (nnmaildir--lists-get-nlist list)
1281 article (nnmaildir--nlist-art list article))
1283 (nnmaildir--srv-set-error nnmaildir--cur-server "No such article")
1284 (throw 'return nil))
1285 (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil
1286 (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1287 (throw 'return nil))
1288 (setq nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server)
1289 nnmaildir--file (nnmaildir--srv-grp-dir nnmaildir--file gname)
1290 nnmaildir--file (if (nnmaildir--param pgname 'read-only)
1291 (nnmaildir--new nnmaildir--file)
1292 (nnmaildir--cur nnmaildir--file))
1293 nnmaildir--file (concat nnmaildir--file
1294 (nnmaildir--art-get-prefix article)
1296 (if (file-exists-p nnmaildir--file) nil
1297 (nnmaildir--art-set-suffix article 'expire)
1298 (nnmaildir--art-set-nov article nil)
1299 (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
1300 (throw 'return nil))
1302 (set-buffer (get-buffer-create " *nnmaildir move*"))
1304 (nnheader-insert-file-contents nnmaildir--file)
1305 (setq result (eval accept-form)))
1306 (if (or (null result) (nnmaildir--param pgname 'read-only)) nil
1307 (nnmaildir--unlink nnmaildir--file)
1308 (nnmaildir--art-set-suffix article 'expire)
1309 (nnmaildir--art-set-nov article nil))
1312 (defun nnmaildir-request-accept-article (gname &optional server last)
1313 (let ((group (nnmaildir--prepare server gname))
1314 (coding-system-for-write nnheader-file-coding-system)
1315 (buffer-file-coding-system nil)
1316 (file-coding-system-alist nil)
1317 srv-dir dir file tmpfile curfile 24h num article)
1320 (nnmaildir--srv-set-error nnmaildir--cur-server
1321 (concat "No such group: " gname))
1322 (throw 'return nil))
1323 (setq gname (nnmaildir--grp-get-name group))
1324 (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only)
1325 (nnmaildir--srv-set-error nnmaildir--cur-server
1326 (concat "Read-only group: " gname))
1327 (throw 'return nil))
1328 (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1329 dir (nnmaildir--srv-grp-dir srv-dir gname)
1330 file (format-time-string "%s" nil))
1331 (if (string= nnmaildir--delivery-time file) nil
1332 (setq nnmaildir--delivery-time file
1333 nnmaildir--delivery-ct 0))
1334 (setq file (concat file "." nnmaildir--delivery-pid))
1335 (if (zerop nnmaildir--delivery-ct) nil
1336 (setq file (concat file "_"
1337 (number-to-string nnmaildir--delivery-ct))))
1338 (setq file (concat file "." (system-name))
1339 tmpfile (concat (nnmaildir--tmp dir) file)
1340 curfile (concat (nnmaildir--cur dir) file ":2,"))
1341 (when (file-exists-p tmpfile)
1342 (nnmaildir--srv-set-error nnmaildir--cur-server
1343 (concat "File exists: " tmpfile))
1344 (throw 'return nil))
1345 (when (file-exists-p curfile)
1346 (nnmaildir--srv-set-error nnmaildir--cur-server
1347 (concat "File exists: " curfile))
1348 (throw 'return nil))
1349 (setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct)
1350 24h (run-with-timer 86400 nil
1352 (nnmaildir--unlink tmpfile)
1353 (nnmaildir--srv-set-error
1354 nnmaildir--cur-server
1355 "24-hour timer expired")
1356 (throw 'return nil))))
1358 (add-name-to-file nnmaildir--file tmpfile)
1360 (write-region (point-min) (point-max) tmpfile nil 'no-message nil
1361 'confirm-overwrite) ;; error would be preferred :(
1362 (unix-sync))) ;; no fsync :(
1365 (add-name-to-file tmpfile curfile)
1367 (nnmaildir--srv-set-error nnmaildir--cur-server
1368 (concat "Error linking: "
1369 (prin1-to-string err)))
1370 (nnmaildir--unlink tmpfile)
1371 (throw 'return nil)))
1372 (nnmaildir--unlink tmpfile)
1373 (setq article (nnmaildir--art-new)
1374 num (nnmaildir--grp-get-lists group)
1375 num (nnmaildir--lists-get-nlist num)
1376 num (1+ (nnmaildir--nlist-last-num num)))
1377 (nnmaildir--art-set-prefix article file)
1378 (nnmaildir--art-set-suffix article ":2,")
1379 (nnmaildir--art-set-num article num)
1380 (if (nnmaildir--grp-add-art srv-dir group article) (cons gname num)))))
1382 (defun nnmaildir-save-mail (group-art)
1385 (throw 'return nil))
1386 (let ((ret group-art)
1387 ga gname x groups nnmaildir--file deactivate-mark)
1389 (goto-char (point-min))
1391 (while (looking-at "From ")
1392 (replace-match "X-From-Line: ")
1394 (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server)
1395 ga (car group-art) group-art (cdr group-art)
1397 (or (intern-soft gname groups)
1398 (nnmaildir-request-create-group gname)
1399 (throw 'return nil)) ;; not that nnmail bothers to check :(
1400 (if (nnmaildir-request-accept-article gname) nil
1401 (throw 'return nil))
1402 (setq x (nnmaildir--prepare nil gname)
1403 nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server)
1404 nnmaildir--file (concat nnmaildir--file
1405 (nnmaildir--grp-get-name x))
1406 nnmaildir--file (file-name-as-directory nnmaildir--file)
1407 x (nnmaildir--grp-get-lists x)
1408 x (nnmaildir--lists-get-nlist x)
1410 nnmaildir--file (concat nnmaildir--file
1411 (nnmaildir--art-get-prefix x)
1412 (nnmaildir--art-get-suffix x)))
1414 (setq ga (car group-art) group-art (cdr group-art)
1416 (if (and (or (intern-soft gname groups)
1417 (nnmaildir-request-create-group gname))
1418 (nnmaildir-request-accept-article gname)) nil
1419 (setq ret (delq ga ret)))) ;; We'll still try the other groups
1422 (defun nnmaildir-active-number (group)
1423 (let ((x (nnmaildir--prepare nil group)))
1426 (nnmaildir--srv-set-error nnmaildir--cur-server
1427 (concat "No such group: " group))
1428 (throw 'return nil))
1429 (setq x (nnmaildir--grp-get-lists x)
1430 x (nnmaildir--lists-get-nlist x))
1433 x (nnmaildir--art-get-num x)
1437 (defun nnmaildir-request-expire-articles (ranges &optional gname server force)
1438 (let ((no-force (not force))
1439 (group (nnmaildir--prepare server gname))
1440 pgname time boundary time-iter bound-iter high low target dir nlist
1441 stop num article didnt suffix nnmaildir--file deactivate-mark)
1444 (nnmaildir--srv-set-error nnmaildir--cur-server
1445 (if gname (concat "No such group: " gname)
1446 "No current group"))
1447 (throw 'return (gnus-uncompress-range ranges)))
1448 (setq gname (nnmaildir--grp-get-name group)
1449 pgname (nnmaildir--grp-get-pname group))
1450 (if (nnmaildir--param pgname 'read-only)
1451 (throw 'return (gnus-uncompress-range ranges)))
1452 (setq time (or (nnmaildir--param pgname 'expire-age) 604800))
1453 (if (or force (integerp time)) nil
1454 (throw 'return (gnus-uncompress-range ranges)))
1455 (setq boundary (current-time)
1456 high (- (car boundary) (/ time 65536))
1457 low (- (cadr boundary) (% time 65536)))
1459 (setq low (+ low 65536)
1461 (setcar (cdr boundary) low)
1462 (setcar boundary high)
1463 (setq target (nnmaildir--param pgname 'expire-group)
1464 target (and (stringp target)
1465 (not (string-equal target pgname))
1467 dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1468 dir (nnmaildir--srv-grp-dir dir gname)
1469 dir (nnmaildir--cur dir)
1470 nlist (nnmaildir--grp-get-lists group)
1471 nlist (nnmaildir--lists-get-nlist nlist)
1472 ranges (reverse ranges))
1474 (set-buffer (get-buffer-create " *nnmaildir move*"))
1476 (setq num (car ranges) ranges (cdr ranges))
1477 (while (eq num (car ranges))
1478 (setq ranges (cdr ranges)))
1479 (if (numberp num) (setq stop num)
1480 (setq stop (car num) num (cdr num)))
1481 (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) num)
1484 (setq article (car nlist)
1485 num (nnmaildir--art-get-num article))
1487 (setq nlist (cdr nlist)
1488 suffix (nnmaildir--art-get-suffix article))
1490 (if (stringp suffix) nil
1491 (nnmaildir--art-set-suffix article 'expire)
1492 (nnmaildir--art-set-nov article nil)
1493 (throw 'continue nil))
1494 (setq nnmaildir--file (nnmaildir--art-get-prefix article)
1495 nnmaildir--file (concat dir nnmaildir--file suffix)
1496 time (file-attributes nnmaildir--file))
1498 (nnmaildir--art-set-suffix article 'expire)
1499 (nnmaildir--art-set-nov article nil)
1500 (throw 'continue nil))
1501 (setq time (nth 5 time)
1503 bound-iter boundary)
1506 (while (and bound-iter time-iter
1507 (= (car bound-iter) (car time-iter)))
1508 (setq bound-iter (cdr bound-iter)
1509 time-iter (cdr time-iter)))
1510 (and bound-iter time-iter
1511 (car-less-than-car bound-iter time-iter))))
1512 (setq didnt (cons (nnmaildir--art-get-num article) didnt))
1515 (nnheader-insert-file-contents nnmaildir--file)
1516 (gnus-request-accept-article target nil nil 'no-encode))
1517 (nnmaildir--unlink nnmaildir--file)
1518 (nnmaildir--art-set-suffix article 'expire)
1519 (nnmaildir--art-set-nov article nil)))))
1523 (defun nnmaildir-request-set-mark (gname actions &optional server)
1524 (let ((group (nnmaildir--prepare server gname))
1525 (coding-system-for-write nnheader-file-coding-system)
1526 (buffer-file-coding-system nil)
1527 (file-coding-system-alist nil)
1528 del-mark add-marks marksdir markfile action group-nlist nlist ranges
1529 begin end article all-marks todo-marks did-marks marks form mdir mfile
1533 (setq mfile (car marks)
1534 mfile (symbol-name mfile)
1535 mfile (concat marksdir mfile)
1536 mfile (file-name-as-directory mfile)
1537 mfile (concat mfile (nnmaildir--art-get-prefix article)))
1538 (nnmaildir--unlink mfile))
1542 (setq mdir (concat marksdir (symbol-name (car marks)))
1543 mfile (concat (file-name-as-directory mdir)
1544 (nnmaildir--art-get-prefix article)))
1545 (if (memq (car marks) did-marks) nil
1546 (nnmaildir--mkdir mdir)
1547 (setq did-marks (cons (car marks) did-marks)))
1548 (if (file-exists-p mfile) nil
1550 (add-name-to-file markfile mfile)
1551 (file-error ;; too many links, probably
1552 (if (file-exists-p mfile) nil
1553 (nnmaildir--unlink markfile)
1554 (write-region "" nil markfile nil 'no-message)
1555 (add-name-to-file markfile mfile
1556 'ok-if-already-exists)))))
1557 (setq marks (cdr marks)))))
1560 (nnmaildir--srv-set-error nnmaildir--cur-server
1561 (concat "No such group: " gname))
1563 (setq ranges (gnus-range-add ranges (caar actions))
1564 actions (cdr actions)))
1565 (throw 'return ranges))
1566 (setq group-nlist (nnmaildir--grp-get-lists group)
1567 group-nlist (nnmaildir--lists-get-nlist group-nlist)
1568 marksdir (nnmaildir--srv-get-dir nnmaildir--cur-server)
1569 marksdir (nnmaildir--srv-grp-dir marksdir gname)
1570 marksdir (nnmaildir--nndir marksdir)
1571 markfile (concat marksdir "markfile")
1572 marksdir (concat marksdir "marks")
1573 marksdir (file-name-as-directory marksdir)
1574 gname (nnmaildir--grp-get-name group)
1575 all-marks (nnmaildir--grp-get-pname group)
1576 all-marks (or (nnmaildir--param all-marks 'directory-files)
1577 (nnmaildir--srv-get-ls nnmaildir--cur-server))
1578 all-marks (funcall all-marks marksdir nil "\\`[^.]" 'nosort)
1581 (setcar marks (intern (car marks)))
1582 (setq marks (cdr marks)))
1584 (setq action (car actions) actions (cdr actions)
1587 todo-marks (caddr action)
1590 (if (memq (car marks) all-marks) nil
1591 (setq all-marks (cons (car marks) all-marks)))
1592 (setq marks (cdr marks)))
1595 ((eq 'del (cadr action))
1598 (setq marks (cdr marks))))
1599 ((eq 'add (cadr action)) '(funcall add-marks))
1603 (setq marks all-marks)
1605 (if (memq (car marks) todo-marks) nil
1607 (setq marks (cdr marks)))))))
1608 (if (numberp (cdr ranges)) (setq ranges (list ranges))
1609 (setq ranges (reverse ranges)))
1611 (setq begin (car ranges) ranges (cdr ranges))
1612 (while (eq begin (car ranges))
1613 (setq ranges (cdr ranges)))
1614 (if (numberp begin) (setq end begin)
1615 (setq end (cdr begin) begin (car begin)))
1616 (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) end)
1619 (setq article (car nlist))
1620 (>= (nnmaildir--art-get-num article) begin))
1621 (setq nlist (cdr nlist))
1622 (when (stringp (nnmaildir--art-get-suffix article))
1623 (setq marks todo-marks)
1627 (defun nnmaildir-close-group (group &optional server)
1630 (defun nnmaildir-close-server (&optional server)
1631 (let (srv-ls flist ls dirs dir files file x)
1632 (nnmaildir--prepare server nil)
1633 (setq server nnmaildir--cur-server)
1635 (setq nnmaildir--cur-server nil
1636 srv-ls (nnmaildir--srv-get-ls server))
1640 (setq group (symbol-value group)
1641 x (nnmaildir--grp-get-pname group)
1642 ls (nnmaildir--param x 'directory-files)
1644 dir (nnmaildir--srv-get-dir server)
1645 dir (nnmaildir--srv-grp-dir
1646 dir (nnmaildir--grp-get-name group))
1647 x (nnmaildir--param x 'read-only)
1648 x (if x (nnmaildir--new dir) (nnmaildir--cur dir))
1649 files (funcall ls x nil "\\`[^.]" 'nosort)
1652 (while (<= flist x) (setq flist (* 2 flist)))
1653 (if (/= flist 1) (setq flist (1- flist)))
1654 (setq flist (make-vector flist 0))
1656 (setq file (car files) files (cdr files))
1657 (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
1658 (intern (match-string 1 file) flist))
1659 (setq dir (nnmaildir--nndir dir)
1660 dirs (cons (concat dir "nov")
1661 (funcall ls (concat dir "marks") 'full "\\`[^.]"
1664 (setq dir (car dirs) dirs (cdr dirs)
1665 files (funcall ls dir nil "\\`[^.]" 'nosort)
1666 dir (file-name-as-directory dir))
1668 (setq file (car files) files (cdr files))
1669 (if (intern-soft file flist) nil
1670 (setq file (concat dir file))
1671 (delete-file file)))))
1672 (nnmaildir--srv-get-groups server)))
1673 (unintern (nnmaildir--srv-get-name server) nnmaildir--servers)))
1676 (defun nnmaildir-request-close ()
1677 (let (servers buffer)
1678 (mapatoms (lambda (server)
1679 (setq servers (cons (symbol-name server) servers)))
1682 (nnmaildir-close-server (car servers))
1683 (setq servers (cdr servers)))
1684 (setq buffer (get-buffer " *nnmaildir work*"))
1685 (if buffer (kill-buffer buffer))
1686 (setq buffer (get-buffer " *nnmaildir nov*"))
1687 (if buffer (kill-buffer buffer))
1688 (setq buffer (get-buffer " *nnmaildir move*"))
1689 (if buffer (kill-buffer buffer)))
1692 (provide 'nnmaildir)
1694 ;;; nnmaildir.el ends here