;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; 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
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.
;;; Code:
(require 'nnheader)
-(require 'rmail)
+(require 'message)
(require 'nnmail)
+(require 'nnoo)
+(require 'gnus-range)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnmbox)
-(defvar nnmbox-mbox-file (expand-file-name "~/mbox")
+(defvoo 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")
+(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active")
"The name of the active file for the mail box.")
-(defvar nnmbox-get-new-mail t
+(defvoo 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
+(defvoo nnmbox-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
\f
(defconst nnmbox-version "nnmbox 1.0"
"nnmbox version.")
-(defvar nnmbox-current-group nil
+(defvoo nnmbox-current-group nil
"Current nnmbox news group directory.")
-(defconst nnmbox-mbox-buffer nil)
+(defvar nnmbox-mbox-buffer nil)
-(defvar nnmbox-status-string "")
+(defvoo nnmbox-status-string "")
-(defvar nnmbox-group-alist nil)
-(defvar nnmbox-active-timestamp nil)
-
-\f
+(defvoo nnmbox-group-alist nil)
+(defvoo nnmbox-active-timestamp 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)))
+(defvoo nnmbox-file-coding-system mm-binary-coding-system)
+(defvoo nnmbox-file-coding-system-for-write nil)
+(defvoo nnmbox-active-file-coding-system mm-binary-coding-system)
+(defvoo nnmbox-active-file-coding-system-for-write nil)
+(defvar nnmbox-group-building-active-articles nil)
+(defvar nnmbox-group-active-articles nil)
\f
;;; Interface functions
-(defun nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
+(nnoo-define-basics nnmbox)
+
+(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(let ((number (length sequence))
(count 0)
- article art-string start stop)
- (nnmbox-possibly-change-newsgroup newsgroup)
+ article start stop)
+ (nnmbox-possibly-change-newsgroup newsgroup server)
(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))
- (insert-buffer-substring nnmbox-mbox-buffer start stop)
- (goto-char (point-max))
- (insert ".\n")))
+ (when (nnmbox-find-article article)
+ (setq start
+ (save-excursion
+ (re-search-backward
+ (concat "^" message-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))
+ (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))
(nnheader-message 5 "nnmbox: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
(nnheader-fold-continuation-lines)
'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)
- (setq nnmbox-current-server nil)
+(deffoo nnmbox-open-server (server &optional defs)
+ (nnoo-change-server 'nnmbox server defs)
+ (nnmbox-create-mbox)
projects / gnus / blobdiff