;;; nnmbox.el --- mail mbox access for Gnus
;; Copyright (C) 1995 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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.

;;; Commentary:

;; For an overview of what the interface functions do, please see the
;; Gnus sources.  

;;; Code:

(require 'nnheader)
(require 'rmail)
(require 'nnmail)

(defvar nnmbox-mbox-file (expand-file-name "~/mbox")
  "The name of the mail box file in the user's home directory.")

(defvar nnmbox-active-file (expand-file-name "~/.mbox-active")
  "The name of the active file for the mail box.")

(defvar nnmbox-get-new-mail t
  "If non-nil, nnmbox will check the incoming mail file and split the mail.")

(defvar nnmbox-prepare-save-mail-hook nil
  "Hook run narrowed to an article before saving.")



(defconst nnmbox-version "nnmbox 0.1"
  "nnmbox version.")

(defvar nnmbox-current-group nil
  "Current nnmbox news group directory.")

(defconst nnmbox-mbox-buffer nil)

(defvar nnmbox-status-string "")

(defvar nnmbox-group-alist nil)



(defvar nnmbox-current-server nil)
(defvar nnmbox-server-alist nil)
(defvar nnmbox-server-variables 
  (list
   (list 'nnmbox-mbox-file nnmbox-mbox-file)
   (list 'nnmbox-active-file nnmbox-active-file)
   (list 'nnmbox-get-new-mail nnmbox-get-new-mail)
   '(nnmbox-current-group nil)
   '(nnmbox-status-string "")
   '(nnmbox-group-alist nil)))



;;; Interface functions

(defun nnmbox-retrieve-headers (sequence &optional newsgroup server)
  (save-excursion
    (set-buffer nntp-server-buffer)
    (erase-buffer)
    (let ((file nil)
	  (number (length sequence))
	  (count 0)
	  beg article art-string start stop)
      (nnmbox-possibly-change-newsgroup newsgroup)
      (if (stringp (car sequence))
	  'headers
	(while sequence
	  (setq article (car sequence))
	  (setq art-string (nnmbox-article-string article))
	  (set-buffer nnmbox-mbox-buffer)
	  (if (or (search-forward art-string nil t)
		  (progn (goto-char (point-min))
			 (search-forward art-string nil t)))
	      (progn
		(setq start 
		      (save-excursion
			(re-search-backward 
			 (concat "^" rmail-unix-mail-delimiter) nil t)
			(point)))
		(search-forward "\n\n" nil t)
		(setq stop (1- (point)))
		(set-buffer nntp-server-buffer)
		(insert (format "221 %d Article retrieved.\n" article))
		(setq beg (point))
		(insert-buffer-substring nnmbox-mbox-buffer start stop)
		(goto-char (point-max))
		(insert ".\n")))
	  (setq sequence (cdr sequence))
	  (setq count (1+ count))
	  (and (numberp nnmail-large-newsgroup)
	       (> number nnmail-large-newsgroup)
	       (zerop (% count 20))
	       gnus-verbose-backends
	       (message "nnmbox: Receiving headers... %d%%"
			(/ (* count 100) number))))

	(and (numberp nnmail-large-newsgroup)
	     (> number nnmail-large-newsgroup)
	     gnus-verbose-backends
	     (message "nnmbox: 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 nnmbox-open-server (server &optional defs)
  (nnheader-init-server-buffer)
  (if (equal server nnmbox-current-server)
      t
    (if nnmbox-current-server
	(setq nnmbox-server-alist 
	      (cons (list nnmbox-current-server
			  (nnheader-save-variables nnmbox-server-variables))
		    nnmbox-server-alist)))
    (let ((state (assoc server nnmbox-server-alist)))
      (if state 
	  (progn
	    (nnheader-restore-variables (nth 1 state))
	    (setq nnmbox-server-alist (delq state nnmbox-server-alist)))
	(nnheader-set-init-variables nnmbox-server-variables defs)))
    (setq nnmbox-current-server server)))

(defun nnmbox-close-server (&optional server)
  t)

(defun nnmbox-server-opened (&optional server)
  (and (equal server nnmbox-current-server)
       nnmbox-mbox-buffer
       (buffer-name nnmbox-mbox-buffer)
       nntp-server-buffer
       (buffer-name nntp-server-buffer)))

(defun nnmbox-status-message (&optional server)
  nnmbox-status-string)

(defun nnmbox-request-article (article &optional newsgroup server buffer)
  (nnmbox-possibly-change-newsgroup newsgroup)
  (if (stringp article)
      nil
    (save-excursion
      (set-buffer nnmbox-mbox-buffer)
      (goto-char (point-min))
      (if (search-forward (nnmbox-article-string article) nil t)
	  (let (start stop)
	    (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
	    (setq start (point))
	    (forward-line 1)
	    (or (and (re-search-forward 
		      (concat "^" rmail-unix-mail-delimiter) nil t)
		     (forward-line -1))
		(goto-char (point-max)))
	    (setq stop (point))
	    (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
	      (set-buffer nntp-server-buffer)
	      (erase-buffer)
	      (insert-buffer-substring nnmbox-mbox-buffer start stop)
	      (goto-char (point-min))
	      (while (looking-at "From ")
		(delete-char 5)
		(insert "X-From-Line: ")
		(forward-line 1))
	      t))))))

(defun nnmbox-request-group (group &optional server dont-check)
  (save-excursion
    (if (nnmbox-possibly-change-newsgroup group)
	(if dont-check
	    t
	  (nnmbox-get-new-mail group)
	  (save-excursion
	    (set-buffer nntp-server-buffer)
	    (erase-buffer)
	    (let ((active (assoc group nnmbox-group-alist)))
	      (insert (format "211 %d %d %d %s\n" 
			      (1+ (- (cdr (car (cdr active)))
				     (car (car (cdr active)))))
			      (car (car (cdr active)))
			      (cdr (car (cdr active)))
			      (car active))))
	    t)))))

(defun nnmbox-close-group (group &optional server)
  t)

(defun nnmbox-request-list (&optional server)
  (if server (nnmbox-get-new-mail))
  (save-excursion
    (or (nnmail-find-file nnmbox-active-file)
	(progn
	  (setq nnmbox-group-alist (nnmail-get-active))
	  (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
	  (nnmail-find-file nnmbox-active-file)))))

(defun nnmbox-request-newgroups (date &optional server)
  (nnmbox-request-list server))

(defun nnmbox-request-list-newsgroups (&optional server)
  (setq nnmbox-status-string "nnmbox: LIST NEWSGROUPS is not implemented.")
  nil)

(defun nnmbox-request-post (&optional server)
  (mail-send-and-exit nil))

(defalias 'nnmbox-request-post-buffer 'nnmail-request-post-buffer)

(defun nnmbox-request-expire-articles 
  (articles newsgroup &optional server force)
  (nnmbox-possibly-change-newsgroup newsgroup)
  (let* ((days (or (and nnmail-expiry-wait-function
			(funcall nnmail-expiry-wait-function newsgroup))
		   nnmail-expiry-wait))
	 article rest)
    (save-excursion 
      (set-buffer nnmbox-mbox-buffer)
      (while articles
	(goto-char (point-min))
	(if (search-forward (nnmbox-article-string (car articles)) nil t)
	    (if (or force
		    (> (nnmail-days-between 
			(current-time-string)
			(buffer-substring 
			 (point) (progn (end-of-line) (point))))
		       days))
		(progn
		  (and gnus-verbose-backends
		       (message "Deleting: %s" (car articles)))
		  (nnmbox-delete-mail))
	      (setq rest (cons (car articles) rest))))
	(setq articles (cdr articles)))
      (save-buffer)
      ;; Find the lowest active article in this group.
      (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
	(goto-char (point-min))
	(while (and (not (search-forward
			  (nnmbox-article-string (car active)) nil t))
		    (<= (car active) (cdr active)))
	  (setcar active (1+ (car active)))
	  (goto-char (point-min))))
      (nnmail-save-active nnmbox-g