1 ;;; nnmbox.el --- mail mbox access for Gnus
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news, mail
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
32 (defvar nnmbox-mbox-file (expand-file-name "~/mbox")
33 "The name of the mail box file in the users home directory.")
35 (defvar nnmbox-active-file (expand-file-name "~/.mbox-active")
36 "The name of the active file for the mail box.")
38 (defvar nnmbox-get-new-mail t
39 "If non-nil, nnml will check the incoming mail file and split the mail.")
43 (defconst nnmbox-version "nnmbox 0.1"
46 (defvar nnmbox-current-group nil
47 "Current nnmbox news group directory.")
49 (defconst nnmbox-mbox-buffer " *nnmbox mbox buffer*")
51 (defvar nnmbox-status-string "")
53 (defvar nnmbox-group-alist nil)
55 ;;; Interface functions
57 (defun nnmbox-retrieve-headers (sequence &optional newsgroup server)
58 "Retrieve the headers for the articles in SEQUENCE.
59 Newsgroup must be selected before calling this function."
61 (set-buffer nntp-server-buffer)
64 (number (length sequence))
66 beg article art-string start stop)
67 (nnmbox-possibly-change-newsgroup newsgroup)
69 (setq article (car sequence))
70 (setq art-string (nnmbox-article-string article))
71 (set-buffer nnmbox-mbox-buffer)
72 (if (or (search-forward art-string nil t)
74 (search-forward art-string nil t)))
79 (concat "^" rmail-unix-mail-delimiter) nil t)
81 (search-forward "\n\n" nil t)
82 (setq stop (1- (point)))
83 (set-buffer nntp-server-buffer)
84 (insert (format "221 %d Article retrieved.\n" article))
86 (insert-buffer-substring nnmbox-mbox-buffer start stop)
87 (goto-char (point-max))
89 (setq sequence (cdr sequence))
90 (setq count (1+ count))
91 (and (numberp nnmail-large-newsgroup)
92 (> number nnmail-large-newsgroup)
95 (message "nnmbox: Receiving headers... %d%%"
96 (/ (* count 100) number))))
98 (and (numberp nnmail-large-newsgroup)
99 (> number nnmail-large-newsgroup)
100 gnus-verbose-backends
101 (message "nnmbox: Receiving headers... done"))
103 ;; Fold continuation lines.
105 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
106 (replace-match " " t t))
109 (defun nnmbox-open-server (host &optional service)
111 (setq nnmbox-status-string "")
112 (setq nnmbox-group-alist nil)
113 (nnheader-init-server-buffer))
115 (defun nnmbox-close-server (&optional server)
119 (defun nnmbox-server-opened (&optional server)
120 "Return server process status, T or NIL.
121 If the stream is opened, return T, otherwise return NIL."
122 (and nntp-server-buffer
123 (get-buffer nntp-server-buffer)))
125 (defun nnmbox-status-message (&optional server)
126 "Return server status response as string."
127 nnmbox-status-string)
129 (defun nnmbox-request-article (article &optional newsgroup server buffer)
130 "Select ARTICLE by number."
131 (nnmbox-possibly-change-newsgroup newsgroup)
132 (if (stringp article)
135 (set-buffer nnmbox-mbox-buffer)
137 (if (search-forward (nnmbox-article-string article) nil t)
139 (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
142 (or (and (re-search-forward
143 (concat "^" rmail-unix-mail-delimiter) nil t)
145 (goto-char (point-max)))
147 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
148 (set-buffer nntp-server-buffer)
150 (insert-buffer-substring nnmbox-mbox-buffer start stop)
151 (goto-char (point-min))
152 (while (looking-at "From ")
154 (insert "X-From-Line: ")
158 (defun nnmbox-request-group (group &optional server dont-check)
161 (if (nnmbox-possibly-change-newsgroup group)
164 (nnmbox-get-new-mail)
166 (set-buffer nntp-server-buffer)
168 (let ((active (assoc group nnmbox-group-alist)))
169 (insert (format "211 %d %d %d %s\n"
170 (1+ (- (cdr (car (cdr active)))
171 (car (car (cdr active)))))
172 (car (car (cdr active)))
173 (cdr (car (cdr active)))
177 (defun nnmbox-close-group (group &optional server)
180 (defun nnmbox-request-list (&optional server)
181 "List active newsgoups."
182 (if server (nnmbox-get-new-mail))
183 (or (nnmail-find-file nnmbox-active-file)
185 (setq nnmbox-group-alist (nnmail-get-active))
186 (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
187 (nnmail-find-file nnmbox-active-file))))
189 (defun nnmbox-request-newgroups (date &optional server)
190 "List groups created after DATE."
191 (nnmbox-request-list server))
193 (defun nnmbox-request-list-newsgroups (&optional server)
194 "List newsgroups (defined in NNTP2)."
195 (setq nnmbox-status-string "nnmbox: LIST NEWSGROUPS is not implemented.")
198 (defun nnmbox-request-post (&optional server)
199 "Post a new news in current buffer."
200 (mail-send-and-exit nil))
202 (fset 'nnmbox-request-post-buffer 'nnmail-request-post-buffer)
204 (defun nnmbox-request-expire-articles (articles newsgroup &optional server force)
205 "Expire all articles in the ARTICLES list in group GROUP.
206 The list of unexpired articles will be returned (ie. all articles that
207 were too fresh to be expired).
208 If FORCE is non-nil, the ARTICLES will be deleted without looking at
210 (nnmbox-possibly-change-newsgroup newsgroup)
211 (let* ((days (or (and nnmail-expiry-wait-function
212 (funcall nnmail-expiry-wait-function newsgroup))
216 (set-buffer nnmbox-mbox-buffer)
219 (if (search-forward (nnmbox-article-string (car articles)) nil t)
221 (> (nnmail-days-between
222 (current-time-string)
224 (point) (progn (end-of-line) (point))))
227 (and gnus-verbose-backends
228 (message "Deleting: %s" (car articles)))
229 (nnmbox-delete-mail))
230 (setq rest (cons (car articles) rest))))
231 (setq articles (cdr articles)))
235 (defun nnmbox-request-move-article
236 (article group server accept-form &optional last)
237 (nnmbox-possibly-change-newsgroup group)
238 (let ((buf (get-buffer-create " *nnmbox move*"))
241 (nnmbox-request-article article group server)
244 (buffer-disable-undo (current-buffer))
246 (insert-buffer-substring nntp-server-buffer)
247 (goto-char (point-min))
248 (while (re-search-forward
250 (save-excursion (search-forward "\n\n" nil t) (point)) t)
251 (delete-region (progn (beginning-of-line) (point))
252 (progn (forward-line 1) (point))))
253 (setq result (eval accept-form))
257 (set-buffer nnmbox-mbox-buffer)
259 (if (search-forward (nnmbox-article-string article) nil t)
260 (nnmbox-delete-mail))
261 (and last (save-buffer))))
264 (defun nnmbox-request-accept-article (group &optional last)
265 (let ((buf (current-buffer))
267 (debug (current-buffer))
268 (goto-char (point-min))
269 (if (looking-at "X-From-Line: ")
270 (replace-match "From ")
271 (insert "From nobody " (current-time-string) "\n"))
273 (nnmbox-request-list)
274 (setq nnmbox-group-alist (nnmail-get-active))
277 (goto-char (point-min))
278 (search-forward "\n\n" nil t)
280 (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
281 (delete-region (point) (progn (forward-line 1) (point))))
282 (setq result (nnmbox-save-mail (and (stringp group) group))))
284 (set-buffer nnmbox-mbox-buffer)
285 (insert-buffer-substring buf)
286 (and last (save-buffer))
288 (nnmail-save-active nnmbox-group-alist nnmbox-active-file))
291 (defun nnmbox-request-replace-article (article group buffer)
292 (nnmbox-possibly-change-newsgroup group)
294 (set-buffer nnmbox-mbox-buffer)
296 (if (not (search-forward (nnmbox-article-string article) nil t))
298 (nnmbox-delete-mail t t)
299 (insert-buffer-substring buffer)
304 ;;; Internal functions.
306 (defun nnmbox-delete-mail (&optional force leave-delim)
307 "If FORCE, delete article no matter how many X-Gnus-Newsgroup
308 headers there are. If LEAVE-DELIM, don't delete the Unix mbox
310 ;; Delete the current X-Gnus-Newsgroup line.
313 (progn (beginning-of-line) (point))
314 (progn (forward-line 1) (point))))
315 ;; Beginning of the article.
320 (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
321 (if leave-delim (progn (forward-line 1) (point))
322 (match-beginning 0)))
325 (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter)
327 (if (and (not (bobp)) leave-delim)
328 (progn (forward-line -2) (point))
329 (match-beginning 0)))
331 (goto-char (point-min))
332 ;; Only delete the article if no other groups owns it as well.
333 (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
334 (delete-region (point-min) (point-max))))))
336 (defun nnmbox-possibly-change-newsgroup (newsgroup)
337 (if (not (get-buffer nnmbox-mbox-buffer))
339 (set-buffer (setq nnmbox-mbox-buffer
340 (find-file-noselect nnmbox-mbox-file)))
341 (buffer-disable-undo (current-buffer))))
342 (if (not nnmbox-group-alist)
344 (nnmbox-request-list)
345 (setq nnmbox-group-alist (nnmail-get-active))))
347 (if (assoc newsgroup nnmbox-group-alist)
348 (setq nnmbox-current-group newsgroup))))
350 (defun nnmbox-article-string (article)
351 (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"
352 (int-to-string article) " "))
354 (defun nnmbox-save-mail (&optional group)
355 "Called narrowed to an article."
356 (let* ((nnmail-split-methods
357 (if group (list (list group "")) nnmail-split-methods))
358 (group-art (nreverse (nnmail-article-group 'nnmbox-active-number))))
359 (nnmail-insert-lines)
360 (nnmail-insert-xref group-art)
361 (nnmbox-insert-newsgroup-line group-art)
364 (defun nnmbox-insert-newsgroup-line (group-art)
366 (goto-char (point-min))
367 (if (search-forward "\n\n" nil t)
371 (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
372 (car (car group-art)) (cdr (car group-art))
373 (current-time-string)))
374 (setq group-art (cdr group-art)))))
377 (defun nnmbox-active-number (group)
378 "Find the next article number in GROUP."
379 (let ((active (car (cdr (assoc group nnmbox-group-alist)))))
380 (setcdr active (1+ (cdr active)))
383 (defun nnmbox-read-mbox ()
384 (nnmbox-request-list)
385 (setq nnmbox-group-alist (nnmail-get-active))
386 (if (not (file-exists-p nnmbox-mbox-file))
387 (write-region 1 1 nnmbox-mbox-file t 'nomesg))
388 (if (and nnmbox-mbox-buffer
389 (get-buffer nnmbox-mbox-buffer)
390 (buffer-name nnmbox-mbox-buffer)
392 (set-buffer nnmbox-mbox-buffer)
393 (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file)))))
396 (let ((delim (concat "^" rmail-unix-mail-delimiter))
398 (set-buffer (setq nnmbox-mbox-buffer
399 (find-file-noselect nnmbox-mbox-file)))
400 (buffer-disable-undo (current-buffer))
401 (goto-char (point-min))
402 (while (re-search-forward delim nil t)
403 (setq start (match-beginning 0))
404 (if (not (search-forward "\nX-Gnus-Newsgroup: "
409 (re-search-forward delim nil t)
415 (narrow-to-region start end)
416 (nnmbox-save-mail))))
419 (defun nnmbox-get-new-mail ()
422 (if (and nnmail-spool-file nnmbox-get-new-mail
423 (file-exists-p nnmail-spool-file)
424 (> (nth 7 (file-attributes nnmail-spool-file)) 0))
426 (and gnus-verbose-backends
427 (message "nnmbox: Reading incoming mail..."))
429 (nnmail-move-inbox nnmail-spool-file
430 (concat nnmbox-mbox-file "-Incoming")))
432 (let ((in-buf (nnmail-split-incoming
433 incoming 'nnmbox-save-mail t)))
434 (set-buffer nnmbox-mbox-buffer)
435 (goto-char (point-max))
436 (insert-buffer-substring in-buf)
437 (kill-buffer in-buf)))
438 (run-hooks 'nnmail-read-incoming-hook)
439 (and gnus-verbose-backends
440 (message "nnmbox: Reading incoming mail...done"))))
441 (and (buffer-modified-p nnmbox-mbox-buffer)
443 (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
444 (set-buffer nnmbox-mbox-buffer)
447 ; (delete-file incoming))
452 ;;; nnmbox.el ends here