-;;; nnmh.el --- mail spool access for Gnus (mhspool)
+;;; nnmh.el --- mhspool access for Gnus
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;; Commentary:
;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.
;;; Code:
(require 'gnus)
(defvar nnmh-directory "~/Mail/"
- "Mail directory.")
+ "*Mail spool directory.")
(defvar nnmh-get-new-mail t
- "If non-nil, nnmh will check the incoming mail file and split the mail.")
+ "*If non-nil, nnmh will check the incoming mail file and split the mail.")
+
+(defvar nnmh-prepare-save-mail-hook nil
+ "*Hook run narrowed to an article before saving.")
+
+(defvar nnmh-be-safe nil
+ "*If non-nil, nnmh will check all articles to make sure whether they are new or not.")
\f
"Current news group directory.")
(defvar nnmh-status-string "")
-
(defvar nnmh-group-alist nil)
\f
+(defvar nnmh-current-server nil)
+(defvar nnmh-server-alist nil)
+(defvar nnmh-server-variables
+ (list
+ (list 'nnmh-directory nnmh-directory)
+ (list 'nnmh-get-new-mail nnmh-get-new-mail)
+ '(nnmh-current-directory nil)
+ '(nnmh-status-string "")
+ '(nnmh-group-alist)))
+
+\f
+
;;; Interface functions.
(defun nnmh-retrieve-headers (sequence &optional newsgroup server)
- "Retrieve the headers for the articles in SEQUENCE.
-Newsgroup must be selected before calling this function."
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let ((file nil)
- (number (length sequence))
- (count 0)
- beg article)
+ (let* ((file nil)
+ (number (length sequence))
+ (large (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)))
+ (count 0)
+ beg article)
(nnmh-possibly-change-directory newsgroup)
- (while sequence
- (setq article (car sequence))
- (setq file
- (concat nnmh-current-directory (prin1-to-string article)))
- (if (and (file-exists-p file)
- (not (file-directory-p file)))
- (progn
- (insert (format "221 %d Article retrieved.\n" article))
- (setq beg (point))
- (insert-file-contents file)
- (goto-char beg)
- (if (search-forward "\n\n" nil t)
- (forward-char -1)
- (goto-char (point-max))
- (insert "\n\n"))
- (insert ".\n")
- (delete-region (point) (point-max))))
- (setq sequence (cdr sequence))
- (setq count (1+ count))
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (zerop (% count 20))
- (message "nnmh: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (message "nnmh: Receiving headers... done"))
-
- ;; Fold continuation lines.
- (goto-char 1)
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- 'headers)))
-
-(defun nnmh-open-server (host &optional service)
- "Open nnmh mail backend."
- (setq nnmh-status-string "")
- (nnheader-init-server-buffer))
+ (if (stringp (car sequence))
+ 'headers
+ (while sequence
+ (setq article (car sequence))
+ (setq file
+ (concat nnmh-current-directory (int-to-string article)))
+ (if (and (file-exists-p file)
+ (not (file-directory-p file)))
+ (progn
+ (insert (format "221 %d Article retrieved.\n" article))
+ (setq beg (point))
+ (nnheader-insert-head file)
+ (goto-char beg)
+ (if (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (goto-char (point-max))
+ (insert "\n\n"))
+ (insert ".\n")
+ (delete-region (point) (point-max))))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+
+ (and large
+ (zerop (% count 20))
+ (message "nnmh: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (and large (message "nnmh: Receiving headers...done"))
+
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ 'headers))))
+
+(defun nnmh-open-server (server &optional defs)
+ (nnheader-init-server-buffer)
+ (if (equal server nnmh-current-server)
+ t
+ (if nnmh-current-server
+ (setq nnmh-server-alist
+ (cons (list nnmh-current-server
+ (nnheader-save-variables nnmh-server-variables))
+ nnmh-server-alist)))
+ (let ((state (assoc server nnmh-server-alist)))
+ (if state
+ (progn
+ (nnheader-restore-variables (nth 1 state))
+ (setq nnmh-server-alist (delq state nnmh-server-alist)))
+ (nnheader-set-init-variables nnmh-server-variables defs)))
+ (setq nnmh-current-server server)))
(defun nnmh-close-server (&optional server)
- "Close news server."
t)
(defun nnmh-server-opened (&optional server)
- "Return server process status, T or NIL.
-If the stream is opened, return T, otherwise return NIL."
- (and nntp-server-buffer
- (get-buffer nntp-server-buffer)))
+ (and (equal server nnmh-current-server)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
(defun nnmh-status-message (&optional server)
- "Return server status response as string."
nnmh-status-string)
(defun nnmh-request-article (id &optional newsgroup server buffer)
- "Select article by message ID (or number)."
(nnmh-possibly-change-directory newsgroup)
(let ((file (if (stringp id)
nil
- (concat nnmh-current-directory (prin1-to-string id))))
+ (concat nnmh-current-directory (int-to-string id))))
(nntp-server-buffer (or buffer nntp-server-buffer)))
- (if (and (stringp file)
- (file-exists-p file)
- (not (file-directory-p file)))
- (save-excursion
- (nnmail-find-file file)))))
+ (and (stringp file)
+ (file-exists-p file)
+ (not (file-directory-p file))
+ (save-excursion (nnmail-find-file file)))))
(defun nnmh-request-group (group &optional server dont-check)
- "Select news GROUP."
- (and nnmh-get-new-mail (or dont-check (nnmh-get-new-mail)))
- (let ((pathname (nnmail-article-pathname group nnmh-directory))
+ (and nnmh-get-new-mail (or dont-check (nnmh-get-new-mail group)))
+ (let ((pathname (nnmh-article-pathname group nnmh-directory))
dir)
(if (file-directory-p pathname)
(progn
(setq nnmh-current-directory pathname)
- (and nnmh-get-new-mail (nnmh-update-gnus-unreads group))
+ (and nnmh-get-new-mail
+ nnmh-be-safe
+ (nnmh-update-gnus-unreads group))
(or dont-check
(progn
(setq dir
t))))
(defun nnmh-request-list (&optional server dir)
- "Get list of active articles in all newsgroups."
- (and server nnmh-get-new-mail (nnmh-get-new-mail))
(or dir
(save-excursion
(set-buffer nntp-server-buffer)
(setq dir nnmh-directory)))
(setq dir (expand-file-name dir))
;; Recurse down all directories.
- (let ((dirs (directory-files dir t nil t)))
+ (let ((dirs (and (file-readable-p dir)
+ (> (nth 1 (file-attributes (file-chase-links dir))) 2)
+ (directory-files dir t nil t))))
(while dirs
- (if (and (not (string-match "/\\.\\.$" (car dirs)))
- (not (string-match "/\\.$" (car dirs)))
- (file-directory-p (car dirs)))
- (nnmh-request-list server (car dirs)))
+ (if (and (not (string-match "/\\.\\.?$" (car dirs)))
+ (file-directory-p (car dirs))
+ (file-readable-p (car dirs)))
+ (nnmh-request-list nil (car dirs)))
(setq dirs (cdr dirs))))
;; For each directory, generate an active file line.
(if (not (string= (expand-file-name nnmh-directory) dir))
(let ((files (mapcar
(lambda (name) (string-to-int name))
(directory-files dir nil "^[0-9]+$" t))))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (insert
- (format
- "%s %d %d y\n"
- (progn
- (string-match (expand-file-name nnmh-directory) dir)
- (nnmail-replace-chars-in-string
- (substring dir (match-end 0)) ?/ ?.))
- (if files (apply (function max) files) 0)
- (if files (apply (function min) files) 0))))))
+ (if (null files)
+ ()
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (insert
+ (format
+ "%s %d %d y\n"
+ (progn
+ (string-match (expand-file-name nnmh-directory) dir)
+ (nnmail-replace-chars-in-string
+ (substring dir (match-end 0)) ?/ ?.))
+ (apply (function max) files)
+ (apply (function min) files)))))))
+ (setq nnmh-group-alist (nnmail-get-active))
+ (and server nnmh-get-new-mail (nnmh-get-new-mail))
t)
(defun nnmh-request-newgroups (date &optional server)
- "List groups created after DATE."
(nnmh-request-list server))
(defun nnmh-request-post (&optional server)
- "Post a new news in current buffer."
(mail-send-and-exit nil))
-(fset 'nnmh-request-post-buffer 'nnmail-request-post-buffer)
+(defalias 'nnmh-request-post-buffer 'nnmail-request-post-buffer)
(defun nnmh-request-expire-articles (articles newsgroup &optional server force)
- "Expire all articles in the ARTICLES list in group GROUP.
-The list of unexpired articles will be returned (ie. all articles that
-were too fresh to be expired).
-If FORCE is non-nil, ARTICLES will be deleted whether they are old or not."
(nnmh-possibly-change-directory newsgroup)
(let* ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function newsgroup))
(setq nnmh-group-alist (nnmail-get-active))
;; We trick the choosing function into believing that only one
;; group is availiable.
- (let ((nnmail-split-methods '(group "")))
- (cons group (nnmh-save-mail))))
+ (let ((nnmail-split-methods (list (list group ""))))
+ (car (nnmh-save-mail))))
(and
(nnmh-request-list)
(setq nnmh-group-alist (nnmail-get-active))
- (nnmh-save-mail))))
+ (car (nnmh-save-mail)))))
(defun nnmh-request-replace-article (article group buffer)
(nnmh-possibly-change-directory group)
(save-excursion
(set-buffer buffer)
+ (nnmh-possibly-create-directory group)
(condition-case ()
(progn
(write-region (point-min) (point-max)
(defun nnmh-possibly-change-directory (newsgroup)
(if newsgroup
- (let ((pathname (nnmail-article-pathname newsgroup nnmh-directory)))
+ (let ((pathname (nnmh-article-pathname newsgroup nnmh-directory)))
(if (file-directory-p pathname)
(setq nnmh-current-directory pathname)
(error "No such newsgroup: %s" newsgroup)))))
-(defun nnmh-create-directories ()
- (let ((methods nnmail-split-methods)
- dir dirs)
- (while methods
- (setq dir (nnmail-article-pathname (car (car methods)) nnmh-directory))
- (while (not (file-directory-p dir))
- (setq dirs (cons dir dirs))
- (setq dir (file-name-directory (directory-file-name dir))))
- (while dirs
- (if (make-directory (directory-file-name (car dirs)))
- (error "Could not create directory %s" (car dirs)))
- (message "Creating mail directory %s" (car dirs))
- (setq dirs (cdr dirs)))
- (setq methods (cdr methods)))))
-
+(defun nnmh-possibly-create-directory (group)
+ (let (dir dirs)
+ (setq dir (nnmail-article-pathname group nnmh-directory))
+ (while (not (file-directory-p dir))
+ (setq dirs (cons dir dirs))
+ (setq dir (file-name-directory (directory-file-name dir))))
+ (while dirs
+ (if (make-directory (directory-file-name (car dirs)))
+ (error "Could not create directory %s" (car dirs)))
+ (and gnus-verbose-backends
+ (message "Creating mail directory %s" (car dirs)))
+ (setq dirs (cdr dirs)))))
+
(defun nnmh-save-mail ()
"Called narrowed to an article."
(let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))
chars nov-line lines hbeg hend)
(setq chars (nnmail-insert-lines))
(nnmail-insert-xref group-art)
+ (run-hooks 'nnmh-prepare-save-mail-hook)
(goto-char (point-min))
(while (looking-at "From ")
(replace-match "X-From-Line: ")
(let ((ga group-art)
first)
(while ga
- (let ((file (concat (nnmail-article-pathname
+ (nnmh-possibly-create-directory (car (car ga)))
+ (let ((file (concat (nnmh-article-pathname
(car (car ga)) nnmh-directory)
(int-to-string (cdr (car ga))))))
(if first
(setcdr active (1+ (cdr active)))
(let (file)
(while (file-exists-p
- (setq file (concat (nnmail-article-pathname
+ (setq file (concat (nnmh-article-pathname
group nnmh-directory)
(int-to-string (cdr active)))))
(setcdr active (1+ (cdr active)))))
(cdr active)))
-(defun nnmh-get-new-mail ()
+(defun nnmh-article-pathname (group mail-dir)
+ "Make pathname for GROUP."
+ (let ((mail-dir (file-name-as-directory (expand-file-name mail-dir))))
+ (if (file-directory-p (concat mail-dir group))
+ (concat mail-dir group "/")
+ (concat mail-dir (nnmail-replace-chars-in-string group ?. ?/) "/"))))
+
+(defun nnmh-get-new-mail (&optional group)
"Read new incoming mail."
- (let (incoming)
- (nnmh-create-directories)
- (if (and nnmh-get-new-mail nnmail-spool-file
- (file-exists-p nnmail-spool-file)
- (> (nth 7 (file-attributes nnmail-spool-file)) 0))
- (progn
- (message "nnmh: Reading incoming mail...")
- (setq incoming
- (nnmail-move-inbox nnmail-spool-file
- (concat nnmh-directory "Incoming")))
- (nnmh-request-list)
- (setq nnmh-group-alist (nnmail-get-active))
- (nnmail-split-incoming incoming 'nnmh-save-mail)
- (run-hooks 'nnmail-read-incoming-hook)
-;; (delete-file incoming)
- (message "nnmh: Reading incoming mail...done")))))
+ (let ((spools (nnmail-get-spool-files group))
+ incoming incomings)
+ (if (or (not nnmh-get-new-mail) (not nnmail-spool-file))
+ ()
+ ;; We first activate all the groups.
+ (or nnmh-group-alist
+ (nnmh-request-list))
+ ;; The we go through all the existing spool files and split the
+ ;; mail from each.
+ (while spools
+ (and
+ (file-exists-p (car spools))
+ (> (nth 7 (file-attributes (car spools))) 0)
+ (progn
+ (and gnus-verbose-backends
+ (message "nnmh: Reading incoming mail..."))
+ (setq incoming
+ (nnmail-move-inbox
+ (car spools) (concat nnmh-directory "Incoming")))
+ (setq incomings (cons incoming incomings))
+ (nnmail-split-incoming incoming 'nnmh-save-mail nil group)))
+ (setq spools (cdr spools)))
+ ;; If we did indeed read any incoming spools, we save all info.
+ (if incoming
+ (message "nnmh: Reading incoming mail...done"))
+ (while incomings
+ (and nnmail-delete-incoming
+ (file-writable-p incoming)
+ (delete-file incoming))
+ (setq incomings (cdr incomings))))))
+
(defun nnmh-update-gnus-unreads (group)
;; Go through the .nnmh-articles file and compare with the actual
projects / gnus / blobdiff