;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(require 'nnheader)
(require 'nnmail)
+(require 'nnoo)
+(require 'cl)
-(defvar nnml-directory "~/Mail/"
+(nnoo-declare nnml)
+
+(defvoo nnml-directory message-directory
"Mail spool directory.")
-(defvar nnml-active-file (concat nnml-directory "active")
+(defvoo nnml-active-file
+ (concat (file-name-as-directory nnml-directory) "active")
"Mail active file.")
-(defvar nnml-newsgroups-file (concat nnml-directory "newsgroups")
+(defvoo nnml-newsgroups-file
+ (concat (file-name-as-directory nnml-directory) "newsgroups")
"Mail newsgroups description file.")
-(defvar nnml-get-new-mail t
+(defvoo nnml-get-new-mail t
"If non-nil, nnml will check the incoming mail file and split the mail.")
-(defvar nnml-nov-is-evil nil
+(defvoo nnml-nov-is-evil nil
"If non-nil, Gnus will never generate and use nov databases for mail groups.
Using nov databases will speed up header fetching considerably.
-This variable shouldn't be flipped much. If you have, for some reason,
+This variable shouldn't be flipped much. If you have, for some reason,
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
+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.")
-(defvar nnml-prepare-save-mail-hook nil
+(defvoo nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
+(defvoo nnml-inhibit-expiry nil
+ "If non-nil, inhibit expiry.")
+
+
\f
(defconst nnml-version "nnml 1.0"
"nnml version.")
-(defvar nnml-nov-file-name ".overview")
+(defvoo nnml-nov-file-name ".overview")
-(defvar nnml-current-directory nil)
-(defvar nnml-current-group nil)
-(defvar nnml-status-string "")
-(defvar nnml-nov-buffer-alist nil)
-(defvar nnml-group-alist nil)
-(defvar nnml-active-timestamp nil)
+(defvoo nnml-current-directory nil)
+(defvoo nnml-current-group nil)
+(defvoo nnml-status-string "")
+(defvoo nnml-nov-buffer-alist nil)
+(defvoo nnml-group-alist nil)
+(defvoo nnml-active-timestamp nil)
+(defvoo nnml-article-file-alist nil)
-\f
-
-;; Server variables.
-
-(defvar nnml-current-server nil)
-(defvar nnml-server-alist nil)
-(defvar nnml-server-variables
- (list
- (list 'nnml-directory nnml-directory)
- (list 'nnml-active-file nnml-active-file)
- (list 'nnml-newsgroups-file nnml-newsgroups-file)
- (list 'nnml-get-new-mail nnml-get-new-mail)
- (list 'nnml-nov-is-evil nnml-nov-is-evil)
- (list 'nnml-nov-file-name nnml-nov-file-name)
- '(nnml-current-directory nil)
- '(nnml-current-group nil)
- '(nnml-status-string "")
- '(nnml-nov-buffer-alist nil)
- '(nnml-group-alist nil)
- '(nnml-active-timestamp nil)))
+(defvoo nnml-generate-active-function 'nnml-generate-active-info)
\f
;;; Interface functions.
-(defun nnml-retrieve-headers (sequence &optional newsgroup server fetch-old)
+(nnoo-define-basics nnml)
+
+(deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
beg article)
(if (stringp (car sequence))
'headers
- (nnml-possibly-change-directory newsgroup)
+ (nnml-possibly-change-directory newsgroup server)
+ (unless nnml-article-file-alist
+ (setq nnml-article-file-alist
+ (nnheader-article-to-file-alist nnml-current-directory)))
(if (nnml-retrieve-headers-with-nov sequence fetch-old)
'nov
(while sequence
(setq article (car sequence))
- (setq file
- (concat nnml-current-directory (int-to-string article)))
+ (setq file
+ (concat nnml-current-directory
+ (or (cdr (assq article nnml-article-file-alist))
+ "")))
(if (and (file-exists-p file)
(not (file-directory-p file)))
(progn
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
(zerop (% count 20))
- gnus-verbose-backends
- (message "nnml: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (nnheader-message 6 "nnml: Receiving headers... %d%%"
+ (/ (* count 100) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
- gnus-verbose-backends
- (message "nnml: Receiving headers...done"))
+ (nnheader-message 6 "nnml: Receiving headers...done"))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
+ (nnheader-fold-continuation-lines)
'headers)))))
-(defun nnml-open-server (server &optional defs)
- (nnheader-init-server-buffer)
- (if (equal server nnml-current-server)
- t
- (if nnml-current-server
- (setq nnml-server-alist
- (cons (list nnml-current-server
- (nnheader-save-variables nnml-server-variables))
- nnml-server-alist)))
- (let ((state (assoc server nnml-server-alist)))
- (if state
- (progn
- (nnheader-restore-variables (nth 1 state))
- (setq nnml-server-alist (delq state nnml-server-alist)))
- (nnheader-set-init-variables nnml-server-variables defs)))
- (setq nnml-current-server server)))
-
-(defun nnml-close-server (&optional server)
- (setq nnml-current-server nil)
- t)
-
-(defun nnml-server-opened (&optional server)
- (and (equal server nnml-current-server)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)))
-
-(defun nnml-status-message (&optional server)
- nnml-status-string)
-
-(defun nnml-request-article (id &optional newsgroup server buffer)
- (nnml-possibly-change-directory newsgroup)
- (let* ((group-num (and (stringp id) (nnml-find-group-number id)))
- (number (if (numberp id) id (cdr group-num)))
- (file
- (and number
- (concat
- (if (numberp id)
- nnml-current-directory
- (nnmail-group-pathname (car group-num) nnml-directory))
- (int-to-string number))))
- (nntp-server-buffer (or buffer nntp-server-buffer)))
- (and file
- (file-exists-p file)
- (not (file-directory-p file))
- (save-excursion (nnmail-find-file file))
- ;; We return the article number.
- (cons newsgroup (string-to-int (file-name-nondirectory file))))))
-
-(defun nnml-request-group (group &optional server dont-check)
- (if (not (nnml-possibly-change-directory group))
- (progn
- (setq nnml-status-string "Invalid group (no such directory)")
- nil)
- (if dont-check
- t
- (nnmail-activate 'nnml)
- (let ((active (nth 1 (assoc group nnml-group-alist))))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (if (not active)
- ()
- (insert (format "211 %d %d %d %s\n"
- (max (1+ (- (cdr active) (car active))) 0)
- (car active) (cdr active) group))
- t))))))
-
-(defun nnml-request-scan (&optional group server)
+(deffoo nnml-open-server (server &optional defs)
+ (nnoo-change-server 'nnml server defs)
+ (when (not (file-exists-p nnml-directory))
+ (condition-case ()
+ (make-directory nnml-directory t)
+ (error t)))
+ (cond
+ ((not (file-exists-p nnml-directory))
+ (nnml-close-server)
+ (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
+ ((not (file-directory-p (file-truename nnml-directory)))
+ (nnml-close-server)
+ (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
+ (t
+ (nnheader-report 'nnml "Opened server %s using directory %s"
+ server nnml-directory)
+ t)))
+
+(deffoo nnml-request-article (id &optional newsgroup server buffer)
+ (nnml-possibly-change-directory newsgroup server)
+ (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
+ path gpath group-num)
+ (if (stringp id)
+ (when (and (setq group-num (nnml-find-group-number id))
+ (cdr
+ (assq (cdr group-num)
+ (nnheader-article-to-file-alist
+ (setq gpath
+ (nnmail-group-pathname
+ (car group-num)
+ nnml-directory))))))
+ (setq path (concat gpath (int-to-string (cdr group-num)))))
+ (setq path (nnml-article-to-file id)))
+ (cond
+ ((not path)
+ (nnheader-report 'nnml "No such article: %s" id))
+ ((not (file-exists-p path))
+ (nnheader-report 'nnml "No such file: %s" path))
+ ((file-directory-p path)
+ (nnheader-report 'nnml "File is a directory: %s" path))
+ ((not (save-excursion (nnmail-find-file path)))
+ (nnheader-report 'nnml "Couldn't read file: %s" path))
+ (t
+ (nnheader-report 'nnml "Article %s retrieved" id)
+ ;; We return the article number.
+ (cons newsgroup (string-to-int (file-name-nondirectory path)))))))
+
+(deffoo nnml-request-group (group &optional server dont-check)
+ (cond
+ ((not (nnml-possibly-change-directory group server))
+ (nnheader-report 'nnml "Invalid group (no such directory)"))
+ ((not (file-exists-p nnml-current-directory))
+ (nnheader-report 'nnml "Directory %s does not exist"
+ nnml-current-directory))
+ ((not (file-directory-p nnml-current-directory))
+ (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
+ (dont-check
+ (nnheader-report 'nnml "Group %s selected" group)
+ t)
+ (t
+ (nnmail-activate 'nnml)
+ (let ((active (nth 1 (assoc group nnml-group-alist))))
+ (if (not active)
+ (nnheader-report 'nnml "No such group: %s" group)
+ (nnheader-report 'nnml "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (max (1+ (- (cdr active) (car active))) 0)
+ (car active) (cdr active) group))))))
+
+(deffoo nnml-request-scan (&optional group server)
+ (setq nnml-article-file-alist nil)
(nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
-(defun nnml-close-group (group &optional server)
- t)
-
-(defun nnml-request-close ()
- (setq nnml-current-server nil)
- (setq nnml-server-alist nil)
+(deffoo nnml-close-group (group &optional server)
+ (setq nnml-article-file-alist nil)
t)
-(defun nnml-request-create-group (group &optional server)
+(deffoo nnml-request-create-group (group &optional server args)
(nnmail-activate 'nnml)
- (or (assoc group nnml-group-alist)
- (let (active)
- (setq nnml-group-alist (cons (list group (setq active (cons 1 0)))
- nnml-group-alist))
- (nnml-possibly-create-directory group)
- (nnml-possibly-change-directory group)
- (let ((articles (mapcar
- (lambda (file)
- (string-to-int file))
- (directory-files
- nnml-current-directory nil "^[0-9]+$"))))
- (and articles
- (progn
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles)))))
- (nnmail-save-active nnml-group-alist nnml-active-file)))
+ (unless (assoc group nnml-group-alist)
+ (let (active)
+ (push (list group (setq active (cons 1 0)))
+ nnml-group-alist)
+ (nnml-possibly-create-directory group)
+ (nnml-possibly-change-directory group server)
+ (let ((articles (nnheader-directory-articles nnml-current-directory)))
+ (when articles
+ (setcar active (apply 'min articles))
+ (setcdr active (apply 'max articles))))
+ (nnmail-save-active nnml-group-alist nnml-active-file)))
t)
-(defun nnml-request-list (&optional server)
+(deffoo nnml-request-list (&optional server)
(save-excursion
(nnmail-find-file nnml-active-file)
(setq nnml-group-alist (nnmail-get-active))))
-(defun nnml-request-newgroups (date &optional server)
+(deffoo nnml-request-newgroups (date &optional server)
(nnml-request-list server))
-(defun nnml-request-list-newsgroups (&optional server)
+(deffoo nnml-request-list-newsgroups (&optional server)
(save-excursion
(nnmail-find-file nnml-newsgroups-file)))
-(defun nnml-request-post (&optional server)
- (mail-send-and-exit nil))
-
-(defun nnml-request-expire-articles (articles newsgroup &optional server force)
- (nnml-possibly-change-directory newsgroup)
- (let* ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function newsgroup))
- nnmail-expiry-wait))
- (active-articles
- (mapcar
- (function
- (lambda (name)
- (string-to-int name)))
- (directory-files nnml-current-directory nil "^[0-9]+$" t)))
- (max-article (and active-articles (apply 'max active-articles)))
+(deffoo nnml-request-expire-articles (articles newsgroup &optional server force)
+ (nnml-possibly-change-directory newsgroup server)
+ (let* ((active-articles
+ (nnheader-directory-articles nnml-current-directory))
(is-old t)
- article rest mod-time)
+ article rest mod-time number)
(nnmail-activate 'nnml)
+ (unless nnml-article-file-alist
+ (setq nnml-article-file-alist
+ (nnheader-article-to-file-alist nnml-current-directory)))
+
(while (and articles is-old)
(setq article (concat nnml-current-directory
- (int-to-string (car articles))))
- (if (setq mod-time (nth 5 (file-attributes article)))
- (if (and (nnml-deletable-article-p newsgroup (car articles))
- (or force
- (and (not (equal mod-time '(0 0)))
- (setq is-old
- &n
projects / gnus / blobdiff