;; 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.
;; 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-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-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)))
-(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))
+;; 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-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--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--subdir (dir subdir)
- `(file-name-as-directory (concat ,dir ,subdir)))
-(defmacro nnmaildir--srv-grp-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"))
+(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)
+ (setq param (gnus-group-find-parameter pgname param 'allow-list)
param (if (vectorp param) (aref param 0) param))
(eval param))
(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))))
(throw 'return nil))
(setq server (symbol-value server)
nnmaildir--cur-server server))
- (or (setq groups (nnmaildir--srv-get-groups server))
+ (or (setq groups (nnmaildir--srv-groups server))
(throw 'return nil))
- (or (nnmaildir--srv-get-method server)
- (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server))
- x (gnus-server-to-method x)
- x (or x (throw 'return nil))
- x (nnmaildir--srv-set-method server x)))
+ (if (nnmaildir--srv-method server) nil
+ (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
+ x (gnus-server-to-method x))
+ (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))
(or (setq group (intern-soft group groups))
(throw 'return nil))
(setq group (symbol-value 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)
+ nov (nnmaildir--art-nov article)
novdir (nnmaildir--nov-dir (nnmaildir--nndir dir))
novfile (concat novdir prefix))
+ (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.
(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))
+ (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))
- (nnmaildir--grp-set-lists group new-lists)
- (set (intern (nnmaildir--art-get-prefix article)
- (nnmaildir--lists-get-flist new-lists))
+ (setf (nnmaildir--grp-lists group) new-lists)
+ (set (intern (nnmaildir--art-prefix article)
+ (nnmaildir--lists-flist new-lists))
article)
- (set (intern (nnmaildir--art-get-msgid article)
- (nnmaildir--lists-get-mlist new-lists))
+ (set (intern (nnmaildir--art-msgid article)
+ (nnmaildir--lists-mlist new-lists))
article))
(nnmaildir--cache-nov group article nov)
t)))
(defun nnmaildir--group-ls (server pgname)
(or (nnmaildir--param pgname 'directory-files)
- (nnmaildir--srv-get-ls server)))
+ (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
(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))
- (cons (nnmaildir--art-get-prefix article) suffix))))
+ (cons (nnmaildir--art-prefix article) suffix))))
(defun nnmaildir-base-name-to-article-number
(base-name group-name server-address-string)
(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-flist list)
+ (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-get-num article))))
+ (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 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 (nnmaildir--srv-grp-dir srv-dir gname)
+ (setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
nndir (nnmaildir--nndir absdir))
(if (file-exists-p absdir) nil
- (nnmaildir--srv-set-error nnmaildir--cur-server
- (concat "No such directory: " absdir))
+ (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 (nnmaildir--nov-dir nndir))
(nnmaildir--mkdir (nnmaildir--marks-dir nndir))
(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))
+ (setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
- (if (equal cattr (nnmaildir--grp-get-cur group))
+ (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
(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))
+ (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)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
- (nnmaildir-get-new-mail t)
+ (nnmaildir-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))
+ (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 (equal x (nnmaildir--srv-mtime nnmaildir--cur-server))
(if scan-group nil
(mapatoms (lambda (sym)
(nnmaildir--scan (symbol-name sym) t groups
(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)
+ (setf (nnmaildir--srv-mtime nnmaildir--cur-server)
+ (nth 5 (file-attributes srv-dir))))
+ (if (nnmaildir--srv-gnm nnmaildir--cur-server)
(nnmail-get-new-mail 'nnmaildir nil nil))))))
t)
(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) " ")
+ (insert (nnmaildir--grp-name group) " ")
(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 " ")
(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)
(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)
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 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 (nnmaildir--marks-dir dir)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
(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 (nnmaildir--subdir dir mark)
(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)
(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
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))
(delete-file (car files))
(setq files (cdr files)))
(delete-directory dir))
- (setq dir (nnmaildir--nndir grp-dir)
- files (concat dir "markfile"))
- (nnmaildir--unlink files)
+ (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))
(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))
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))
(nnmaildir--with-move-buffer
(erase-buffer)
(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)
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-equal nnmaildir--delivery-time file) nil
(setq nnmaildir--delivery-time file
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 (nnmaildir--srv-dir nnmaildir--cur-server)
nnmaildir--file (nnmaildir--subdir nnmaildir--file
- (nnmaildir--grp-get-name x))
- x (nnmaildir--grp-get-lists x)
- x (nnmaildir--lists-get-nlist x)
+ (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))
(nnmaildir--with-move-buffer
(while 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)))
(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
- pgname ls deactivate-mark)
+ pgname ls markfilenew deactivate-mark)
(setq del-mark
(lambda ()
(setq mfile (nnmaildir--subdir marksdir (symbol-name (car marks)))
- mfile (concat mfile (nnmaildir--art-get-prefix article)))
+ mfile (concat mfile (nnmaildir--art-prefix article)))
(nnmaildir--unlink mfile))
add-marks
(lambda ()
(while marks
(setq mdir (nnmaildir--subdir marksdir (symbol-name (car marks)))
- mfile (concat mdir (nnmaildir--art-get-prefix article)))
+ 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")
+ markfilenew (concat markfile "{new}")
marksdir (nnmaildir--marks-dir marksdir)
- gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group)
+ 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)
(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)))
(setq nnmaildir--cur-server nil)
(save-match-data
(mapatoms
- (lambda (group)
- (setq group (symbol-value group)
- x (nnmaildir--grp-get-pname group)
- ls (nnmaildir--group-ls server x)
- 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 (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-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 ()
(mapatoms
(lambda (sym)
(when (or (memq sym extras)
- (and (fboundp sym)
- (>= (length (setq name (symbol-name sym))) 10)
- (string-equal "nnmaildir-" (substring name 0 10))))
+ (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:
projects / elisp / gnus.git- / commitdiff