(require 'nnmail)
(require 'nnoo)
(eval-when-compile (require 'cl))
-(eval-and-compile
- (autoload 'gnus-sorted-intersection "gnus-range"))
(nnoo-declare nnml)
(defvoo nnml-directory message-directory
- "Spool directory for the nnml mail backend.")
+ "Spool directory for the nnml mail backend.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
(defvoo nnml-active-file
(expand-file-name "active" nnml-directory)
- "Mail active file.")
+ "Mail active file.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
(defvoo nnml-newsgroups-file
(expand-file-name "newsgroups" nnml-directory)
- "Mail newsgroups description file.")
+ "Mail newsgroups description file.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
(defvoo nnml-get-new-mail t
- "If non-nil, nnml will check the incoming mail file and split the mail.")
+ "If non-nil, nnml will check the incoming mail file and split the mail.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
(defvoo nnml-nov-is-evil nil
"If non-nil, Gnus will never generate and use nov databases for mail groups.
set this to t, and want to set it to nil again, you should always run
the `nnml-generate-nov-databases' command. The function will go
through all nnml directories and generate nov databases for them
-all. This may very well take some time.")
+all. This may very well take some time.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
(defvoo nnml-prepare-save-mail-hook nil
- "Hook run narrowed to an article before saving.")
+ "Hook run narrowed to an article before saving.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
(defvoo nnml-inhibit-expiry nil
- "If non-nil, inhibit expiry.")
+ "If non-nil, inhibit expiry.
+
+This variable is a virtual server slot. See the Gnus manual for details.")
\f
(defvoo nnml-generate-active-function 'nnml-generate-active-info)
(defvar nnml-nov-buffer-file-name nil)
+(defvar nnml-check-directory-twice t
+ "If t, to make sure nothing went wrong when reading over NFS --
+check twice.")
(defvoo nnml-file-coding-system nnmail-file-coding-system)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let ((file nil)
- (number (length sequence))
- (count 0)
- (file-name-coding-system nnmail-pathname-coding-system)
- beg article)
+ (let* ((file nil)
+ (number (length sequence))
+ (count 0)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ beg article
+ (nnml-check-directory-twice
+ (and nnml-check-directory-twice
+ ;; To speed up, disable it in some case.
+ (or (not (numberp nnmail-large-newsgroup))
+ (<= number nnmail-large-newsgroup)))))
(if (stringp (car sequence))
'headers
(if (nnml-retrieve-headers-with-nov sequence fetch-old)
server nnml-directory)
t)))
-(defun nnml-request-regenerate (server)
+(deffoo nnml-request-regenerate (server)
(nnml-possibly-change-directory nil server)
- (nnml-generate-nov-databases)
+ (nnml-generate-nov-databases server)
t)
(deffoo nnml-request-article (id &optional group server buffer)
(and
(nnml-deletable-article-p group article)
(nnml-request-article article group server)
- (let (nnml-current-directory
- nnml-current-group
+ (let (nnml-current-directory
+ nnml-current-group
nnml-article-file-alist)
(save-excursion
(set-buffer buf)
(nnml-save-nov))))
result))
+(deffoo nnml-request-post (&optional server)
+ (nnmail-do-request-post 'nnml-request-accept-article server))
+
(deffoo nnml-request-replace-article (article group buffer)
(nnml-possibly-change-directory group)
(save-excursion
(directory-files
nnml-current-directory t
(concat nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$")))
+ "\\|" (regexp-quote nnml-nov-file-name) "$"
+ "\\|" (regexp-quote nnml-marks-file-name) "$")))
article)
(while articles
(setq article (pop articles))
(let ((overview (concat old-dir nnml-nov-file-name)))
(when (file-exists-p overview)
(rename-file overview (concat new-dir nnml-nov-file-name))))
+ ;; Move .marks file.
+ (let ((marks (concat old-dir nnml-marks-file-name)))
+ (when (file-exists-p marks)
+ (rename-file marks (concat new-dir nnml-marks-file-name))))
(when (<= (length (directory-files old-dir)) 2)
(ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
(let (file)
(if (setq file (cdr (assq article nnml-article-file-alist)))
(expand-file-name file nnml-current-directory)
+ (if nnml-check-directory-twice
;; Just to make sure nothing went wrong when reading over NFS --
- ;; check once more.
- (when (file-exists-p
- (setq file (expand-file-name (number-to-string article)
- nnml-current-directory)))
- (nnml-update-file-alist t)
- file))))
+ ;; check once more.
+ (when (file-exists-p
+ (setq file (expand-file-name (number-to-string article)
+ nnml-current-directory)))
+ (nnml-update-file-alist t)
+ file)))))
(defun nnml-deletable-article-p (group article)
"Say whether ARTICLE in GROUP can be deleted."
;; likely that the article we are looking for is in that group.
(if (setq number (nnml-find-id nnml-current-group id))
(cons nnml-current-group number)
- ;; It wasn't there, so we look through the other groups as well.
+ ;; It wasn't there, so we look through the other groups as well.
(while (and (not number)
alist)
(or (string= (caar alist) nnml-current-group)
(setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
;;;###autoload
-(defun nnml-generate-nov-databases ()
+(defun nnml-generate-nov-databases (&optional server)
"Generate NOV databases in all nnml directories."
- (interactive)
+ (interactive (list (or (nnoo-current-server 'nnml) "")))
;; Read the active file to make sure we don't re-use articles
;; numbers in empty groups.
(nnmail-activate 'nnml)
- (nnml-open-server (or (nnoo-current-server 'nnml) ""))
+ (unless (nnml-server-opened server)
+ (nnml-open-server server))
(setq nnml-directory (expand-file-name nnml-directory))
;; Recurse down the directories.
(nnml-generate-nov-databases-1 nnml-directory nil t)
(eval-when-compile (defvar files))
(defun nnml-generate-active-info (dir)
;; Update the active info for this group.
- (let ((group (nnheader-file-to-group
- (directory-file-name dir) nnml-directory)))
- (setq nnml-group-alist
- (delq (assoc group nnml-group-alist) nnml-group-alist))
+ (let* ((group (nnheader-file-to-group
+ (directory-file-name dir) nnml-directory))
+ (entry (assoc group nnml-group-alist))
+ (last (or (caadr entry) 0)))
+ (setq nnml-group-alist (delq entry nnml-group-alist))
(push (list group
- (cons (caar files)
- (let ((f files))
- (while (cdr f) (setq f (cdr f)))
- (caar f))))
+ (cons (or (caar files) (1+ last))
+ (max last
+ (or (let ((f files))
+ (while (cdr f) (setq f (cdr f)))
+ (caar f))
+ 0))))
nnml-group-alist)))
(defun nnml-generate-nov-file (dir files)
(setq nnml-article-file-alist
(nnheader-article-to-file-alist nnml-current-directory))))
+(defvoo nnml-marks-file-name ".marks")
+(defvoo nnml-marks-is-evil nil)
+(defvoo nnml-marks nil)
+
+(deffoo nnml-request-set-mark (group actions &optional server)
+ (nnml-possibly-change-directory group server)
+ (unless nnml-marks-is-evil
+ (nnml-open-marks group server)
+ (dolist (action actions)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (assert (or (eq what 'add) (eq what 'del)) t
+ "Unknown request-set-mark action: %s" what)
+ (dolist (mark marks)
+ (setq nnml-marks (nnimap-update-alist-soft
+ mark
+ (funcall (if (eq what 'add) 'gnus-range-add
+ 'gnus-remove-from-range)
+ (cdr (assoc mark nnml-marks)) range)
+ nnml-marks)))))
+ (nnml-save-marks group server)))
+
+(deffoo nnml-request-update-info (group info &optional server)
+ (nnml-possibly-change-directory group server)
+ (unless nnml-marks-is-evil
+ (nnml-open-marks group server)
+ ;; Update info using `nnml-marks'.
+ (mapcar (lambda (pred)
+ (gnus-info-set-marks
+ info
+ (nnimap-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nnml-marks))
+ (gnus-info-marks info))
+ t))
+ gnus-article-mark-lists)
+ (let ((seen (cdr (assq 'read nnml-marks))))
+ (gnus-info-set-read info
+ (if (and (integerp (car seen))
+ (null (cdr seen)))
+ (list (cons (car seen) (car seen)))
+ seen))))
+ info)
+
+(defun nnml-save-marks (group server)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (expand-file-name nnml-marks-file-name
+ (nnmail-group-pathname group nnml-directory))))
+ (gnus-make-directory (file-name-directory file))
+ (with-temp-file file
+ (erase-buffer)
+ (princ nnml-marks (current-buffer))
+ (insert "\n"))))
+
+(defun nnml-open-marks (group server)
+ (with-temp-buffer
+ (let ((file (expand-file-name
+ nnml-marks-file-name
+ (nnmail-group-pathname group nnml-directory))))
+ (if (file-exists-p file)
+ (setq nnml-marks (condition-case err
+ (progn
+ (nnheader-insert-file-contents file)
+ (read (current-buffer)))
+ (error (or (gnus-yes-or-no-p
+ (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
+ (error "Cannot read nnml marks file %s (%s)" file err)))))
+ ;; User didn't have a .marks file. Probably first time
+ ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
+ (let ((info (gnus-get-info
+ (gnus-group-prefixed-name
+ group
+ (gnus-server-to-method (format "nnml:%s" server))))))
+ (nnheader-message 6 "Boostrapping nnml marks...")
+ (setq nnml-marks (gnus-info-marks info))
+ (push (cons 'read (gnus-info-read info)) nnml-marks)
+ (nnml-save-marks group server))))))
+
(provide 'nnml)
;;; nnml.el ends here
projects / gnus / blobdiff