1 ;;; nnbabyl.el --- rmail mbox access for Gnus
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000
4 ;; Free Software Foundation, Inc.
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8 ;; Keywords: news, mail
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;; For an overview of what the interface functions do, please see the
38 5 "Ignore rmail errors from this file, you don't have rmail")))
41 (eval-when-compile (require 'cl))
43 (nnoo-declare nnbabyl)
45 (defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
46 "The name of the rmail box file in the users home directory.
48 This variable is a virtual server slot. See the Gnus manual for details.")
50 (defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
51 "The name of the active file for the rmail box.
53 This variable is a virtual server slot. See the Gnus manual for details.")
55 (defvoo nnbabyl-get-new-mail t
56 "If non-nil, nnbabyl will check the incoming mail file and split the mail.
58 This variable is a virtual server slot. See the Gnus manual for details.")
61 (defvoo nnbabyl-prepare-save-mail-hook nil
62 "Hook run narrowed to an article before saving.
64 This variable is a virtual server slot. See the Gnus manual for details.")
68 (defvar nnbabyl-mail-delimiter "\^_")
70 (defconst nnbabyl-version "nnbabyl 1.0"
73 (defvoo nnbabyl-mbox-buffer nil)
74 (defvoo nnbabyl-current-group nil)
75 (defvoo nnbabyl-status-string "")
76 (defvoo nnbabyl-group-alist nil)
77 (defvoo nnbabyl-active-timestamp nil)
79 (defvoo nnbabyl-previous-buffer-mode nil)
82 (autoload 'gnus-set-text-properties "gnus-ems"))
86 ;;; Interface functions
88 (nnoo-define-basics nnbabyl)
90 (deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
92 (set-buffer nntp-server-buffer)
94 (let ((number (length articles))
96 (delim (concat "^" nnbabyl-mail-delimiter))
97 article art-string start stop)
98 (nnbabyl-possibly-change-newsgroup group server)
99 (while (setq article (pop articles))
100 (setq art-string (nnbabyl-article-string article))
101 (set-buffer nnbabyl-mbox-buffer)
103 (when (or (search-forward art-string nil t)
104 (search-backward art-string nil t))
105 (unless (re-search-backward delim nil t)
106 (goto-char (point-min)))
107 (while (and (not (looking-at ".+:"))
108 (zerop (forward-line 1))))
110 (search-forward "\n\n" nil t)
111 (setq stop (1- (point)))
112 (set-buffer nntp-server-buffer)
114 (princ article (current-buffer))
115 (insert " Article retrieved.\n")
116 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
117 (goto-char (point-max))
119 (and (numberp nnmail-large-newsgroup)
120 (> number nnmail-large-newsgroup)
121 (zerop (% (incf count) 20))
122 (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
123 (/ (* count 100) number))))
125 (and (numberp nnmail-large-newsgroup)
126 (> number nnmail-large-newsgroup)
127 (nnheader-message 5 "nnbabyl: Receiving headers...done"))
129 (set-buffer nntp-server-buffer)
130 (nnheader-fold-continuation-lines)
133 (deffoo nnbabyl-open-server (server &optional defs)
134 (nnoo-change-server 'nnbabyl server defs)
135 (nnbabyl-create-mbox)
137 ((not (file-exists-p nnbabyl-mbox-file))
138 (nnbabyl-close-server)
139 (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
140 ((file-directory-p nnbabyl-mbox-file)
141 (nnbabyl-close-server)
142 (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
144 (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
148 (deffoo nnbabyl-close-server (&optional server)
149 ;; Restore buffer mode.
150 (when (and (nnbabyl-server-opened)
151 nnbabyl-previous-buffer-mode)
153 (set-buffer nnbabyl-mbox-buffer)
155 (caar nnbabyl-previous-buffer-mode)
156 (cdar nnbabyl-previous-buffer-mode))
157 (funcall (cdr nnbabyl-previous-buffer-mode))))
158 (nnoo-close-server 'nnbabyl server)
159 (setq nnbabyl-mbox-buffer nil)
162 (deffoo nnbabyl-server-opened (&optional server)
163 (and (nnoo-current-server-p 'nnbabyl server)
165 (buffer-name nnbabyl-mbox-buffer)
167 (buffer-name nntp-server-buffer)))
169 (deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
170 (nnbabyl-possibly-change-newsgroup newsgroup server)
172 (set-buffer nnbabyl-mbox-buffer)
173 (goto-char (point-min))
174 (when (search-forward (nnbabyl-article-string article) nil t)
175 (let (start stop summary-line)
176 (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
177 (goto-char (point-min))
179 (while (and (not (looking-at ".+:"))
180 (zerop (forward-line 1))))
182 (or (when (re-search-forward
183 (concat "^" nnbabyl-mail-delimiter) nil t)
186 (goto-char (point-max)))
188 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
189 (set-buffer nntp-server-buffer)
191 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
192 (goto-char (point-min))
193 ;; If there is an EOOH header, then we have to remove some
194 ;; duplicated headers.
195 (setq summary-line (looking-at "Summary-line:"))
196 (when (search-forward "\n*** EOOH ***" nil t)
198 ;; The headers to be deleted are located before the
200 (delete-region (point-min) (progn (forward-line 1)
203 (delete-region (progn (beginning-of-line) (point))
204 (or (search-forward "\n\n" nil t)
206 (if (numberp article)
207 (cons nnbabyl-current-group article)
208 (nnbabyl-article-group-number)))))))