1 ;;; nnbabyl.el --- rmail mbox access for Gnus
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003,
4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 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 3 of the License, or
15 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
27 ;; For an overview of what the interface functions do, please see the
35 (error (nnheader-message
36 5 "Ignore rmail errors from this file, you don't have rmail")))
39 (eval-when-compile (require 'cl))
41 (nnoo-declare nnbabyl)
43 (defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
44 "The name of the rmail box file in the users home directory.")
46 (defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
47 "The name of the active file for the rmail box.")
49 (defvoo nnbabyl-get-new-mail t
50 "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
53 (defvoo nnbabyl-prepare-save-mail-hook nil
54 "Hook run narrowed to an article before saving.")
58 (defvar nnbabyl-mail-delimiter "\^_")
60 (defconst nnbabyl-version "nnbabyl 1.0"
63 (defvoo nnbabyl-mbox-buffer nil)
64 (defvoo nnbabyl-current-group nil)
65 (defvoo nnbabyl-status-string "")
66 (defvoo nnbabyl-group-alist nil)
67 (defvoo nnbabyl-active-timestamp nil)
69 (defvoo nnbabyl-previous-buffer-mode nil)
73 ;;; Interface functions
75 (nnoo-define-basics nnbabyl)
77 (deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
78 (with-current-buffer nntp-server-buffer
80 (let ((number (length articles))
82 (delim (concat "^" nnbabyl-mail-delimiter))
83 article art-string start stop)
84 (nnbabyl-possibly-change-newsgroup group server)
85 (while (setq article (pop articles))
86 (setq art-string (nnbabyl-article-string article))
87 (set-buffer nnbabyl-mbox-buffer)
89 (when (or (search-forward art-string nil t)
90 (search-backward art-string nil t))
91 (unless (re-search-backward delim nil t)
92 (goto-char (point-min)))
93 (while (and (not (looking-at ".+:"))
94 (zerop (forward-line 1))))
96 (search-forward "\n\n" nil t)
97 (setq stop (1- (point)))
98 (set-buffer nntp-server-buffer)
100 (princ article (current-buffer))
101 (insert " Article retrieved.\n")
102 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
103 (goto-char (point-max))
105 (and (numberp nnmail-large-newsgroup)
106 (> number nnmail-large-newsgroup)
107 (zerop (% (incf count) 20))
108 (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
109 (/ (* count 100) number))))
111 (and (numberp nnmail-large-newsgroup)
112 (> number nnmail-large-newsgroup)
113 (nnheader-message 5 "nnbabyl: Receiving headers...done"))
115 (set-buffer nntp-server-buffer)
116 (nnheader-fold-continuation-lines)
119 (deffoo nnbabyl-open-server (server &optional defs)
120 (nnoo-change-server 'nnbabyl server defs)
121 (nnbabyl-create-mbox)
123 ((not (file-exists-p nnbabyl-mbox-file))
124 (nnbabyl-close-server)
125 (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
126 ((file-directory-p nnbabyl-mbox-file)
127 (nnbabyl-close-server)
128 (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
130 (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
134 (deffoo nnbabyl-close-server (&optional server)
135 ;; Restore buffer mode.
136 (when (and (nnbabyl-server-opened)
137 nnbabyl-previous-buffer-mode)
138 (with-current-buffer nnbabyl-mbox-buffer
140 (caar nnbabyl-previous-buffer-mode)
141 (cdar nnbabyl-previous-buffer-mode))
142 (funcall (cdr nnbabyl-previous-buffer-mode))))
143 (nnoo-close-server 'nnbabyl server)
144 (setq nnbabyl-mbox-buffer nil)
147 (deffoo nnbabyl-server-opened (&optional server)
148 (and (nnoo-current-server-p 'nnbabyl server)
150 (buffer-name nnbabyl-mbox-buffer)
152 (buffer-name nntp-server-buffer)))
154 (deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
155 (nnbabyl-possibly-change-newsgroup newsgroup server)
156 (with-current-buffer nnbabyl-mbox-buffer
157 (goto-char (point-min))
158 (when (search-forward (nnbabyl-article-string article) nil t)
159 (let (start stop summary-line)
160 (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
161 (goto-char (point-min))
163 (while (and (not (looking-at ".+:"))
164 (zerop (forward-line 1))))
166 (or (when (re-search-forward
167 (concat "^" nnbabyl-mail-delimiter) nil t)
170 (goto-char (point-max)))
172 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
173 (set-buffer nntp-server-buffer)
175 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
176 (goto-char (point-min))
177 ;; If there is an EOOH header, then we have to remove some
178 ;; duplicated headers.
179 (setq summary-line (looking-at "Summary-line:"))
180 (when (search-forward "\n*** EOOH ***" nil t)
182 ;; The headers to be deleted are located before the
184 (delete-region (point-min) (progn (forward-line 1)
187 (delete-region (progn (beginning-of-line) (point))
188 (or (search-forward "\n\n" nil t)
190 (if (numberp article)
191 (cons nnbabyl-current-group article)
192 (nnbabyl-article-group-number)))))))
194 (deffoo nnbabyl-request-group (group &optional server dont-check info)
195 (let ((active (cadr (assoc group nnbabyl-group-alist))))
199 (null (nnbabyl-possibly-change-newsgroup group server)))
200 (nnheader-report 'nnbabyl "No such group: %s" group))
202 (nnheader-report 'nnbabyl "Selected group %s" group)
203 (nnheader-insert ""))
205 (nnheader-report 'nnbabyl "Selected group %s" group)
206 (nnheader-insert "211 %d %d %d %s\n"
207 (1+ (- (cdr active) (car active)))
208 (car active) (cdr active) group))))))
210 (deffoo nnbabyl-request-scan (&optional group server)
211 (nnbabyl-possibly-change-newsgroup group server)
216 (with-current-buffer nnbabyl-mbox-buffer
218 (file-name-directory nnbabyl-mbox-file)
222 (let ((in-buf (current-buffer)))
223 (goto-char (point-min))
224 (while (search-forward "\n\^_\n" nil t)
226 (set-buffer nnbabyl-mbox-buffer)
227 (goto-char (point-max))
228 (search-backward "\n\^_" nil t)
229 (goto-char (match-end 0))
230 (insert-buffer-substring in-buf)))
231 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
233 (deffoo nnbabyl-close-group (group &optional server)
236 (deffoo nnbabyl-request-create-group (group &optional server args)
237 (nnmail-activate 'nnbabyl)