;;; nnmaildir.el --- maildir backend for Gnus
-;; Copyright (c) 2001, 2002 Free Software Foundation, Inc.
-;; Copyright (c) 2000, 2001 Paul Jarc <prj@po.cwru.edu>
+;; Public domain.
;; Author: Paul Jarc <prj@po.cwru.edu>
;;; Commentary:
;; Maildir format is documented in the maildir(5) man page from qmail
-;; and at <URL:http://cr.yp.to/proto/maildir.html>. nnmaildir also
-;; stores extra information in the .nnmaildir/ directory within a
-;; maildir.
+;; (available at <URL:http://multivac.cwru.edu./prj/maildir.5>) and at
+;; <URL:http://cr.yp.to/proto/maildir.html>. nnmaildir also stores
+;; extra information in the .nnmaildir/ directory within a maildir.
;;
;; Some goals of nnmaildir:
;; * Everything Just Works, and correctly. E.g., stale NOV data is
;; Todo:
;; * Don't force article renumbering, so nnmaildir can be used with
;; the cache and agent. Alternatively, completely rewrite the Gnus
-;; backend interface, which would have other advantages.
+;; backend interface, which would have other advantages as well.
;;
;; See also <URL:http://multivac.cwru.edu./nnmaildir/> until that
;; information is added to the Gnus manual.
;; An obarry containing symbols whose names are server names and whose values
;; are servers:
(defvar nnmaildir--servers (make-vector 3 0))
-;; A server which has not necessarily been added to nnmaildir--servers, or nil:
-(defvar nnmaildir--tmp-server nil)
;; The current server:
(defvar nnmaildir--cur-server nil)
-;; A server is a vector:
-["server-name"
- select-method
- "/expanded/path/to/directory/containing/symlinks/to/maildirs/"
- directory-files-function
- group-name-transformation-function
- ;; An obarray containing symbols whose names are group names and whose values
- ;; are groups:
- group-hash
- ;; A group which has not necessarily been added to the group hash, or nil:
- tmp-group
- current-group ;; or nil
- "Last error message, or nil"
- directory-modtime
- get-new-mail-p ;; Should we split mail from mail-sources?
- "new/group/creation/directory"]
-
-;; A group is a vector:
-["group.name"
- "prefixed:group.name"
- ;; Modification times of the "new", and "cur" directories:
- new-modtime
- cur-modtime
- ;; A vector containing lists of articles:
- [;; A list of articles, with article numbers in descending order, ending with
- ;; article 1:
- article-list
- ;; An obarray containing symbols whose names are filename prefixes and whose
- ;; values are articles:
- file-hash
- ;; Same as above, but keyed on Message-ID:
- msgid-hash
- ;; An article which has not necessarily been added to the file and msgid
- ;; hashes, or nil:
- tmp-article]
- ;; A vector containing nil, or articles with NOV data:
- nov-cache
- ;; The index of the next nov-cache entry to be replaced:
- nov-cache-index
- ;; An obarray containing symbols whose names are mark names and whose values
- ;; are modtimes of mark directories:
- mark-modtime-hash]
-
-;; An article is a vector:
-["file.name.prefix"
- ":2,suffix" ;; or 'expire if expired
- number
- "msgid"
- ;; A NOV data vector, or nil:
- ["subject\tfrom\tdate"
- "references\tchars\lines"
- "extra"
- article-file-modtime
- ;; The value of nnmail-extra-headers when this NOV data was parsed:
- (to in-reply-to)]]
-
-(defmacro nnmaildir--srv-new () '(make-vector 11 nil))
-(defmacro nnmaildir--srv-get-name (server) `(aref ,server 0))
-(defmacro nnmaildir--srv-get-method (server) `(aref ,server 1))
-(defmacro nnmaildir--srv-get-dir (server) `(aref ,server 2))
-(defmacro nnmaildir--srv-get-ls (server) `(aref ,server 3))
-(defmacro nnmaildir--srv-get-groups (server) `(aref ,server 4))
-(defmacro nnmaildir--srv-get-tmpgrp (server) `(aref ,server 5))
-(defmacro nnmaildir--srv-get-curgrp (server) `(aref ,server 6))
-(defmacro nnmaildir--srv-get-error (server) `(aref ,server 7))
-(defmacro nnmaildir--srv-get-mtime (server) `(aref ,server 8))
-(defmacro nnmaildir--srv-get-gnm (server) `(aref ,server 9))
-(defmacro nnmaildir--srv-get-create-dir (server) `(aref ,server 10))
-(defmacro nnmaildir--srv-set-name (server val) `(aset ,server 0 ,val))
-(defmacro nnmaildir--srv-set-method (server val) `(aset ,server 1 ,val))
-(defmacro nnmaildir--srv-set-dir (server val) `(aset ,server 2 ,val))
-(defmacro nnmaildir--srv-set-ls (server val) `(aset ,server 3 ,val))
-(defmacro nnmaildir--srv-set-groups (server val) `(aset ,server 4 ,val))
-(defmacro nnmaildir--srv-set-tmpgrp (server val) `(aset ,server 5 ,val))
-(defmacro nnmaildir--srv-set-curgrp (server val) `(aset ,server 6 ,val))
-(defmacro nnmaildir--srv-set-error (server val) `(aset ,server 7 ,val))
-(defmacro nnmaildir--srv-set-mtime (server val) `(aset ,server 8 ,val))
-(defmacro nnmaildir--srv-set-gnm (server val) `(aset ,server 9 ,val))
-(defmacro nnmaildir--srv-set-create-dir (server val) `(aset ,server 10 ,val))
-
-(defmacro nnmaildir--grp-new () '(make-vector 8 nil))
-(defmacro nnmaildir--grp-get-name (group) `(aref ,group 0))
-(defmacro nnmaildir--grp-get-pname (group) `(aref ,group 1))
-(defmacro nnmaildir--grp-get-new (group) `(aref ,group 2))
-(defmacro nnmaildir--grp-get-cur (group) `(aref ,group 3))
-(defmacro nnmaildir--grp-get-lists (group) `(aref ,group 4))
-(defmacro nnmaildir--grp-get-cache (group) `(aref ,group 5))
-(defmacro nnmaildir--grp-get-index (group) `(aref ,group 6))
-(defmacro nnmaildir--grp-get-mmth (group) `(aref ,group 7))
-(defmacro nnmaildir--grp-set-name (group val) `(aset ,group 0 ,val))
-(defmacro nnmaildir--grp-set-pname (group val) `(aset ,group 1 ,val))
-(defmacro nnmaildir--grp-set-new (group val) `(aset ,group 2 ,val))
-(defmacro nnmaildir--grp-set-cur (group val) `(aset ,group 3 ,val))
-(defmacro nnmaildir--grp-set-lists (group val) `(aset ,group 4 ,val))
-(defmacro nnmaildir--grp-set-cache (group val) `(aset ,group 5 ,val))
-(defmacro nnmaildir--grp-set-index (group val) `(aset ,group 6 ,val))
-(defmacro nnmaildir--grp-set-mmth (group val) `(aset ,group 7 ,val))
-
-(defmacro nnmaildir--lists-new () '(make-vector 4 nil))
-(defmacro nnmaildir--lists-get-nlist (lists) `(aref ,lists 0))
-(defmacro nnmaildir--lists-get-flist (lists) `(aref ,lists 1))
-(defmacro nnmaildir--lists-get-mlist (lists) `(aref ,lists 2))
-(defmacro nnmaildir--lists-get-tmpart (lists) `(aref ,lists 3))
-(defmacro nnmaildir--lists-set-nlist (lists val) `(aset ,lists 0 ,val))
-(defmacro nnmaildir--lists-set-flist (lists val) `(aset ,lists 1 ,val))
-(defmacro nnmaildir--lists-set-mlist (lists val) `(aset ,lists 2 ,val))
-(defmacro nnmaildir--lists-set-tmpart (lists val) `(aset ,lists 3 ,val))
-
-(defmacro nnmaildir--nlist-last-num (list)
- `(if ,list (nnmaildir--art-get-num (car ,list)) 0))
-(defmacro nnmaildir--nlist-art (list num)
- `(and ,list
- (>= (nnmaildir--art-get-num (car ,list)) ,num)
- (nth (- (nnmaildir--art-get-num (car ,list)) ,num) ,list)))
+;; A copy of nnmail-extra-headers
+(defvar nnmaildir--extra nil)
+
+;; A disk NOV structure (must be prin1-able, so no defstruct) looks like this:
+["subject\tfrom\tdate"
+ "references\tchars\lines"
+ "To: you\tIn-Reply-To: <your.mess@ge>"
+ (12345 67890) ;; modtime of the corresponding article file
+ (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
+(defconst nnmaildir--novlen 5)
+(defmacro nnmaildir--nov-new (beg mid end mtime extra)
+ `(vector ,beg ,mid ,end ,mtime ,extra))
+(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
+(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
+(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
+(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
+(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
+(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value))
+(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value))
+(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value))
+(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
+(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
+
+(defstruct nnmaildir--art
+ (prefix nil :type string) ;; "time.pid.host"
+ (suffix nil :type string) ;; ":2,flags"
+ (num nil :type natnum) ;; article number
+ (msgid nil :type string) ;; "<mess.age@id>"
+ (nov nil :type vector)) ;; cached nov structure, or nil
+
+(defstruct nnmaildir--lists
+ (nlist nil :type list) ;; list of articles, ordered descending by number
+ (flist nil :type vector) ;; obarray mapping filename prefix->article
+ (mlist nil :type vector)) ;; obarray mapping message-id->article
+
+(defstruct nnmaildir--grp
+ (name nil :type string) ;; "group.name"
+ (new nil :type list) ;; new/ modtime
+ (cur nil :type list) ;; cur/ modtime
+ (lists nil :type nnmaildir--lists) ;; lists of articles in this group
+ (cache nil :type vector) ;; nov cache
+ (index nil :type natnum) ;; index of next cache entry to replace
+ (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
+
+(defstruct nnmaildir--srv
+ (address nil :type string) ;; server address string
+ (method nil :type list) ;; (nnmaildir "address" ...)
+ (prefix nil :type string) ;; "nnmaildir+address:"
+ (dir nil :type string) ;; "/expanded/path/to/server/dir/"
+ (ls nil :type function) ;; directory-files function
+ (groups nil :type vector) ;; obarray mapping group names->groups
+ (curgrp nil :type nnmaildir--grp) ;; current group, or nil
+ (error nil :type string) ;; last error message, or nil
+ (mtime nil :type list) ;; modtime of dir
+ (gnm nil) ;; flag: split from mail-sources?
+ (create-dir nil :type string)) ;; group creation directory
+
+(defmacro nnmaildir--nlist-last-num (nlist)
+ `(let ((nlist ,nlist))
+ (if nlist (nnmaildir--art-num (car nlist)) 0)))
+(defmacro nnmaildir--nlist-art (nlist num) ;;;; evals args multiple times
+ `(and ,nlist
+ (>= (nnmaildir--art-num (car ,nlist)) ,num)
+ (nth (- (nnmaildir--art-num (car ,nlist)) ,num) ,nlist)))
(defmacro nnmaildir--flist-art (list file)
`(symbol-value (intern-soft ,file ,list)))
(defmacro nnmaildir--mlist-art (list msgid)
`(symbol-value (intern-soft ,msgid ,list)))
-(defmacro nnmaildir--art-new () '(make-vector 5 nil))
-(defmacro nnmaildir--art-get-prefix (article) `(aref ,article 0))
-(defmacro nnmaildir--art-get-suffix (article) `(aref ,article 1))
-(defmacro nnmaildir--art-get-num (article) `(aref ,article 2))
-(defmacro nnmaildir--art-get-msgid (article) `(aref ,article 3))
-(defmacro nnmaildir--art-get-nov (article) `(aref ,article 4))
-(defmacro nnmaildir--art-set-prefix (article val) `(aset ,article 0 ,val))
-(defmacro nnmaildir--art-set-suffix (article val) `(aset ,article 1 ,val))
-(defmacro nnmaildir--art-set-num (article val) `(aset ,article 2 ,val))
-(defmacro nnmaildir--art-set-msgid (article val) `(aset ,article 3 ,val))
-(defmacro nnmaildir--art-set-nov (article val) `(aset ,article 4 ,val))
-
-(defmacro nnmaildir--nov-new () '(make-vector 5 nil))
-(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
-(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
-(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
-(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
-(defmacro nnmaildir--nov-get-neh (nov) `(aref ,nov 4))
-(defmacro nnmaildir--nov-set-beg (nov val) `(aset ,nov 0 ,val))
-(defmacro nnmaildir--nov-set-mid (nov val) `(aset ,nov 1 ,val))
-(defmacro nnmaildir--nov-set-end (nov val) `(aset ,nov 2 ,val))
-(defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val))
-(defmacro nnmaildir--nov-set-neh (nov val) `(aset ,nov 4 ,val))
-
-(defmacro nnmaildir--srv-grp-dir (srv-dir gname)
- `(file-name-as-directory (concat ,srv-dir ,gname)))
-
-(defun nnmaildir--param (prefixed-group-name param)
- (setq param
- (gnus-group-find-parameter prefixed-group-name param 'allow-list)
+(defun nnmaildir--pgname (server gname)
+ (let ((prefix (nnmaildir--srv-prefix server)))
+ (if prefix (concat prefix gname)
+ (setq gname (gnus-group-prefixed-name gname
+ (nnmaildir--srv-method server)))
+ (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
+ gname)))
+
+(defun nnmaildir--param (pgname param)
+ (setq param (gnus-group-find-parameter pgname param 'allow-list)
param (if (vectorp param) (aref param 0) param))
(eval param))
-(defmacro nnmaildir--unlink (file)
- `(if (file-attributes ,file) (delete-file ,file)))
-
-(defmacro nnmaildir--tmp (dir) `(file-name-as-directory (concat ,dir "tmp")))
-(defmacro nnmaildir--new (dir) `(file-name-as-directory (concat ,dir "new")))
-(defmacro nnmaildir--cur (dir) `(file-name-as-directory (concat ,dir "cur")))
-(defmacro nnmaildir--nndir (dir)
- `(file-name-as-directory (concat ,dir ".nnmaildir")))
-
-(defun nnmaildir--lists-fix (lists)
- (let ((tmp (nnmaildir--lists-get-tmpart lists)))
- (when tmp
- (set (intern (nnmaildir--art-get-prefix tmp)
- (nnmaildir--lists-get-flist lists))
- tmp)
- (set (intern (nnmaildir--art-get-msgid tmp)
- (nnmaildir--lists-get-mlist lists))
- tmp)
- (nnmaildir--lists-set-tmpart lists nil))))
+(defmacro nnmaildir--with-nntp-buffer (&rest body)
+ `(save-excursion
+ (set-buffer nntp-server-buffer)
+ ,@body))
+(defmacro nnmaildir--with-work-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir work*"))
+ ,@body))
+(defmacro nnmaildir--with-nov-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir nov*"))
+ ,@body))
+(defmacro nnmaildir--with-move-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir move*"))
+ ,@body))
+
+(defmacro nnmaildir--subdir (dir subdir)
+ `(file-name-as-directory (concat ,dir ,subdir)))
+(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
+ `(nnmaildir--subdir ,srv-dir ,gname))
+(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
+(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
+(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
+(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
+(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
+(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
+
+(defmacro nnmaildir--unlink (file-arg)
+ `(let ((file ,file-arg))
+ (if (file-attributes file) (delete-file file))))
+(defun nnmaildir--mkdir (dir)
+ (or (file-exists-p (file-name-as-directory dir))
+ (make-directory-internal (directory-file-name dir))))
(defun nnmaildir--prepare (server group)
(let (x groups)
(catch 'return
- (setq x nnmaildir--tmp-server)
- (when x
- (set (intern (nnmaildir--srv-get-name x) nnmaildir--servers) x)
- (setq nnmaildir--tmp-server nil))
(if (null server)
(or (setq server nnmaildir--cur-server)
(throw 'return nil))
(throw 'return nil))
(setq server (symbol-value server)
nnmaildir--cur-server server))
- (setq groups (nnmaildir--srv-get-groups server))
- (if groups nil (throw 'return nil))
- (if (nnmaildir--srv-get-method server) nil
- (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server))
+ (or (setq groups (nnmaildir--srv-groups server))
+ (throw 'return nil))
+ (if (nnmaildir--srv-method server) nil
+ (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
x (gnus-server-to-method x))
- (if x nil (throw 'return nil))
- (nnmaildir--srv-set-method server x))
- (setq x (nnmaildir--srv-get-tmpgrp server))
- (when x
- (set (intern (nnmaildir--grp-get-name x) groups) x)
- (nnmaildir--srv-set-tmpgrp server nil))
+ (or x (throw 'return nil))
+ (setf (nnmaildir--srv-method server) x))
(if (null group)
- (or (setq group (nnmaildir--srv-get-curgrp server))
+ (or (setq group (nnmaildir--srv-curgrp server))
(throw 'return nil))
- (setq group (intern-soft group groups))
- (if group nil (throw 'return nil))
+ (or (setq group (intern-soft group groups))
+ (throw 'return nil))
(setq group (symbol-value group)))
- (nnmaildir--lists-fix (nnmaildir--grp-get-lists group))
group)))
-(defun nnmaildir--update-nov (srv-dir group article)
+(defun nnmaildir--update-nov (server group article)
(let ((nnheader-file-coding-system 'binary)
+ (srv-dir (nnmaildir--srv-dir server))
dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
- nov msgid nov-beg nov-mid nov-end field pos extra val old-neh new-neh
- deactivate-mark)
+ nov msgid nov-beg nov-mid nov-end field pos extra val old-extra
+ new-extra deactivate-mark)
(catch 'return
- (setq suffix (nnmaildir--art-get-suffix article))
+ (setq suffix (nnmaildir--art-suffix article))
(if (stringp suffix) nil
- (nnmaildir--art-set-nov article nil)
+ (setf (nnmaildir--art-nov article) nil)
(throw 'return nil))
- (setq gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group)
- dir (nnmaildir--srv-grp-dir srv-dir gname)
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname server gname)
+ dir (nnmaildir--srvgrp-dir srv-dir gname)
msgdir (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
- prefix (nnmaildir--art-get-prefix article)
+ prefix (nnmaildir--art-prefix article)
file (concat msgdir prefix suffix)
attr (file-attributes file))
(if attr nil
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil)
(throw 'return nil))
(setq mtime (nth 5 attr)
attr (nth 7 attr)
- nov (nnmaildir--art-get-nov article)
- novdir (concat (nnmaildir--nndir dir) "nov")
- novdir (file-name-as-directory novdir)
+ nov (nnmaildir--art-nov article)
+ novdir (nnmaildir--nov-dir (nnmaildir--nndir dir))
novfile (concat novdir prefix))
- (save-excursion
- (set-buffer (get-buffer-create " *nnmaildir nov*"))
+ (or (equal nnmaildir--extra nnmail-extra-headers)
+ (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
+ (nnmaildir--with-nov-buffer
(when (file-exists-p novfile) ;; If not, force reparsing the message.
(if nov nil ;; It's already in memory.
;; Else read the data from the NOV file.
(erase-buffer)
(nnheader-insert-file-contents novfile)
(setq nov (read (current-buffer)))
- (nnmaildir--art-set-msgid article (car nov))
+ (setf (nnmaildir--art-msgid article) (car nov))
(setq nov (cadr nov)))
- ;; If the NOV's modtime matches the file's current modtime,
- ;; and it has the right length (i.e., it wasn't produced by
- ;; a too-much older version of nnmaildir), then we may use
- ;; this NOV data rather than parsing the message file,
- ;; unless nnmail-extra-headers has been augmented since this
- ;; data was last parsed.
+ ;; If the NOV's modtime matches the file's current modtime, and it
+ ;; has the right structure (i.e., it wasn't produced by a too-much
+ ;; older version of nnmaildir), then we may use this NOV data
+ ;; rather than parsing the message file, unless
+ ;; nnmail-extra-headers has been augmented since this data was last
+ ;; parsed.
(when (and (equal mtime (nnmaildir--nov-get-mtime nov))
- (= (length nov) (length (nnmaildir--nov-new))))
- ;; This NOV data is potentially up-to-date.
- (setq old-neh (nnmaildir--nov-get-neh nov)
- new-neh nnmail-extra-headers)
- (if (equal new-neh old-neh) (throw 'return nov)) ;; Common case.
+ (= (length nov) nnmaildir--novlen)
+ (stringp (nnmaildir--nov-get-beg nov))
+ (stringp (nnmaildir--nov-get-mid nov))
+ (stringp (nnmaildir--nov-get-end nov))
+ (listp (nnmaildir--nov-get-mtime nov))
+ (listp (nnmaildir--nov-get-extra nov)))
+ ;; this NOV data is potentially up-to-date; now check extra headers
+ (setq old-extra (nnmaildir--nov-get-extra nov))
+ (when (equal nnmaildir--extra old-extra) ;; common case
+ (nnmaildir--nov-set-extra nov nnmaildir--extra) ;; save memory
+ (throw 'return nov))
;; They're not equal, but maybe the new is a subset of the old...
- (if (null new-neh) (throw 'return nov))
- (while new-neh
- (if (memq (car new-neh) old-neh)
+ (if (null nnmaildir--extra) (throw 'return nov))
+ (setq new-extra nnmaildir--extra)
+ (while new-extra
+ (if (memq (car new-extra) old-extra)
(progn
- (setq new-neh (cdr new-neh))
- (if new-neh nil (throw 'return nov)))
- (setq new-neh nil)))))
+ (setq new-extra (cdr new-extra))
+ (if new-extra nil (throw 'return nov)))
+ (setq new-extra nil))))) ;;found one not in old-extra;quit loop
;; Parse the NOV data out of the message.
(erase-buffer)
(nnheader-insert-file-contents file)
(setq msgid field))
(if (or (null msgid) (nnheader-fake-message-id-p msgid))
(setq msgid (concat "<" prefix "@nnmaildir>")))
+ (setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime
+ nnmaildir--extra))
(erase-buffer)
- (setq nov (nnmaildir--nov-new))
- (nnmaildir--nov-set-beg nov nov-beg)
- (nnmaildir--nov-set-mid nov nov-mid)
- (nnmaildir--nov-set-end nov nov-end)
- (nnmaildir--nov-set-mtime nov mtime)
- (nnmaildir--nov-set-neh nov (copy-sequence nnmail-extra-headers))
(prin1 (list msgid nov) (current-buffer))
(setq file (concat novfile ":"))
(nnmaildir--unlink file)
(write-region (point-min) (point-max) file nil 'no-message))
(rename-file file novfile 'replace)
- (nnmaildir--art-set-msgid article msgid)
+ (setf (nnmaildir--art-msgid article) msgid)
nov)))
(defun nnmaildir--cache-nov (group article nov)
- (let ((cache (nnmaildir--grp-get-cache group))
- (index (nnmaildir--grp-get-index group))
+ (let ((cache (nnmaildir--grp-cache group))
+ (index (nnmaildir--grp-index group))
goner)
- (if (nnmaildir--art-get-nov article) nil
+ (if (nnmaildir--art-nov article) nil
(setq goner (aref cache index))
- (if goner (nnmaildir--art-set-nov goner nil))
+ (if goner (setf (nnmaildir--art-nov goner) nil))
(aset cache index article)
- (nnmaildir--grp-set-index group (% (1+ index) (length cache))))
- (nnmaildir--art-set-nov article nov)))
+ (setf (nnmaildir--grp-index group) (% (1+ index) (length cache))))
+ (setf (nnmaildir--art-nov article) nov)))
-(defun nnmaildir--grp-add-art (srv-dir group article)
- (let ((nov (nnmaildir--update-nov srv-dir group article))
+(defun nnmaildir--grp-add-art (server group article)
+ (let ((nov (nnmaildir--update-nov server group article))
old-lists new-lists)
(when nov
- (setq old-lists (nnmaildir--grp-get-lists group)
- new-lists (nnmaildir--lists-new))
- (nnmaildir--lists-set-nlist
- new-lists (cons article (nnmaildir--lists-get-nlist old-lists)))
- (nnmaildir--lists-set-flist new-lists
- (nnmaildir--lists-get-flist old-lists))
- (nnmaildir--lists-set-mlist new-lists
- (nnmaildir--lists-get-mlist old-lists))
- (nnmaildir--lists-set-tmpart new-lists article)
- (nnmaildir--grp-set-lists group new-lists)
- (nnmaildir--lists-fix new-lists)
+ (setq old-lists (nnmaildir--grp-lists group)
+ new-lists (copy-nnmaildir--lists old-lists))
+ (setf (nnmaildir--lists-nlist new-lists)
+ (cons article (nnmaildir--lists-nlist new-lists)))
+ (let ((inhibit-quit t))
+ (setf (nnmaildir--grp-lists group) new-lists)
+ (set (intern (nnmaildir--art-prefix article)
+ (nnmaildir--lists-flist new-lists))
+ article)
+ (set (intern (nnmaildir--art-msgid article)
+ (nnmaildir--lists-mlist new-lists))
+ article))
(nnmaildir--cache-nov group article nov)
t)))
-(defun nnmaildir--mkdir (dir)
- (or (file-exists-p (file-name-as-directory dir))
- (make-directory-internal (directory-file-name dir))))
+(defun nnmaildir--group-ls (server pgname)
+ (or (nnmaildir--param pgname 'directory-files)
+ (nnmaildir--srv-ls server)))
(defun nnmaildir--article-count (group)
(let ((ct 0)
(min 1))
- (setq group (nnmaildir--grp-get-lists group)
- group (nnmaildir--lists-get-nlist group))
+ (setq group (nnmaildir--grp-lists group)
+ group (nnmaildir--lists-nlist group))
(while group
- (if (stringp (nnmaildir--art-get-suffix (car group)))
+ (if (stringp (nnmaildir--art-suffix (car group)))
(setq ct (1+ ct)
- min (nnmaildir--art-get-num (car group))))
+ min (nnmaildir--art-num (car group))))
(setq group (cdr group)))
(cons ct min)))
(defun nnmaildir-article-number-to-file-name
(number group-name server-address-string)
(let ((group (nnmaildir--prepare server-address-string group-name))
- list article suffix dir filename)
+ list article suffix dir filename pgname)
(catch 'return
(if (null group)
;; The given group or server does not exist.
(throw 'return nil))
- (setq list (nnmaildir--grp-get-lists group)
- list (nnmaildir--lists-get-nlist list)
+ (setq list (nnmaildir--grp-lists group)
+ list (nnmaildir--lists-nlist list)
article (nnmaildir--nlist-art list number))
(if (null article)
;; The given article number does not exist in this group.
(throw 'return nil))
- (setq suffix (nnmaildir--art-get-suffix article))
+ (setq suffix (nnmaildir--art-suffix article))
(if (not (stringp suffix))
;; The article has expired.
(throw 'return nil))
- (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir dir group-name)
- group (if (nnmaildir--param (nnmaildir--grp-get-pname group)
- 'read-only)
+ (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir group-name)
+ pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
+ group (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
- filename (concat group (nnmaildir--art-get-prefix article) suffix))
+ filename (concat group (nnmaildir--art-prefix article) suffix))
(if (file-exists-p filename)
filename
;; The article disappeared out from under us.
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil)
nil))))
+(defun nnmaildir-article-number-to-base-name
+ (number group-name server-address-string)
+ (let ((group (nnmaildir--prepare server-address-string group-name))
+ list article suffix dir filename)
+ (catch 'return
+ (if (null group)
+ ;; The given group or server does not exist.
+ (throw 'return nil))
+ (setq list (nnmaildir--grp-lists group)
+ list (nnmaildir--lists-nlist list)
+ article (nnmaildir--nlist-art list number))
+ (if (null article)
+ ;; The given article number does not exist in this group.
+ (throw 'return nil))
+ (setq suffix (nnmaildir--art-suffix article))
+ (if (not (stringp suffix))
+ ;; The article has expired.
+ (throw 'return nil))
+ (cons (nnmaildir--art-prefix article) suffix))))
+
+(defun nnmaildir-base-name-to-article-number
+ (base-name group-name server-address-string)
+ (let ((group (nnmaildir--prepare server-address-string group-name))
+ list article suffix dir filename)
+ (catch 'return
+ (if (null group)
+ ;; The given group or server does not exist.
+ (throw 'return nil))
+ (setq list (nnmaildir--grp-lists group)
+ list (nnmaildir--lists-flist list)
+ article (nnmaildir--flist-art list base-name))
+ (if (null article)
+ ;; The given article number does not exist in this group.
+ (throw 'return nil))
+ (nnmaildir--art-num article))))
+
(defun nnmaildir-request-type (group &optional article)
'mail)
(defun nnmaildir-status-message (&optional server)
(nnmaildir--prepare server nil)
- (nnmaildir--srv-get-error nnmaildir--cur-server))
+ (nnmaildir--srv-error nnmaildir--cur-server))
(defun nnmaildir-server-opened (&optional server)
(and nnmaildir--cur-server
(if server
- (string-equal server
- (nnmaildir--srv-get-name nnmaildir--cur-server))
+ (string-equal server (nnmaildir--srv-address nnmaildir--cur-server))
t)
- (nnmaildir--srv-get-groups nnmaildir--cur-server)
+ (nnmaildir--srv-groups nnmaildir--cur-server)
t))
(defun nnmaildir-open-server (server &optional defs)
(setq server (intern-soft x nnmaildir--servers))
(if server
(and (setq server (symbol-value server))
- (nnmaildir--srv-get-groups server)
+ (nnmaildir--srv-groups server)
(setq nnmaildir--cur-server server)
(throw 'return t))
- (setq server (nnmaildir--srv-new))
- (nnmaildir--srv-set-name server x)
- (setq nnmaildir--tmp-server server)
- (set (intern x nnmaildir--servers) server)
- (setq nnmaildir--tmp-server nil))
+ (setq server (make-nnmaildir--srv :address x))
+ (let ((inhibit-quit t))
+ (set (intern x nnmaildir--servers) server)))
(setq dir (assq 'directory defs))
(if dir nil
- (nnmaildir--srv-set-error
- server "You must set \"directory\" in the select method")
+ (setf (nnmaildir--srv-error server)
+ "You must set \"directory\" in the select method")
(throw 'return nil))
(setq dir (cadr dir)
dir (eval dir)
dir (expand-file-name dir)
dir (file-name-as-directory dir))
(if (file-exists-p dir) nil
- (nnmaildir--srv-set-error server (concat "No such directory: " dir))
+ (setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
(throw 'return nil))
- (nnmaildir--srv-set-dir server dir)
+ (setf (nnmaildir--srv-dir server) dir)
(setq x (assq 'directory-files defs))
(if (null x)
(setq x (symbol-function (if nnheader-directory-files-is-safe
'nnheader-directory-files-safe)))
(setq x (cadr x))
(if (functionp x) nil
- (nnmaildir--srv-set-error
- server (concat "Not a function: " (prin1-to-string x)))
+ (setf (nnmaildir--srv-error server)
+ (concat "Not a function: " (prin1-to-string x)))
(throw 'return nil)))
- (nnmaildir--srv-set-ls server x)
+ (setf (nnmaildir--srv-ls server) x)
(setq x (funcall x dir nil "\\`[^.]" 'nosort)
x (length x)
size 1)
(and (setq x (assq 'get-new-mail defs))
(setq x (cdr x))
(car x)
- (nnmaildir--srv-set-gnm server t)
+ (setf (nnmaildir--srv-gnm server) t)
(require 'nnmail))
(setq x (assq 'create-directory defs))
(when x
(setq x (cadr x)
x (eval x))
- (nnmaildir--srv-set-create-dir server x))
- (nnmaildir--srv-set-groups server (make-vector size 0))
+ (setf (nnmaildir--srv-create-dir server) x))
+ (setf (nnmaildir--srv-groups server) (make-vector size 0))
(setq nnmaildir--cur-server server)
t)))
(let ((36h-ago (- (car (current-time)) 2))
absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
files file num dir flist group x)
- (setq absdir (file-name-as-directory (concat srv-dir gname))
+ (setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
nndir (nnmaildir--nndir absdir))
- (if (file-attributes absdir) nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such directory: " absdir))
+ (if (file-exists-p absdir) nil
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such directory: " absdir))
(throw 'return nil))
(setq tdir (nnmaildir--tmp absdir)
ndir (nnmaildir--new absdir)
nattr (file-attributes ndir)
cattr (file-attributes cdir))
(if (and (file-exists-p tdir) nattr cattr) nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Not a maildir: " absdir))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Not a maildir: " absdir))
(throw 'return nil))
- (setq group (nnmaildir--prepare nil gname))
+ (setq group (nnmaildir--prepare nil gname)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname))
(if group
- (setq isnew nil
- pgname (nnmaildir--grp-get-pname group))
+ (setq isnew nil)
(setq isnew t
- group (nnmaildir--grp-new)
- pgname (gnus-group-prefixed-name gname method))
- (nnmaildir--grp-set-name group gname)
- (nnmaildir--grp-set-pname group pgname)
- (nnmaildir--grp-set-lists group (nnmaildir--lists-new))
- (nnmaildir--grp-set-index group 0)
+ group (make-nnmaildir--grp :name gname :index 0
+ :lists (make-nnmaildir--lists)))
(nnmaildir--mkdir nndir)
- (nnmaildir--mkdir (concat nndir "nov"))
- (nnmaildir--mkdir (concat nndir "marks"))
+ (nnmaildir--mkdir (nnmaildir--nov-dir nndir))
+ (nnmaildir--mkdir (nnmaildir--marks-dir nndir))
(write-region "" nil (concat nndir "markfile") nil 'no-message))
(setq read-only (nnmaildir--param pgname 'read-only)
ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
(if read-only nil
(setq x (nth 11 (file-attributes tdir)))
(if (and (= x (nth 11 nattr)) (= x (nth 11 cattr))) nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Maildir spans filesystems: "
- absdir))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Maildir spans filesystems: " absdir))
(throw 'return nil))
(setq files (funcall ls tdir 'full "\\`[^.]" 'nosort))
(while files
isnew
(throw 'return t))
(setq nattr (nth 5 nattr))
- (if (equal nattr (nnmaildir--grp-get-new group))
+ (if (equal nattr (nnmaildir--grp-new group))
(setq nattr nil))
(if read-only (setq dir (and (or isnew nattr) ndir))
(when (or isnew nattr)
(while files
(setq file (car files) files (cdr files))
(rename-file (concat ndir file) (concat cdir file ":2,")))
- (nnmaildir--grp-set-new group nattr))
- (setq cattr (file-attributes cdir)
- cattr (nth 5 cattr))
- (if (equal cattr (nnmaildir--grp-get-cur group))
+ (setf (nnmaildir--grp-new group) nattr))
+ (setq cattr (nth 5 (file-attributes cdir)))
+ (if (equal cattr (nnmaildir--grp-cur group))
(setq cattr nil))
(setq dir (and (or isnew cattr) cdir)))
(if dir nil (throw 'return t))
num 1)
(while (<= num x) (setq num (* 2 num)))
(if (/= num 1) (setq num (1- num)))
- (setq x (nnmaildir--grp-get-lists group))
- (nnmaildir--lists-set-flist x (make-vector num 0))
- (nnmaildir--lists-set-mlist x (make-vector num 0))
- (nnmaildir--grp-set-mmth group (make-vector 1 0))
+ (setq x (nnmaildir--grp-lists group))
+ (setf (nnmaildir--lists-flist x) (make-vector num 0))
+ (setf (nnmaildir--lists-mlist x) (make-vector num 0))
+ (setf (nnmaildir--grp-mmth group) (make-vector 1 0))
(setq num (nnmaildir--param pgname 'nov-cache-size))
(if (numberp num) (if (< num 1) (setq num 1))
(setq x files
num 16
- cdir (file-name-as-directory (concat nndir "marks"))
- ndir (file-name-as-directory (concat cdir "tick"))
- cdir (file-name-as-directory (concat cdir "read")))
+ cdir (nnmaildir--marks-dir nndir)
+ ndir (nnmaildir--subdir cdir "tick")
+ cdir (nnmaildir--subdir cdir "read"))
(while x
(setq file (car x) x (cdr x))
(string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
(if (or (not (file-exists-p (concat cdir file)))
(file-exists-p (concat ndir file)))
(setq num (1+ num)))))
- (nnmaildir--grp-set-cache group (make-vector num nil))
- (nnmaildir--srv-set-tmpgrp nnmaildir--cur-server group)
- (set (intern gname groups) group)
- (nnmaildir--srv-set-tmpgrp nnmaildir--cur-server nil)
+ (setf (nnmaildir--grp-cache group) (make-vector num nil))
+ (let ((inhibit-quit t))
+ (set (intern gname groups) group))
(or scan-msgs (throw 'return t)))
- (setq flist (nnmaildir--grp-get-lists group)
- num (nnmaildir--lists-get-nlist flist)
- flist (nnmaildir--lists-get-flist flist)
+ (setq flist (nnmaildir--grp-lists group)
+ num (nnmaildir--lists-nlist flist)
+ flist (nnmaildir--lists-flist flist)
num (nnmaildir--nlist-last-num num)
x files
files nil)
(while files
(setq file (car files) files (cdr files)
file (if (consp file) file (aref file 5))
- x (nnmaildir--art-new))
- (nnmaildir--art-set-prefix x (car file))
- (nnmaildir--art-set-suffix x (cdr file))
- (nnmaildir--art-set-num x (1+ num))
- (if (nnmaildir--grp-add-art srv-dir group x)
+ x (make-nnmaildir--art :prefix (car file) :suffix(cdr file)
+ :num (1+ num)))
+ (if (nnmaildir--grp-add-art nnmaildir--cur-server group x)
(setq num (1+ num))))
- (if read-only (nnmaildir--grp-set-new group nattr)
- (nnmaildir--grp-set-cur group cattr)))
+ (if read-only (setf (nnmaildir--grp-new group) nattr)
+ (setf (nnmaildir--grp-cur group) cattr)))
t))
(defun nnmaildir-request-scan (&optional scan-group server)
(let ((coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
(buffer-file-coding-system nil)
+ (file-coding-system nil)
(file-coding-system-alist nil)
(nnmaildir-get-new-mail t)
(nnmaildir-group-alist nil)
(nnmaildir-active-file nil)
x srv-ls srv-dir method groups group dirs grp-dir seen deactivate-mark)
(nnmaildir--prepare server nil)
- (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server)
- srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- method (nnmaildir--srv-get-method nnmaildir--cur-server)
- groups (nnmaildir--srv-get-groups nnmaildir--cur-server))
- (save-excursion
- (set-buffer (get-buffer-create " *nnmaildir work*"))
+ (setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server)
+ srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ method (nnmaildir--srv-method nnmaildir--cur-server)
+ groups (nnmaildir--srv-groups nnmaildir--cur-server))
+ (nnmaildir--with-work-buffer
(save-match-data
(if (stringp scan-group)
(if (nnmaildir--scan scan-group t groups method srv-dir srv-ls)
- (if (nnmaildir--srv-get-gnm nnmaildir--cur-server)
+ (if (nnmaildir--srv-gnm nnmaildir--cur-server)
(nnmail-get-new-mail 'nnmaildir nil nil scan-group))
(unintern scan-group groups))
- (setq x (nth 5 (file-attributes srv-dir)))
- (if (equal x (nnmaildir--srv-get-mtime nnmaildir--cur-server))
- (if scan-group nil
- (mapatoms (lambda (sym)
- (nnmaildir--scan (symbol-name sym) t groups
- method srv-dir srv-ls))
- groups))
+ (setq x (nth 5 (file-attributes srv-dir))
+ scan-group (null scan-group))
+ (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server))
+ (if scan-group
+ (mapatoms (lambda (sym)
+ (nnmaildir--scan (symbol-name sym) t groups
+ method srv-dir srv-ls))
+ groups))
(setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
x (length dirs)
seen 1)
(while (<= seen x) (setq seen (* 2 seen)))
(if (/= seen 1) (setq seen (1- seen)))
- (setq seen (make-vector seen 0)
- scan-group (null scan-group))
+ (setq seen (make-vector seen 0))
(while dirs
(setq grp-dir (car dirs) dirs (cdr dirs))
(if (nnmaildir--scan grp-dir scan-group groups method srv-dir
(while x
(unintern (car x) groups)
(setq x (cdr x)))
- (nnmaildir--srv-set-mtime nnmaildir--cur-server
- (nth 5 (file-attributes srv-dir))))
- (if (nnmaildir--srv-get-gnm nnmaildir--cur-server)
- (nnmail-get-new-mail 'nnmaildir nil nil))))))
+ (setf (nnmaildir--srv-mtime nnmaildir--cur-server)
+ (nth 5 (file-attributes srv-dir))))
+ (and scan-group
+ (nnmaildir--srv-gnm nnmaildir--cur-server)
+ (nnmail-get-new-mail 'nnmaildir nil nil))))))
t)
(defun nnmaildir-request-list (&optional server)
(nnmaildir-request-scan 'find-new-groups server)
(let (pgname ro ct-min deactivate-mark)
(nnmaildir--prepare server nil)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (nnmaildir--with-nntp-buffer
(erase-buffer)
(mapatoms (lambda (group)
- (setq group (symbol-value group)
- ro (nnmaildir--param (nnmaildir--grp-get-pname group)
- 'read-only)
+ (setq pgname (symbol-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server pgname)
+ group (symbol-value group)
+ ro (nnmaildir--param pgname 'read-only)
ct-min (nnmaildir--article-count group))
- (insert (nnmaildir--grp-get-name group) " ")
- (princ (car ct-min) nntp-server-buffer)
+ (insert (nnmaildir--grp-name group) " ")
+ (princ (nnmaildir--nlist-last-num
+ (nnmaildir--lists-nlist
+ (nnmaildir--grp-lists group)))
+ nntp-server-buffer)
(insert " ")
(princ (cdr ct-min) nntp-server-buffer)
(insert " " (if ro "n" "y") "\n"))
- (nnmaildir--srv-get-groups nnmaildir--cur-server))))
+ (nnmaildir--srv-groups nnmaildir--cur-server))))
t)
(defun nnmaildir-request-newgroups (date &optional server)
(defun nnmaildir-retrieve-groups (groups &optional server)
(let (gname group ct-min deactivate-mark)
(nnmaildir--prepare server nil)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (nnmaildir--with-nntp-buffer
(erase-buffer)
(while groups
(setq gname (car groups) groups (cdr groups))
- (nnmaildir-request-scan gname server)
(setq group (nnmaildir--prepare nil gname))
(if (null group) (insert "411 no such news group\n")
(setq ct-min (nnmaildir--article-count group))
(princ (cdr ct-min) nntp-server-buffer)
(insert " ")
(princ (nnmaildir--nlist-last-num
- (nnmaildir--lists-get-nlist
- (nnmaildir--grp-get-lists group)))
+ (nnmaildir--lists-nlist
+ (nnmaildir--grp-lists group)))
nntp-server-buffer)
(insert " " gname "\n")))))
'group)
(defun nnmaildir-request-update-info (gname info &optional server)
- (nnmaildir-request-scan gname server)
(let ((group (nnmaildir--prepare server gname))
- srv-ls pgname nlist flist last always-marks never-marks old-marks
- dotfile num dir markdirs marks mark ranges articles article read end
- new-marks ls old-mmth new-mmth mtime mark-sym deactivate-mark)
+ pgname nlist flist last always-marks never-marks old-marks dotfile num
+ dir markdirs marks mark ranges articles article read end new-marks ls
+ old-mmth new-mmth mtime mark-sym deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
- (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server)
- gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group)
- nlist (nnmaildir--grp-get-lists group)
- flist (nnmaildir--lists-get-flist nlist)
- nlist (nnmaildir--lists-get-nlist nlist))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ nlist (nnmaildir--grp-lists group)
+ flist (nnmaildir--lists-flist nlist)
+ nlist (nnmaildir--lists-nlist nlist))
(if nlist nil
(gnus-info-set-read info nil)
(gnus-info-set-marks info nil 'extend)
last (nnmaildir--nlist-last-num nlist)
always-marks (nnmaildir--param pgname 'always-marks)
never-marks (nnmaildir--param pgname 'never-marks)
- dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir dir gname)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
dir (nnmaildir--nndir dir)
- dir (concat dir "marks")
- dir (file-name-as-directory dir)
- ls (nnmaildir--param pgname 'directory-files)
- ls (or ls srv-ls)
+ dir (nnmaildir--marks-dir dir)
+ ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
num (length markdirs)
new-mmth 1)
(while (<= new-mmth num) (setq new-mmth (* 2 new-mmth)))
(if (/= new-mmth 1) (setq new-mmth (1- new-mmth)))
(setq new-mmth (make-vector new-mmth 0)
- old-mmth (nnmaildir--grp-get-mmth group))
+ old-mmth (nnmaildir--grp-mmth group))
(while markdirs
(setq mark (car markdirs) markdirs (cdr markdirs)
- articles (concat dir mark)
- articles (file-name-as-directory articles)
+ articles (nnmaildir--subdir dir mark)
mark-sym (intern mark)
ranges nil)
(catch 'got-ranges
(when (memq mark-sym always-marks)
(setq ranges (list (cons 1 last)))
(throw 'got-ranges nil))
- (setq mtime (file-attributes articles)
- mtime (nth 5 mtime))
+ (setq mtime (nth 5 (file-attributes articles)))
(set (intern mark new-mmth) mtime)
(when (equal mtime (symbol-value (intern-soft mark old-mmth)))
(setq ranges (assq mark-sym old-marks))
(setq article (car articles) articles (cdr articles)
article (nnmaildir--flist-art flist article))
(if article
- (setq num (nnmaildir--art-get-num article)
+ (setq num (nnmaildir--art-num article)
ranges (gnus-add-to-range ranges (list num))))))
(if (eq mark-sym 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
(gnus-info-set-read info read)
(gnus-info-set-marks info marks 'extend)
- (nnmaildir--grp-set-mmth group new-mmth)
+ (setf (nnmaildir--grp-mmth group) new-mmth)
info)))
(defun nnmaildir-request-group (gname &optional server fast)
- (nnmaildir-request-scan gname server)
(let ((group (nnmaildir--prepare server gname))
ct-min deactivate-mark)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (nnmaildir--with-nntp-buffer
(erase-buffer)
(catch 'return
(if group nil
(insert "411 no such news group\n")
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
- (nnmaildir--srv-set-curgrp nnmaildir--cur-server group)
+ (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group)
(if fast (throw 'return t))
(setq ct-min (nnmaildir--article-count group))
(insert "211 ")
(princ (cdr ct-min) nntp-server-buffer)
(insert " ")
(princ (nnmaildir--nlist-last-num
- (nnmaildir--lists-get-nlist
- (nnmaildir--grp-get-lists group)))
+ (nnmaildir--lists-nlist
+ (nnmaildir--grp-lists group)))
nntp-server-buffer)
(insert " " gname "\n")
t))))
(defun nnmaildir-request-create-group (gname &optional server args)
(nnmaildir--prepare server nil)
(catch 'return
- (let ((create-dir (nnmaildir--srv-get-create-dir nnmaildir--cur-server))
+ (let ((create-dir (nnmaildir--srv-create-dir nnmaildir--cur-server))
srv-dir dir groups)
(when (zerop (length gname))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- "Invalid (empty) group name")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Invalid (empty) group name")
(throw 'return nil))
(when (eq (aref "." 0) (aref gname 0))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- "Group names may not start with \".\"")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Group names may not start with \".\"")
(throw 'return nil))
(when (save-match-data (string-match "[\0/\t]" gname))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Illegal characters (null, tab, or /) in group name: "
- gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Illegal characters (null, tab, or /) in group name: "
+ gname))
(throw 'return nil))
- (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server))
+ (setq groups (nnmaildir--srv-groups nnmaildir--cur-server))
(when (intern-soft gname groups)
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Group already exists: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Group already exists: " gname))
(throw 'return nil))
- (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server))
+ (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
(if (file-name-absolute-p create-dir)
(setq dir (expand-file-name create-dir))
(setq dir srv-dir
dir (file-truename dir)
dir (concat dir create-dir)))
- (setq dir (file-name-as-directory dir)
- dir (concat dir gname))
+ (setq dir (nnmaildir--subdir (file-name-as-directory dir) gname))
(nnmaildir--mkdir dir)
- (setq dir (file-name-as-directory dir))
- (nnmaildir--mkdir (concat dir "tmp"))
- (nnmaildir--mkdir (concat dir "new"))
- (nnmaildir--mkdir (concat dir "cur"))
+ (nnmaildir--mkdir (nnmaildir--tmp dir))
+ (nnmaildir--mkdir (nnmaildir--new dir))
+ (nnmaildir--mkdir (nnmaildir--cur dir))
(setq create-dir (file-name-as-directory create-dir))
(make-symbolic-link (concat create-dir gname) (concat srv-dir gname))
(nnmaildir-request-scan 'find-new-groups))))
(defun nnmaildir-request-rename-group (gname new-name &optional server)
(let ((group (nnmaildir--prepare server gname))
(coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
(buffer-file-coding-system nil)
+ (file-coding-system nil)
(file-coding-system-alist nil)
srv-dir x groups)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
(when (zerop (length new-name))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- "Invalid (empty) group name")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Invalid (empty) group name")
(throw 'return nil))
(when (eq (aref "." 0) (aref new-name 0))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- "Group names may not start with \".\"")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Group names may not start with \".\"")
(throw 'return nil))
(when (save-match-data (string-match "[\0/\t]" new-name))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Illegal characters (null, tab, or /) in group name: "
- new-name))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Illegal characters (null, tab, or /) in group name: "
+ new-name))
(throw 'return nil))
(if (string-equal gname new-name) (throw 'return t))
(when (intern-soft new-name
- (nnmaildir--srv-get-groups nnmaildir--cur-server))
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Group already exists: " new-name))
+ (nnmaildir--srv-groups nnmaildir--cur-server))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Group already exists: " new-name))
(throw 'return nil))
- (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server))
+ (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
(condition-case err
(rename-file (concat srv-dir gname)
(concat srv-dir new-name))
(error
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Error renaming link: "
- (prin1-to-string err)))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Error renaming link: " (prin1-to-string err)))
(throw 'return nil)))
- (setq x (nnmaildir--srv-get-groups nnmaildir--cur-server)
+ (setq x (nnmaildir--srv-groups nnmaildir--cur-server)
groups (make-vector (length x) 0))
(mapatoms (lambda (sym)
(if (eq (symbol-value sym) group) nil
(symbol-value sym))))
x)
(setq group (copy-sequence group))
- (nnmaildir--grp-set-name group new-name)
+ (setf (nnmaildir--grp-name group) new-name)
(set (intern new-name groups) group)
- (nnmaildir--srv-set-groups nnmaildir--cur-server groups)
+ (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups)
t)))
(defun nnmaildir-request-delete-group (gname force &optional server)
pgname grp-dir dir dirs files ls deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
- (if (eq group (nnmaildir--srv-get-curgrp nnmaildir--cur-server))
- (nnmaildir--srv-set-curgrp nnmaildir--cur-server nil))
- (setq gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group))
- (unintern gname (nnmaildir--srv-get-groups nnmaildir--cur-server))
- (setq grp-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- grp-dir (nnmaildir--srv-grp-dir grp-dir gname))
+ (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server))
+ (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname))
+ (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server))
+ (setq grp-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ grp-dir (nnmaildir--srvgrp-dir grp-dir gname))
(if (not force) (setq grp-dir (directory-file-name grp-dir))
(if (nnmaildir--param pgname 'read-only)
(progn (delete-directory (nnmaildir--tmp grp-dir))
(nnmaildir--unlink (nnmaildir--new grp-dir))
(delete-directory (nnmaildir--cur grp-dir)))
- (save-excursion
- (set-buffer (get-buffer-create " *nnmaildir work*"))
+ (nnmaildir--with-work-buffer
(erase-buffer)
- (setq ls (or (nnmaildir--param pgname 'directory-files)
- (nnmaildir--srv-get-ls nnmaildir--cur-server))
+ (setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
files (funcall ls (nnmaildir--tmp grp-dir) 'full "\\`[^.]"
'nosort))
(while files
(delete-file (car files))
(setq files (cdr files)))
- (delete-directory (concat grp-dir "tmp"))
+ (delete-directory (nnmaildir--tmp grp-dir))
(setq files (funcall ls (nnmaildir--new grp-dir) 'full "\\`[^.]"
'nosort))
(while files
(delete-file (car files))
(setq files (cdr files)))
- (delete-directory (concat grp-dir "new"))
+ (delete-directory (nnmaildir--new grp-dir))
(setq files (funcall ls (nnmaildir--cur grp-dir) 'full "\\`[^.]"
'nosort))
(while files
(delete-file (car files))
(setq files (cdr files)))
- (delete-directory (concat grp-dir "cur"))))
+ (delete-directory (nnmaildir--cur grp-dir))))
(setq dir (nnmaildir--nndir grp-dir)
- dirs (cons (concat dir "nov")
- (funcall ls (concat dir "marks") 'full "\\`[^.]"
+ dirs (cons (nnmaildir--nov-dir dir)
+ (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
'nosort)))
(while dirs
(setq dir (car dirs) dirs (cdr dirs)
(delete-file (car files))
(setq files (cdr files)))
(delete-directory dir))
- (setq dir (nnmaildir--nndir grp-dir)
- files (concat dir "markfile"))
- (nnmaildir--unlink files)
- (delete-directory (concat dir "marks"))
+ (setq dir (nnmaildir--nndir grp-dir))
+ (nnmaildir--unlink (concat dir "markfile"))
+ (nnmaildir--unlink (concat dir "markfile{new}"))
+ (delete-directory (nnmaildir--marks-dir dir))
(delete-directory dir)
(setq grp-dir (directory-file-name grp-dir)
dir (car (file-attributes grp-dir)))
(if (eq (aref "/" 0) (aref dir 0)) nil
(setq dir (concat (file-truename
- (nnmaildir--srv-get-dir nnmaildir--cur-server))
+ (nnmaildir--srv-dir nnmaildir--cur-server))
dir)))
(delete-directory dir))
(nnmaildir--unlink grp-dir)
srv-dir dir nlist mlist article num stop nov nlist2 deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (if gname (concat "No such group: " gname)
- "No current group"))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (if gname (concat "No such group: " gname) "No current group"))
(throw 'return nil))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (nnmaildir--with-nntp-buffer
(erase-buffer)
- (setq nlist (nnmaildir--grp-get-lists group)
- mlist (nnmaildir--lists-get-mlist nlist)
- nlist (nnmaildir--lists-get-nlist nlist)
- gname (nnmaildir--grp-get-name group)
- srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir srv-dir gname))
+ (setq nlist (nnmaildir--grp-lists group)
+ mlist (nnmaildir--lists-mlist nlist)
+ nlist (nnmaildir--lists-nlist nlist)
+ gname (nnmaildir--grp-name group)
+ srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir srv-dir gname))
(cond
((null nlist))
((and fetch-old (not (numberp fetch-old)))
(while nlist
(setq article (car nlist) nlist (cdr nlist)
- nov (nnmaildir--update-nov srv-dir group article))
+ nov (nnmaildir--update-nov nnmaildir--cur-server group
+ article))
(when nov
(nnmaildir--cache-nov group article nov)
- (setq num (nnmaildir--art-get-num article))
+ (setq num (nnmaildir--art-num article))
(princ num nntp-server-buffer)
(insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-get-msgid article) "\t"
+ (nnmaildir--art-msgid article) "\t"
(nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
":")
(princ num nntp-server-buffer)
(setq article (car articles) articles (cdr articles)
article (nnmaildir--mlist-art mlist article))
(when (and article
- (setq nov (nnmaildir--update-nov srv-dir group
- article)))
+ (setq nov (nnmaildir--update-nov nnmaildir--cur-server
+ group article)))
(nnmaildir--cache-nov group article nov)
- (setq num (nnmaildir--art-get-num article))
+ (setq num (nnmaildir--art-num article))
(princ num nntp-server-buffer)
(insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-get-msgid article) "\t"
+ (nnmaildir--art-msgid article) "\t"
(nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
":")
(princ num nntp-server-buffer)
(setq articles (cdr articles)))
(if (numberp stop) (setq num stop)
(setq num (cdr stop) stop (car stop)))
- (setq nlist2 (nthcdr (- (nnmaildir--art-get-num (car nlist)) num)
+ (setq nlist2 (nthcdr (- (nnmaildir--art-num (car nlist)) num)
nlist))
(while (and nlist2
(setq article (car nlist2)
- num (nnmaildir--art-get-num article))
+ num (nnmaildir--art-num article))
(>= num stop))
(setq nlist2 (cdr nlist2)
- nov (nnmaildir--update-nov srv-dir group article))
+ nov (nnmaildir--update-nov nnmaildir--cur-server group
+ article))
(when nov
(nnmaildir--cache-nov group article nov)
(princ num nntp-server-buffer)
(insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-get-msgid article) "\t"
+ (nnmaildir--art-msgid article) "\t"
(nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
":")
(princ num nntp-server-buffer)
(defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
(let ((group (nnmaildir--prepare server gname))
(case-fold-search t)
- list article suffix dir deactivate-mark)
+ list article suffix dir pgname deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (if gname (concat "No such group: " gname)
- "No current group"))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (if gname (concat "No such group: " gname) "No current group"))
(throw 'return nil))
- (setq list (nnmaildir--grp-get-lists group))
+ (setq list (nnmaildir--grp-lists group))
(if (numberp num-msgid)
- (setq list (nnmaildir--lists-get-nlist list)
+ (setq list (nnmaildir--lists-nlist list)
article (nnmaildir--nlist-art list num-msgid))
- (setq list (nnmaildir--lists-get-mlist list)
+ (setq list (nnmaildir--lists-mlist list)
article (nnmaildir--mlist-art list num-msgid))
- (if article (setq num-msgid (nnmaildir--art-get-num article))
+ (if article (setq num-msgid (nnmaildir--art-num article))
(catch 'found
(mapatoms
- (lambda (grp)
- (setq group (symbol-value grp)
- list (nnmaildir--grp-get-lists group)
- list (nnmaildir--lists-get-mlist list)
- article (nnmaildir--mlist-art list num-msgid))
- (when article
- (setq num-msgid (nnmaildir--art-get-num article))
- (throw 'found nil)))
- (nnmaildir--srv-get-groups nnmaildir--cur-server)))))
+ (lambda (grp)
+ (setq group (symbol-value grp)
+ list (nnmaildir--grp-lists group)
+ list (nnmaildir--lists-mlist list)
+ article (nnmaildir--mlist-art list num-msgid))
+ (when article
+ (setq num-msgid (nnmaildir--art-num article))
+ (throw 'found nil)))
+ (nnmaildir--srv-groups nnmaildir--cur-server)))))
(if article nil
- (nnmaildir--srv-set-error nnmaildir--cur-server "No such article")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
(throw 'return nil))
- (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil
- (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
+ (if (stringp (setq suffix (nnmaildir--art-suffix article))) nil
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Article has expired")
(throw 'return nil))
- (setq gname (nnmaildir--grp-get-name group)
- dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir dir gname)
- group (if (nnmaildir--param (nnmaildir--grp-get-pname group)
- 'read-only)
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ group (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
nnmaildir-article-file-name (concat group
- (nnmaildir--art-get-prefix
+ (nnmaildir--art-prefix
article)
suffix))
(if (file-exists-p nnmaildir-article-file-name) nil
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
- (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Article has expired")
(throw 'return nil))
(save-excursion
(set-buffer (or to-buffer nntp-server-buffer))
(defun nnmaildir-request-replace-article (article gname buffer)
(let ((group (nnmaildir--prepare nil gname))
(coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
(buffer-file-coding-system nil)
+ (file-coding-system nil)
(file-coding-system-alist nil)
file dir suffix tmpfile deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
- (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only)
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Read-only group: " group))
+ (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
+ 'read-only)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Read-only group: " group))
(throw 'return nil))
- (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir dir gname)
- file (nnmaildir--grp-get-lists group)
- file (nnmaildir--lists-get-nlist file)
+ (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ file (nnmaildir--grp-lists group)
+ file (nnmaildir--lists-nlist file)
file (nnmaildir--nlist-art file article))
- (if (and file (stringp (setq suffix (nnmaildir--art-get-suffix file))))
+ (if (and file (stringp (setq suffix (nnmaildir--art-suffix file))))
nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (format "No such article: %d" article))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (format "No such article: %d" article))
(throw 'return nil))
(save-excursion
(set-buffer buffer)
(setq article file
- file (nnmaildir--art-get-prefix article)
+ file (nnmaildir--art-prefix article)
tmpfile (concat (nnmaildir--tmp dir) file))
(when (file-exists-p tmpfile)
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "File exists: " tmpfile))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " tmpfile))
(throw 'return nil))
(write-region (point-min) (point-max) tmpfile nil 'no-message nil
'confirm-overwrite)) ;; error would be preferred :(
pgname list suffix result nnmaildir--file deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
- (setq gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group)
- list (nnmaildir--grp-get-lists group)
- list (nnmaildir--lists-get-nlist list)
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ list (nnmaildir--grp-lists group)
+ list (nnmaildir--lists-nlist list)
article (nnmaildir--nlist-art list article))
(if article nil
- (nnmaildir--srv-set-error nnmaildir--cur-server "No such article")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
(throw 'return nil))
- (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil
- (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
+ (if (stringp (setq suffix (nnmaildir--art-suffix article))) nil
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Article has expired")
(throw 'return nil))
- (setq nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server)
- nnmaildir--file (nnmaildir--srv-grp-dir nnmaildir--file gname)
+ (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+ nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
nnmaildir--file (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new nnmaildir--file)
(nnmaildir--cur nnmaildir--file))
nnmaildir--file (concat nnmaildir--file
- (nnmaildir--art-get-prefix article)
+ (nnmaildir--art-prefix article)
suffix))
(if (file-exists-p nnmaildir--file) nil
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
- (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired")
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Article has expired")
(throw 'return nil))
- (save-excursion
- (set-buffer (get-buffer-create " *nnmaildir move*"))
+ (nnmaildir--with-move-buffer
(erase-buffer)
(nnheader-insert-file-contents nnmaildir--file)
(setq result (eval accept-form)))
(if (or (null result) (nnmaildir--param pgname 'read-only)) nil
(nnmaildir--unlink nnmaildir--file)
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil))
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil))
result)))
(defun nnmaildir-request-accept-article (gname &optional server last)
(let ((group (nnmaildir--prepare server gname))
(coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
(buffer-file-coding-system nil)
+ (file-coding-system nil)
(file-coding-system-alist nil)
srv-dir dir file tmpfile curfile 24h num article)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(throw 'return nil))
- (setq gname (nnmaildir--grp-get-name group))
- (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only)
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Read-only group: " gname))
+ (setq gname (nnmaildir--grp-name group))
+ (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
+ 'read-only)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Read-only group: " gname))
(throw 'return nil))
- (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir srv-dir gname)
+ (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir srv-dir gname)
file (format-time-string "%s" nil))
- (if (string= nnmaildir--delivery-time file) nil
+ (if (string-equal nnmaildir--delivery-time file) nil
(setq nnmaildir--delivery-time file
nnmaildir--delivery-ct 0))
(setq file (concat file "." nnmaildir--delivery-pid))
tmpfile (concat (nnmaildir--tmp dir) file)
curfile (concat (nnmaildir--cur dir) file ":2,"))
(when (file-exists-p tmpfile)
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "File exists: " tmpfile))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " tmpfile))
(throw 'return nil))
(when (file-exists-p curfile)
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "File exists: " curfile))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " curfile))
(throw 'return nil))
(setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct)
24h (run-with-timer 86400 nil
(lambda ()
(nnmaildir--unlink tmpfile)
- (nnmaildir--srv-set-error
- nnmaildir--cur-server
- "24-hour timer expired")
+ (setf (nnmaildir--srv-error
+ nnmaildir--cur-server)
+ "24-hour timer expired")
(throw 'return nil))))
(condition-case nil
(add-name-to-file nnmaildir--file tmpfile)
(condition-case err
(add-name-to-file tmpfile curfile)
(error
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "Error linking: "
- (prin1-to-string err)))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Error linking: " (prin1-to-string err)))
(nnmaildir--unlink tmpfile)
(throw 'return nil)))
(nnmaildir--unlink tmpfile)
- (setq article (nnmaildir--art-new)
- num (nnmaildir--grp-get-lists group)
- num (nnmaildir--lists-get-nlist num)
- num (1+ (nnmaildir--nlist-last-num num)))
- (nnmaildir--art-set-prefix article file)
- (nnmaildir--art-set-suffix article ":2,")
- (nnmaildir--art-set-num article num)
- (if (nnmaildir--grp-add-art srv-dir group article) (cons gname num)))))
+ (setq num (nnmaildir--grp-lists group)
+ num (nnmaildir--lists-nlist num)
+ num (1+ (nnmaildir--nlist-last-num num))
+ article (make-nnmaildir--art :prefix file :suffix ":2," :num num))
+ (if (nnmaildir--grp-add-art nnmaildir--cur-server group article)
+ (cons gname num)))))
(defun nnmaildir-save-mail (group-art)
(catch 'return
(while (looking-at "From ")
(replace-match "X-From-Line: ")
(forward-line 1))))
- (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server)
+ (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)
ga (car group-art) group-art (cdr group-art)
gname (car ga))
(or (intern-soft gname groups)
(if (nnmaildir-request-accept-article gname) nil
(throw 'return nil))
(setq x (nnmaildir--prepare nil gname)
- nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server)
- nnmaildir--file (concat nnmaildir--file
- (nnmaildir--grp-get-name x))
- nnmaildir--file (file-name-as-directory nnmaildir--file)
- x (nnmaildir--grp-get-lists x)
- x (nnmaildir--lists-get-nlist x)
+ nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+ nnmaildir--file (nnmaildir--subdir nnmaildir--file
+ (nnmaildir--grp-name x))
+ x (nnmaildir--grp-lists x)
+ x (nnmaildir--lists-nlist x)
x (car x)
nnmaildir--file (concat nnmaildir--file
- (nnmaildir--art-get-prefix x)
- (nnmaildir--art-get-suffix x)))
+ (nnmaildir--art-prefix x)
+ (nnmaildir--art-suffix x)))
(while group-art
(setq ga (car group-art) group-art (cdr group-art)
gname (car ga))
(let ((x (nnmaildir--prepare nil group)))
(catch 'return
(if x nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " group))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " group))
(throw 'return nil))
- (setq x (nnmaildir--grp-get-lists x)
- x (nnmaildir--lists-get-nlist x))
+ (setq x (nnmaildir--grp-lists x)
+ x (nnmaildir--lists-nlist x))
(if x
(setq x (car x)
- x (nnmaildir--art-get-num x)
+ x (nnmaildir--art-num x)
x (1+ x))
1))))
nnmaildir-article-file-name deactivate-mark)
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (if gname (concat "No such group: " gname)
- "No current group"))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (if gname (concat "No such group: " gname) "No current group"))
(throw 'return (gnus-uncompress-range ranges)))
- (setq gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname))
(if (nnmaildir--param pgname 'read-only)
(throw 'return (gnus-uncompress-range ranges)))
(setq time (or (nnmaildir--param pgname 'expire-age)
high (1- high)))
(setcar (cdr boundary) low)
(setcar boundary high)
- (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- dir (nnmaildir--srv-grp-dir dir gname)
+ (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
dir (nnmaildir--cur dir)
- nlist (nnmaildir--grp-get-lists group)
- nlist (nnmaildir--lists-get-nlist nlist)
+ nlist (nnmaildir--grp-lists group)
+ nlist (nnmaildir--lists-nlist nlist)
ranges (reverse ranges))
- (save-excursion
- (set-buffer (get-buffer-create " *nnmaildir move*"))
+ (nnmaildir--with-move-buffer
(while ranges
(setq number (car ranges) ranges (cdr ranges))
(while (eq number (car ranges))
(setq ranges (cdr ranges)))
(if (numberp number) (setq stop number)
(setq stop (car number) number (cdr number)))
- (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) number)
+ (setq nlist (nthcdr (- (nnmaildir--art-num (car nlist)) number)
nlist))
(while (and nlist
(setq article (car nlist)
- number (nnmaildir--art-get-num article))
+ number (nnmaildir--art-num article))
(>= number stop))
(setq nlist (cdr nlist)
- suffix (nnmaildir--art-get-suffix article))
+ suffix (nnmaildir--art-suffix article))
(catch 'continue
(if (stringp suffix) nil
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil)
(throw 'continue nil))
- (setq nnmaildir--file (nnmaildir--art-get-prefix article)
+ (setq nnmaildir--file (nnmaildir--art-prefix article)
nnmaildir--file (concat dir nnmaildir--file suffix)
time (file-attributes nnmaildir--file))
(if time nil
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil)
(throw 'continue nil))
(setq time (nth 5 time)
time-iter time
(if (equal target pgname)
(setq didnt (cons number didnt)) ;; Leave it here.
(nnmaildir--unlink nnmaildir--file)
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil))))))
+ (setf (nnmaildir--art-suffix article) 'expire)
+ (setf (nnmaildir--art-nov article) nil))))))
(erase-buffer))
didnt)))
(defun nnmaildir-request-set-mark (gname actions &optional server)
(let ((group (nnmaildir--prepare server gname))
(coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
(buffer-file-coding-system nil)
+ (file-coding-system nil)
(file-coding-system-alist nil)
del-mark add-marks marksdir markfile action group-nlist nlist ranges
begin end article all-marks todo-marks did-marks marks form mdir mfile
- deactivate-mark)
+ pgname ls markfilenew deactivate-mark)
(setq del-mark
(lambda ()
- (setq mfile (car marks)
- mfile (symbol-name mfile)
- mfile (concat marksdir mfile)
- mfile (file-name-as-directory mfile)
- mfile (concat mfile (nnmaildir--art-get-prefix article)))
+ (setq mfile (nnmaildir--subdir marksdir (symbol-name (car marks)))
+ mfile (concat mfile (nnmaildir--art-prefix article)))
(nnmaildir--unlink mfile))
add-marks
(lambda ()
(while marks
- (setq mdir (concat marksdir (symbol-name (car marks)))
- mfile (concat (file-name-as-directory mdir)
- (nnmaildir--art-get-prefix article)))
+ (setq mdir (nnmaildir--subdir marksdir (symbol-name (car marks)))
+ mfile (concat mdir (nnmaildir--art-prefix article)))
(if (memq (car marks) did-marks) nil
(nnmaildir--mkdir mdir)
(setq did-marks (cons (car marks) did-marks)))
(if (file-exists-p mfile) nil
(condition-case nil
(add-name-to-file markfile mfile)
- (file-error ;; too many links, probably
+ (file-error
(if (file-exists-p mfile) nil
- (nnmaildir--unlink markfile)
- (write-region "" nil markfile nil 'no-message)
- (add-name-to-file markfile mfile
- 'ok-if-already-exists)))))
+ ;; too many links, maybe
+ (write-region "" nil markfilenew nil 'no-message)
+ (add-name-to-file markfilenew mfile 'ok-if-already-exists)
+ (rename-file markfilenew markfile 'replace)))))
(setq marks (cdr marks)))))
(catch 'return
(if group nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such group: " gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
(while actions
(setq ranges (gnus-range-add ranges (caar actions))
actions (cdr actions)))
(throw 'return ranges))
- (setq group-nlist (nnmaildir--grp-get-lists group)
- group-nlist (nnmaildir--lists-get-nlist group-nlist)
- marksdir (nnmaildir--srv-get-dir nnmaildir--cur-server)
- marksdir (nnmaildir--srv-grp-dir marksdir gname)
+ (setq group-nlist (nnmaildir--grp-lists group)
+ group-nlist (nnmaildir--lists-nlist group-nlist)
+ marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
+ marksdir (nnmaildir--srvgrp-dir marksdir gname)
marksdir (nnmaildir--nndir marksdir)
markfile (concat marksdir "markfile")
- marksdir (concat marksdir "marks")
- marksdir (file-name-as-directory marksdir)
- gname (nnmaildir--grp-get-name group)
- all-marks (nnmaildir--grp-get-pname group)
- all-marks (or (nnmaildir--param all-marks 'directory-files)
- (nnmaildir--srv-get-ls nnmaildir--cur-server))
- all-marks (funcall all-marks marksdir nil "\\`[^.]" 'nosort)
+ markfilenew (concat markfile "{new}")
+ marksdir (nnmaildir--marks-dir marksdir)
+ gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+ all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
marks all-marks)
(while marks
(setcar marks (intern (car marks)))
(setq ranges (cdr ranges)))
(if (numberp begin) (setq end begin)
(setq end (cdr begin) begin (car begin)))
- (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) end)
+ (setq nlist (nthcdr (- (nnmaildir--art-num (car nlist)) end)
nlist))
(while (and nlist
(setq article (car nlist))
- (>= (nnmaildir--art-get-num article) begin))
+ (>= (nnmaildir--art-num article) begin))
(setq nlist (cdr nlist))
- (when (stringp (nnmaildir--art-get-suffix article))
+ (when (stringp (nnmaildir--art-suffix article))
(setq marks todo-marks)
(eval form)))))
nil)))
t)
(defun nnmaildir-close-server (&optional server)
- (let (srv-ls flist ls dirs dir files file x)
+ (let (flist ls dirs dir files file x)
(nnmaildir--prepare server nil)
(setq server nnmaildir--cur-server)
(when server
- (setq nnmaildir--cur-server nil
- srv-ls (nnmaildir--srv-get-ls server))
+ (setq nnmaildir--cur-server nil)
(save-match-data
(mapatoms
- (lambda (group)
- (setq group (symbol-value group)
- x (nnmaildir--grp-get-pname group)
- ls (nnmaildir--param x 'directory-files)
- ls (or ls srv-ls)
- dir (nnmaildir--srv-get-dir server)
- dir (nnmaildir--srv-grp-dir
- dir (nnmaildir--grp-get-name group))
- x (nnmaildir--param x 'read-only)
- x (if x (nnmaildir--new dir) (nnmaildir--cur dir))
- files (funcall ls x nil "\\`[^.]" 'nosort)
- x (length files)
- flist 1)
- (while (<= flist x) (setq flist (* 2 flist)))
- (if (/= flist 1) (setq flist (1- flist)))
- (setq flist (make-vector flist 0))
- (while files
- (setq file (car files) files (cdr files))
- (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
- (intern (match-string 1 file) flist))
- (setq dir (nnmaildir--nndir dir)
- dirs (cons (concat dir "nov")
- (funcall ls (concat dir "marks") 'full "\\`[^.]"
- 'nosort)))
- (while dirs
- (setq dir (car dirs) dirs (cdr dirs)
- files (funcall ls dir nil "\\`[^.]" 'nosort)
- dir (file-name-as-directory dir))
- (while files
- (setq file (car files) files (cdr files))
- (if (intern-soft file flist) nil
- (setq file (concat dir file))
- (delete-file file)))))
- (nnmaildir--srv-get-groups server)))
- (unintern (nnmaildir--srv-get-name server) nnmaildir--servers)))
+ (lambda (group)
+ (setq x (nnmaildir--pgname server (symbol-name group))
+ group (symbol-value group)
+ ls (nnmaildir--group-ls server x)
+ dir (nnmaildir--srv-dir server)
+ dir (nnmaildir--srvgrp-dir dir (nnmaildir--grp-name group))
+ x (nnmaildir--param x 'read-only)
+ x (if x (nnmaildir--new dir) (nnmaildir--cur dir))
+ files (funcall ls x nil "\\`[^.]" 'nosort)
+ x (length files)
+ flist 1)
+ (while (<= flist x) (setq flist (* 2 flist)))
+ (if (/= flist 1) (setq flist (1- flist)))
+ (setq flist (make-vector flist 0))
+ (while files
+ (setq file (car files) files (cdr files))
+ (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
+ (intern (match-string 1 file) flist))
+ (setq dir (nnmaildir--nndir dir)
+ dirs (cons (nnmaildir--nov-dir dir)
+ (funcall ls (nnmaildir--marks-dir dir) 'full
+ "\\`[^.]" 'nosort)))
+ (while dirs
+ (setq dir (car dirs) dirs (cdr dirs)
+ files (funcall ls dir nil "\\`[^.]" 'nosort)
+ dir (file-name-as-directory dir))
+ (while files
+ (setq file (car files) files (cdr files))
+ (if (intern-soft file flist) nil
+ (setq file (concat dir file))
+ (delete-file file)))))
+ (nnmaildir--srv-groups server)))
+ (unintern (nnmaildir--srv-address server) nnmaildir--servers)))
t)
(defun nnmaildir-request-close ()
(if buffer (kill-buffer buffer)))
t)
+(defun nnmaildir--edit-prep ()
+ (let ((extras '(mapcar mapatoms))
+ name)
+ (mapatoms
+ (lambda (sym)
+ (when (or (memq sym extras)
+ (and (fboundp sym)
+ (setq name (symbol-name sym))
+ (>= (length name) 10)
+ (or (string-equal "nnmaildir-" (substring name 0 10))
+ (and (>= (length name) 15)
+ (string-equal "make-nnmaildir-"
+ (substring name 0 15))))))
+ (put sym 'lisp-indent-function 0))))
+ 'done))
+
(provide 'nnmaildir)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; fill-column: 77
+;; eval: (progn (require 'nnmaildir) (nnmaildir--edit-prep))
+;; End:
+
;;; nnmaildir.el ends here
projects / elisp / gnus.git- / blobdiff