view lisp/gnus/nnbabyl.el @ 47576:b31c8ab7336a

Sync with version 2.0.20. Lengthy ChangeLog follows: 2002-09-22 Kai Gro?ohann <grossjoh@ls6.informatik.uni-dortmund.de> Version 2.0.20 released. 2002-09-20 Kai Gro?ohann <grossjoh@ls6.informatik.uni-dortmund.de> * net/tramp.el (tramp-completion-function-alist): Escape open paren in docstring. (tramp-user-regexp, tramp-host-regexp): Allow empty strings. (tramp-handle-insert-file-contents): Call tramp-message-for-buffer instead of tramp-message. (tramp-open-connection-rsh): Handle empty string as user name. (tramp-open-connection-su): Handle empty string as host name. Handle nil user name. (tramp-handle-file-local-copy, tramp-handle-write-region) (tramp-completion-handle-file-name-all-completions) (tramp-open-connection-telnet, tramp-open-connection-rsh) (tramp-open-connection-su, tramp-post-connection) (tramp-maybe-open-connection, tramp-method-out-of-band-p) (tramp-get-connection-function, tramp-get-remote-sh) (tramp-get-rsh-program, tramp-get-rsh-args) (tramp-get-rcp-program, tramp-get-rcp-args) (tramp-get-rcp-keep-date-arg, tramp-get-su-program) (tramp-get-su-args, tramp-get-telnet-program) (tramp-get-telnet-args): Use `tramp-find-method', perhaps require additional args USER, HOST. (tramp-action-password, tramp-open-connection-telnet) (tramp-open-connection-su, tramp-open-connection-multi) (tramp-method-out-of-band-p): `tramp-method-out-of-band-p' now takes USER and HOST arguments, to be able to use `tramp-find-method'. Update callers. (tramp-find-method): New function. 2002-09-20 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-insert-directory): Handle "--dired" in SWITCHES (by removing it). 2002-09-18 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-file-name-handler): Add `file-remote-p' property. 2002-09-17 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (top-level): Maybe autoload uudecode-decode-region. 2002-09-16 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-bug): Add tramp-methods. 2002-09-16 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-methods): Update docstring: tramp-encoding-command, tramp-decoding-command, tramp-encoding-function and tramp-decoding-function are not parameters anymore. (tramp-uuencode-region): Autoload it. 2002-09-13 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> Version 2.0.19 released. * net/tramp-uu.el: New file, implements uuencode in Lisp. * net/tramp.el (tramp-coding-commands): Use `tramp-uuencode-region' as local encoder for the uuencode based entries. 2002-09-13 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-write-region): Wrong parens. 2002-09-13 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> Version 2.0.18 released. * net/tramp.el (tramp-perl-decode): Perl changes to accomodate older versions of Perl. Now tested with 5.004. Suggestion from Michael Albinus. 2002-09-12 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-find-inline-encoding): Call tramp-call-local-coding-command with nil for INPUT and OUTPUT. (tramp-call-local-coding-command): OUTPUT equals nil means to discard the output. INPUT equals nil means /dev/null. 2002-09-12 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-encoding-shell): Default to environment variable COMSPEC on Windows. (tramp-handle-write-region): More debugging output. (tramp-find-inline-encoding): Ditto. 2002-09-11 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-handle-file-name-all-completions): Define `result1'. (tramp-parse-hosts-group): Discard IPv6 entries. 2002-09-11 Kai Gro?ohann <grossjoh@ls6.informatik.uni-dortmund.de> * net/tramp.el (tramp-post-connection): Only send Perl mime-encode/decode implementations when using inline method. (tramp-handle-file-local-copy) (tramp-handle-write-region, tramp-post-connection) (tramp-coding-commands, tramp-find-inline-encoding): For the inline encodings, distinguish between local and remote commands, instead of between commands and functions. (The local commands can be functions, too.) If the local host is a Windows machine, we can't expect the same commands to work there as on the remote host. (tramp-call-local-coding-command): New function for calling local encoding and decoding commands. (tramp-set-remote-encoding, tramp-get-remote-encoding) (tramp-set-remote-decoding, tramp-get-remote-decoding) (tramp-set-local-encoding, tramp-get-local-encoding) (tramp-set-local-decoding, tramp-get-local-decoding): New functions. (tramp-get-encoding-command, tramp-set-encoding-command) (tramp-get-decoding-command, tramp-set-decoding-command) (tramp-get-encoding-function, tramp-set-encoding-function) (tramp-get-decoding-function, tramp-set-decoding-function): Old functions, removed. 2002-09-10 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-open-connection-setup-interactive-shell): Change command to invoke /bin/sh slightly to make it compatible with the `rc' shell. Suggested by Daniel Pittman. 2002-09-10 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-handle-write-region): Added missing `)'. Hope it's the right place. 2002-09-09 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-open-connection-setup-interactive-shell): Do "exec env PS1='$ ' /bin/sh" instead of just "exec /bin/sh" in order to get a sane shell prompt. If people have ${CWD}, say, in their shell prompt, then the default login shell might display something harmless, but the /bin/sh will display a dollar sign which confused the subsequent prompt recognition. (tramp-multi-action-password): More debugging output. (tramp-encoding-shell): Renamed from tramp-sh-program. More documentation. Default to cmd.exe on Windows NT. (tramp-encoding-command-switch): New variable. Use instead of hard-wired "-c" which is only good for /bin/sh. (tramp-encoding-reads-stdin): New variable. If t, commands are called like "/bin/sh -c COMMAND <INPUT", if nil, they are called like "/bin/sh -c COMMAND INPUT", ie the input file is the last argument. (tramp-multi-sh-program): Always default to tramp-encoding-shell. (tramp-handle-file-local-copy, tramp-handle-write-region): Respect tramp-encoding-shell and friends. (tramp-find-inline-encoding): Use new-style calls for checking if the local commands work. 2002-09-07 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-methods): Remove `tramp-completion-function' entries. They are handled now by `tramp-completion-function-alist'. (tramp-completion-function): Defvar removed. I've never used it. Hmm. (tramp-get-completion-function) (tramp-get-completion-rsh, tramp-get-completion-ssh) (tramp-get-completion-telnet, tramp-get-completion-su): Functions removed as well. Not necessary any longer due to extended customization means. (tramp-completion-function-alist): New defcustom. Holds all FUNCTION FILE pairs used for user and host name completion relevant for METHOD. (tramp-completion-function-alist-rsh) (tramp-completion-function-alist-ssh) (tramp-completion-function-alist-telnet) (tramp-completion-function-alist-su): Defconst for initializing `tramp-completion-function-alist'. Unfortunately, mainly UNIX-like values are known for me until now. Needs to be completed for at least VMS++ like operating systems. (tramp-set-completion-function) (tramp-get-completion-function): New functions for configuration of `tramp-completion-function-alist'. The old definition of `tramp-get-completion-function' has been discarded. (tramp-completion-handle-file-name-all-completions): Change function call for user/host completion according to definition in `tramp-completion-function-alist'. (tramp-parse-passwd): Added exception handling for "root", because `tramp-get-completion-su' (the previous place for this stuff) doesn't exist any longer. 2002-09-07 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-enter-password): Use `tramp-password-end-of-line' to terminate the line. (tramp-bug): Include new variable `tramp-password-end-of-line'. (tramp-password-end-of-line): New variable. People who use plink under Windows might have to issue "\r\n" after the password, but they need to send just "\n" after the other commands. So this variable was introduced to complement `tramp-rsh-end-of-line'. (tramp-wait-for-output, tramp-post-connection): Allow "\r" at end of line of the output delimiter. 2002-09-06 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-file-local-copy, tramp-find-shell) (tramp-open-connection-setup-interactive-shell): Add some comments about Douglas Grey Stephen's suggestions to make Tramp work better with plink under Windows. I'm not sure what to think of them, but now I have a guinea pig to try it out on. Said guinea pig is having other problems, though... Also remove some commented-out code. 2002-09-06 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-methods): Algorithm slightly tuned. (tramp-get-completion-user-host): Accept user names as they are if typed until "@". (tramp-completion-mode): Replace `last-input-char' by modern `last-input-event'. Check for `event-modifiers'. 2002-09-06 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (file-expand-wildcards): Corrected check to see if advising is necessary. 2002-09-05 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-postfix-single-method-format) (tramp-postfix-multi-method-format) (tramp-postfix-multi-hop-format) (tramp-postfix-user-format): New format strings. (tramp-postfix-single-method-regexp) (tramp-postfix-multi-method-regexp) (tramp-postfix-multi-hop-regexp) (tramp-postfix-user-regexp) (tramp-make-multi-tramp-file-format) (tramp-make-tramp-file-name): Apply them. (tramp-completion-handle-file-name-all-completions): Fix for invoking ange-ftp in case of "/ftp:xxx" file names. 2002-09-04 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-prefix-format) (tramp-postfix-host-format): New format strings. (tramp-prefix-regexp, tramp-method-regexp) (tramp-postfix-single-method-regexp) (tramp-postfix-multi-method-regexp) (tramp-postfix-multi-hop-regexp) (tramp-user-regexp, tramp-postfix-user-regexp) (tramp-host-regexp, tramp-postfix-host-regexp) (tramp-path-regexp): New atomar regular expressions. If corresponding format strings exist, derived from them. (tramp-file-name-structure) (tramp-multi-file-name-structure) (tramp-multi-file-name-hop-structure) (tramp-make-multi-tramp-file-format) (tramp-completion-mode) (tramp-completion-dissect-file-name) (tramp-parse-rhosts-group) (tramp-parse-shosts-group) (tramp-parse-hosts-group) (tramp-parse-passwd-group): Apply these expressions. (tramp-file-name-structure-unified) (tramp-file-name-structure-separate) (tramp-make-tramp-file-format-unified) (tramp-make-tramp-file-format-separate) (tramp-make-tramp-file-format) (tramp-make-tramp-file-user-nil-format-unified) (tramp-make-tramp-file-user-nil-format-separate) (tramp-make-tramp-file-user-nil-format) (tramp-multi-file-name-structure-unified) (tramp-multi-file-name-structure-separate) (tramp-multi-file-name-hop-structure-unified) (tramp-multi-file-name-hop-structure-separate) (tramp-make-multi-tramp-file-format-unified) (tramp-make-multi-tramp-file-format-separate): Removed. (tramp-make-tramp-file-name): Allow partial tramp file names. Generate tramp file format on-the-fly depending on parameters. Apply atomar format strings resp expressions. (tramp-get-completion-methods) (tramp-get-completion-user-host): Apply `tramp-make-tramp-file-name'. (tramp-parse-hosts-group): Take all host names and IP addresses into account. (tramp-bug): Remove `tramp-make-tramp-file-format'. 2002-09-01 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-methods): Add `tramp-completion-function' for "su" and "sudo". (tramp-get-completion-telnet): Implement it. (tramp-parse-hosts) (tramp-parse-hosts-group) (tramp-get-completion-su) (tramp-parse-passwd) (tramp-parse-passwd-group): New functions. 2002-08-31 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-mode): Check for `last-input-char'. (tramp-completion-file-name-handler-alist): Add handler for `file-exists-p. (tramp-completion-handle-file-exists-p): New function. (tramp-completion-handle-file-name-completion): Simplified. (tramp-completion-dissect-file-name): Regexp's reorganised. (tramp-completion-handle-file-name-all-completions): Call completion-function only if `user' or `host' is given. (tramp-get-completion-user-host): New function. (tramp-get-completion-rsh) (tramp-get-completion-ssh): Apply it. 2002-08-29 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-file-name-handler-alist): Add handler for `expand-file-name'. (tramp-completion-handle-expand-file-name): New function. 2002-08-26 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-mode): New function. (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-all-completions): Apply it. (tramp-methods): Remove double definition of `ssh1-old' and `ssh2-old'. (tramp-point-at-eol): New defalias. (tramp-parse-rhosts-group) (tramp-parse-shosts-group):: Apply it. 2002-08-25 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-methods) (tramp-get-completion-rsh) (tramp-get-completion-ssh): Add "[" for Xemacs. (tramp-completion-file-name-regexp-separate): Expression adapted. (tramp-completion-file-name-handler-alist): Add handler for `file-name-directory' and `file-name-nondirectory'. (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory) (tramp-completion-run-real-handler): New functions. (tramp-completion-file-name-handler) (tramp-completion-handle-file-name-all-completions): Apply `tramp-completion-run-real-handler'. (tramp-parse-rhosts) (tramp-parse-shosts): Use `with-temp-buffer'. `result? renamed to `res' (otherwise side effects in XEmacs). 2002-08-24 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-file-name-regexp) (tramp-completion-file-name-handler-alist) (tramp-flatten-list) (tramp-completion-dissect-file-name) (tramp-get-completion-rsh) (tramp-parse-rhosts) (tramp-parse-rhosts-group) (tramp-get-completion-ssh): Doc string tuned. (tramp-methods): Doc string and custom type extended for `tramp-completion-function'. (tramp-completion-function): Variable added. Is it really used? Other variables like `tramp-completion-function' aren't used. (tramp-completion-file-name-handler-alist): Add handler for `file-name-completion'. (tramp-completion-handle-file-name-completion): New function. 2002-08-18 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-parse-rhosts) (tramp-parse-rhosts-group) (tramp-parse-shosts) (tramp-parse-shosts-group): New functions. 2002-08-17 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-dissect-file-name) (tramp-completion-dissect-file-name1): New functions. 2002-08-16 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-function) (tramp-get-completion-rsh) (tramp-get-completion-ssh) (tramp-get-completion-telnet): New functions. (tramp-methods): Add `tramp-completion-function' for all methods. 2002-08-15 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-methods): New function. (tramp-find-default-method): Allow host to be nil (like user). 2002-08-14 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-file-name-regexp-unified) (tramp-completion-file-name-regexp-separate) (tramp-completion-file-name-regexp) (tramp-completion-file-name-handler-alist): New defcustoms. (tramp-completion-file-name-handler): New function. Add `tramp-completion-file-name-handler' to `file-name-handler-alist'. (tramp-run-real-handler): Add `tramp-completion-file-name-handler' to `inhibit-file-name-handlers'. (tramp-completion-handle-file-name-all-completions) (tramp-completion-handle-file-name-completion): New functions. 2002-08-12 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-invoke-ange-ftp): `tramp-disable-ange-ftp' must be called again after activating `ange-ftp'. (tramp-ange-ftp-file-name-p): Check for Xemacs. 2002-08-08 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-do-copy-or-rename-file): Don't pass KEEP-DATE to tramp-invoke-ange-ftp 'rename. (tramp-handle-write-region): Don't pass LOCKNAME and CONFIRM to tramp-invoke-ange-ftp 'write-region. (tramp-handle-set-file-modes): Change order of FILENAME and MODE passing to tramp-invoke-ange-ftp 'set-file-modes. (tramp-flatten-list): New function. Maybe this functionality does exist already elsewhere in the libraries. (tramp-invoke-ange-ftp): Apply `tramp-flatten-list' to parameter list in order to avoid nested lists, f.e. when invoked from `tramp-handle-dired-call-process'. 2002-09-05 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-chunksize): New kluge variable. (tramp-send-region): If tramp-chunksize is non-nil, send region in parts and sleep 0.1 seconds between chunks. 2002-09-03 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-insert-directory): Use `insert-buffer-substring' instead of `insert-buffer', which is not supposed to be used from Lisp. Remember old point in a variable instead of using `mark'. Suggestion from Stefan Monnier. (tramp-unified-filenames): New variable. Use it in default value of other filename variables. (file-expand-wildcards): Don't advise unless "[" and "]" are used in the filename format. 2002-09-01 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-methods): Remove duplicate definition of ssh1-old and ssh2-old.
author Kai Großjohann <kgrossjo@eu.uu.net>
date Sun, 22 Sep 2002 13:23:36 +0000
parents b87254142b98
children 0d8b17d428b5
line wrap: on
line source

;;; nnbabyl.el --- rmail mbox access for Gnus

;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000
;;	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
;; 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

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

;;; Code:

(require 'nnheader)
(condition-case nil
    (require 'rmail)
  (t (nnheader-message
      5 "Ignore rmail errors from this file, you don't have rmail")))
(require 'nnmail)
(require 'nnoo)
(eval-when-compile (require 'cl))

(nnoo-declare nnbabyl)

(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
  "The name of the rmail box file in the users home directory.")

(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
  "The name of the active file for the rmail box.")

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

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



(defvar nnbabyl-mail-delimiter "\^_")

(defconst nnbabyl-version "nnbabyl 1.0"
  "nnbabyl version.")

(defvoo nnbabyl-mbox-buffer nil)
(defvoo nnbabyl-current-group nil)
(defvoo nnbabyl-status-string "")
(defvoo nnbabyl-group-alist nil)
(defvoo nnbabyl-active-timestamp nil)

(defvoo nnbabyl-previous-buffer-mode nil)

(eval-and-compile
  (autoload 'gnus-set-text-properties "gnus-ems"))



;;; Interface functions

(nnoo-define-basics nnbabyl)

(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
  (save-excursion
    (set-buffer nntp-server-buffer)
    (erase-buffer)
    (let ((number (length articles))
	  (count 0)
	  (delim (concat "^" nnbabyl-mail-delimiter))
	  article art-string start stop)
      (nnbabyl-possibly-change-newsgroup group server)
      (while (setq article (pop articles))
	(setq art-string (nnbabyl-article-string article))
	(set-buffer nnbabyl-mbox-buffer)
	(end-of-line)
	(when (or (search-forward art-string nil t)
		  (search-backward art-string nil t))
	  (unless (re-search-backward delim nil t)
	    (goto-char (point-min)))
	  (while (and (not (looking-at ".+:"))
		      (zerop (forward-line 1))))
	  (setq start (point))
	  (search-forward "\n\n" nil t)
	  (setq stop (1- (point)))
	  (set-buffer nntp-server-buffer)
	  (insert "221 ")
	  (princ article (current-buffer))
	  (insert " Article retrieved.\n")
	  (insert-buffer-substring nnbabyl-mbox-buffer start stop)
	  (goto-char (point-max))
	  (insert ".\n"))
	(and (numberp nnmail-large-newsgroup)
	     (> number nnmail-large-newsgroup)
	     (zerop (% (incf count) 20))
	     (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
			       (/ (* count 100) number))))

      (and (numberp nnmail-large-newsgroup)
	   (> number nnmail-large-newsgroup)
	   (nnheader-message 5 "nnbabyl: Receiving headers...done"))

      (set-buffer nntp-server-buffer)
      (nnheader-fold-continuation-lines)
      'headers)))

(deffoo nnbabyl-open-server (server &optional defs)
  (nnoo-change-server 'nnbabyl server defs)
  (nnbabyl-create-mbox)
  (cond
   ((not (file-exists-p nnbabyl-mbox-file))
    (nnbabyl-close-server)
    (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
   ((file-directory-p nnbabyl-mbox-file)
    (nnbabyl-close-server)
    (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
   (t
    (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
		     nnbabyl-mbox-file)
    t)))

(deffoo nnbabyl-close-server (&optional server)
  ;; Restore buffer mode.
  (when (and (nnbabyl-server-opened)
	     nnbabyl-previous-buffer-mode)
    (save-excursion
      (set-buffer nnbabyl-mbox-buffer)
      (narrow-to-region
       (caar nnbabyl-previous-buffer-mode)
       (cdar nnbabyl-previous-buffer-mode))
      (funcall (cdr nnbabyl-previous-buffer-mode))))
  (nnoo-close-server 'nnbabyl server)
  (setq nnbabyl-mbox-buffer nil)
  t)

(deffoo nnbabyl-server-opened (&optional server)
  (and (nnoo-current-server-p 'nnbabyl server)
       nnbabyl-mbox-buffer
       (buffer-name nnbabyl-mbox-buffer)
       nntp-server-buffer
       (buffer-name nntp-server-buffer)))

(deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
  (nnbabyl-possibly-change-newsgroup newsgroup server)
  (save-excursion
    (set-buffer nnbabyl-mbox-buffer)
    (goto-char (point-min))
    (when (search-forward (nnbabyl-article-string article) nil t)
      (let (start stop summary-line)
	(unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
	  (goto-char (point-min))
	  (end-of-line))
	(while (and (not (looking-at ".+:"))
		    (zerop (forward-line 1))))
	(setq start (point))
	(or (when (re-search-forward
		   (concat "^" nnbabyl-mail-delimiter) nil t)
	      (beginning-of-line)
	      t)
	    (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 nnbabyl-mbox-buffer start stop)
	  (goto-char (point-min))
	  ;; If there is an EOOH header, then we have to remove some
	  ;; duplicated headers.
	  (setq summary-line (looking-at "Summary-line:"))
	  (when (search-forward "\n*** EOOH ***" nil t)
	    (if summary-line
		;; The headers to be deleted are located before the
		;; EOOH line...
		(delete-region (point-min) (progn (forward-line 1)
						  (point)))
	      ;; ...or after.
	      (delete-region (progn (beginning-of-line) (point))
			     (or (search-forward "\n\n" nil t)
				 (point)))))
	  (if (numberp article)
	      (cons nnbabyl-current-group article)
	    (nnbabyl-article-group-number)))))))

(deffoo nnbabyl-request-group (group &optional server dont-check)
  (let ((active (cadr (assoc group nnbabyl-group-alist))))
    (save-excursion
      (cond
       ((or (null active)
	    (null (nnbabyl-possibly-change-newsgroup group server)))
	(nnheader-report 'nnbabyl "No such group: %s" group))
       (dont-check
	(nnheader-report 'nnbabyl "Selected group %s" group)
	(nnheader-insert ""))
       (t
	(nnheader-report 'nnbabyl "Selected group %s" group)
	(nnheader-insert "211 %d %d %d %s\n"
			 (1+ (- (cdr active) (car active)))
			 (car active) (cdr active) group))))))

(deffoo nnbabyl-request-scan (&optional group server)
  (nnbabyl-possibly-change-newsgroup group server)
  (nnbabyl-read-mbox)
  (nnmail-get-new-mail
   'nnbabyl
   (lambda ()
     (save-excursion
       (set-buffer nnbabyl-mbox-buffer)
       (save-buffer)))
   (file-name-directory nnbabyl-mbox-file)
   group
   (lambda ()
     (save-excursion
       (let ((in-buf (current-buffer)))
	 (goto-char (point-min))
	 (while (search-forward "\n\^_\n" nil t)
	   (delete-char -1))
	 (set-buffer nnbabyl-mbox-buffer)
	 (goto-char (point-max))
	 (search-backward "\n\^_" nil t)
	 (goto-char (match-end 0))
	 (insert-buffer-substring in-buf)))
     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))

(deffoo nnbabyl-close-group (group &optional server)
  t)

(deffoo nnbabyl-request-create-group (group &optional server args)
  (nnmail-activate 'nnbabyl)
  (unless (assoc group nnbabyl-group-alist)
    (push (list group (cons 1 0))
	  nnbabyl-group-alist)
    (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
  t)

(deffoo nnbabyl-request-list (&optional server)
  (save-excursion
    (nnmail-find-file nnbabyl-active-file)
    (setq nnbabyl-group-alist (nnmail-get-active))
    t))

(deffoo nnbabyl-request-newgroups (date &optional server)
  (nnbabyl-request-list server))

(deffoo nnbabyl-request-list-newsgroups (&optional server)
  (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))

(deffoo nnbabyl-request-expire-articles
    (articles newsgroup &optional server force)
  (nnbabyl-possibly-change-newsgroup newsgroup server)
  (let* ((is-old t)
	 rest)
    (nnmail-activate 'nnbabyl)

    (save-excursion
      (set-buffer nnbabyl-mbox-buffer)
      (gnus-set-text-properties (point-min) (point-max) nil)
      (while (and articles is-old)
	(goto-char (point-min))
	(when (search-forward (nnbabyl-article-string (car articles)) nil t)
	  (if (setq is-old
		    (nnmail-expired-article-p
		     newsgroup
		     (buffer-substring
		      (point) (progn (end-of-line) (point))) force))
	      (progn
		(unless (eq nnmail-expiry-target 'delete)
		  (with-temp-buffer
		    (nnbabyl-request-article (car articles) 
					     newsgroup server 
					     (current-buffer))
		    (let ((nnml-current-directory nil))
		      (nnmail-expiry-target-group
		       nnmail-expiry-target newsgroup))))
		(nnheader-message 5 "Deleting article %d in %s..."
				  (car articles) newsgroup)
		(nnbabyl-delete-mail))
	    (push (car articles) rest)))
	(setq articles (cdr articles)))
      (save-buffer)
      ;; Find the lowest active article in this group.
      (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
	(goto-char (point-min))
	(while (and (not (search-forward
			  (nnbabyl-article-string (car active)) nil t))
		    (<= (car active) (cdr active)))
	  (setcar active (1+ (car active)))
	  (goto-char (point-min))))
      (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
      (nconc rest articles))))

(deffoo nnbabyl-request-move-article
    (article group server accept-form &optional last)
  (let ((buf (get-buffer-create " *nnbabyl move*"))
	result)
    (and
     (nnbabyl-request-article article group server)
     (save-excursion
       (set-buffer buf)
       (insert-buffer-substring nntp-server-buffer)
       (goto-char (point-min))
       (while (re-search-forward
	       "^X-Gnus-Newsgroup:"
	       (save-excursion (search-forward "\n\n" nil t) (point)) t)
	 (delete-region (progn (beginning-of-line) (point))
			(progn (forward-line 1) (point))))
       (setq result (eval accept-form))
       (kill-buffer (current-buffer))
       result)
     (save-excursion
       (nnbabyl-possibly-change-newsgroup group server)
       (set-buffer nnbabyl-mbox-buffer)
       (goto-char (point-min))
       (if (search-forward (nnbabyl-article-string article) nil t)
	   (nnbabyl-delete-mail))
       (and last (save-buffer))))
    result))

(deffoo nnbabyl-request-accept-article (group &optional server last)
  (nnbabyl-possibly-change-newsgroup group server)
  (nnmail-check-syntax)
  (let ((buf (current-buffer))
	result beg)
    (and
     (nnmail-activate 'nnbabyl)
     (save-excursion
       (goto-char (point-min))
       (search-forward "\n\n" nil t)
       (forward-line -1)
       (save-excursion
	 (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
	   (delete-region (point) (progn (forward-line 1) (point)))))
       (when nnmail-cache-accepted-message-ids
	 (nnmail-cache-insert (nnmail-fetch-field "message-id")))
       (setq result
	     (if (stringp group)
		 (list (cons group (nnbabyl-active-number group)))
	       (nnmail-article-group 'nnbabyl-active-number)))
       (if (and (null result)
		(yes-or-no-p "Moved to `junk' group; delete article? "))
	   (setq result 'junk)
	 (setq result (car (nnbabyl-save-mail result))))
       (set-buffer nnbabyl-mbox-buffer)
       (goto-char (point-max))
       (search-backward "\n\^_")
       (goto-char (match-end 0))
       (insert-buffer-substring buf)
       (when last
	 (when nnmail-cache-accepted-message-ids
	   (nnmail-cache-insert (nnmail-fetch-field "message-id")))
	 (save-buffer)
	 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
       result))))

(deffoo nnbabyl-request-replace-article (article group buffer)
  (nnbabyl-possibly-change-newsgroup group)
  (save-excursion
    (set-buffer nnbabyl-mbox-buffer)
    (goto-char (point-min))
    (if (not (search-forward (nnbabyl-article-string article) nil t))
	nil
      (nnbabyl-delete-mail t t)
      (insert-buffer-substring buffer)
      (save-buffer)
      t)))

(deffoo nnbabyl-request-delete-group (group &optional force server)
  (nnbabyl-possibly-change-newsgroup group server)
  ;; Delete all articles in GROUP.
  (if (not force)
      ()				; Don't delete the articles.
    (save-excursion
      (set-buffer nnbabyl-mbox-buffer)
      (goto-char (point-min))
      ;; Delete all articles in this group.
      (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
	    found)
	(while (search-forward ident nil t)
	  (setq found t)
	  (nnbabyl-delete-mail))
	(when found
	  (save-buffer)))))
  ;; Remove the group from all structures.
  (setq nnbabyl-group-alist
	(delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
	nnbabyl-current-group nil)
  ;; Save the active file.
  (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
  t)

(deffoo nnbabyl-request-rename-group (group new-name &optional server)
  (nnbabyl-possibly-change-newsgroup group server)
  (save-excursion
    (set-buffer nnbabyl-mbox-buffer)
    (goto-char (point-min))
    (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
	  (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
	  found)
      (while (search-forward ident nil t)
	(replace-match new-ident t t)
	(setq found t))
      (when found
	(save-buffer))))
  (let ((entry (assoc group nnbabyl-group-alist)))
    (and entry (setcar entry new-name))
    (setq nnbabyl-current-group nil)
    ;; Save the new group alist.
    (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
    t))


;;; Internal functions.

;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
;; headers there are.  If LEAVE-DELIM, don't delete the Unix mbox
;; delimiter line.
(defun nnbabyl-delete-mail (&optional force leave-delim)
  ;; Delete the current X-Gnus-Newsgroup line.
  (unless force
    (delete-region
     (progn (beginning-of-line) (point))
     (progn (forward-line 1) (point))))
  ;; Beginning of the article.
  (save-excursion
    (save-restriction
      (widen)
      (narrow-to-region
       (save-excursion
	 (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
	   (goto-char (point-min))
	   (end-of-line))
	 (if leave-delim (progn (forward-line 1) (point))
	   (match-beginning 0)))
       (progn
	 (forward-line 1)
	 (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter)
				     nil t)
		  (match-beginning 0))
	     (point-max))))
      (goto-char (point-min))
      ;; Only delete the article if no other groups owns it as well.
      (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
	(delete-region (point-min) (point-max))))))

(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
  (when (and server
	     (not (nnbabyl-server-opened server)))
    (nnbabyl-open-server server))
  (when (or (not nnbabyl-mbox-buffer)
	    (not (buffer-name nnbabyl-mbox-buffer)))
    (save-excursion (nnbabyl-read-mbox)))
  (unless nnbabyl-group-alist
    (nnmail-activate 'nnbabyl))
  (if newsgroup
      (if (assoc newsgroup nnbabyl-group-alist)
	  (setq nnbabyl-current-group newsgroup)
	(nnheader-report 'nnbabyl "No such group in file"))
    t))

(defun nnbabyl-article-string (article)
  (if (numberp article)
      (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
	      (int-to-string article) " ")
    (concat "\nMessage-ID: " article)))

(defun nnbabyl-article-group-number ()
  (save-excursion
    (goto-char (point-min))
    (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
			     nil t)
      (cons (buffer-substring (match-beginning 1) (match-end 1))
	    (string-to-int
	     (buffer-substring (match-beginning 2) (match-end 2)))))))

(defun nnbabyl-insert-lines ()
  "Insert how many lines and chars there are in the body of the mail."
  (let (lines chars)
    (save-excursion
      (goto-char (point-min))
      (when (search-forward "\n\n" nil t)
	;; There may be an EOOH line here...
	(when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
	  (search-forward "\n\n" nil t))
	(setq chars (- (point-max) (point))
	      lines (max (- (count-lines (point) (point-max)) 1) 0))
	;; Move back to the end of the headers.
	(goto-char (point-min))
	(search-forward "\n\n" nil t)
	(forward-char -1)
	(save-excursion
	  (when (re-search-backward "^Lines: " nil t)
	    (delete-region (point) (progn (forward-line 1) (point)))))
	(insert (format "Lines: %d\n" lines))
	chars))))

(defun nnbabyl-save-mail (group-art)
  ;; Called narrowed to an article.
  (nnbabyl-insert-lines)
  (nnmail-insert-xref group-art)
  (nnbabyl-insert-newsgroup-line group-art)
  (run-hooks 'nnbabyl-prepare-save-mail-hook)
  group-art)

(defun nnbabyl-insert-newsgroup-line (group-art)
  (save-excursion
    (goto-char (point-min))
    (while (looking-at "From ")
      (replace-match "Mail-from: From " t t)
      (forward-line 1))
    ;; If there is a C-l at the beginning of the narrowed region, this
    ;; isn't really a "save", but rather a "scan".
    (goto-char (point-min))
    (unless (looking-at "\^L")
      (save-excursion
	(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
	(goto-char (point-max))
	(insert "\^_\n")))
    (when (search-forward "\n\n" nil t)
      (forward-char -1)
      (while group-art
	(insert (format "X-Gnus-Newsgroup: %s:%d   %s\n"
			(caar group-art) (cdar group-art)
			(current-time-string)))
	(setq group-art (cdr group-art))))
    t))

(defun nnbabyl-active-number (group)
  ;; Find the next article number in GROUP.
  (let ((active (cadr (assoc group nnbabyl-group-alist))))
    (if active
	(setcdr active (1+ (cdr active)))
      ;; This group is new, so we create a new entry for it.
      ;; This might be a bit naughty... creating groups on the drop of
      ;; a hat, but I don't know...
      (push (list group (setq active (cons 1 1)))
	    nnbabyl-group-alist))
    (cdr active)))

(defun nnbabyl-create-mbox ()
  (unless (file-exists-p nnbabyl-mbox-file)
    ;; Create a new, empty RMAIL mbox file.
    (save-excursion
      (set-buffer (setq nnbabyl-mbox-buffer
			(create-file-buffer nnbabyl-mbox-file)))
      (setq buffer-file-name nnbabyl-mbox-file)
      (insert "BABYL OPTIONS:\n\n\^_")
      (nnmail-write-region
       (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))))

(defun nnbabyl-read-mbox ()
  (nnmail-activate 'nnbabyl)
  (nnbabyl-create-mbox)

  (unless (and nnbabyl-mbox-buffer
	       (buffer-name nnbabyl-mbox-buffer)
	       (save-excursion
		 (set-buffer nnbabyl-mbox-buffer)
		 (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
    ;; This buffer has changed since we read it last.  Possibly.
    (save-excursion
      (let ((delim (concat "^" nnbabyl-mail-delimiter))
	    (alist nnbabyl-group-alist)
	    start end number)
	(set-buffer (setq nnbabyl-mbox-buffer
			  (nnheader-find-file-noselect
			   nnbabyl-mbox-file nil t)))
	;; Save previous buffer mode.
	(setq nnbabyl-previous-buffer-mode
	      (cons (cons (point-min) (point-max))
		    major-mode))

	(buffer-disable-undo)
	(widen)
	(setq buffer-read-only nil)
	(fundamental-mode)

	;; Go through the group alist and compare against
	;; the rmail file.
	(while alist
	  (goto-char (point-max))
	  (when (and (re-search-backward
		      (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
			      (caar alist))
		      nil t)
		     (> (setq number
			      (string-to-number
			       (buffer-substring
				(match-beginning 1) (match-end 1))))
			(cdadar alist)))
	    (setcdr (cadar alist) number))
	  (setq alist (cdr alist)))

	;; We go through the mbox and make sure that each and
	;; every mail belongs to some group or other.
	(goto-char (point-min))
	(if (looking-at "\^L")
	    (setq start (point))
	  (re-search-forward delim nil t)
	  (setq start (match-end 0)))
	(while (re-search-forward delim nil t)
	  (setq end (match-end 0))
	  (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
	    (goto-char end)
	    (save-excursion
	      (save-restriction
		(narrow-to-region (goto-char start) end)
		(nnbabyl-save-mail
		 (nnmail-article-group 'nnbabyl-active-number))
		(setq end (point-max)))))
	  (goto-char (setq start end)))
	(when (buffer-modified-p (current-buffer))
	  (save-buffer))
	(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))

(defun nnbabyl-remove-incoming-delims ()
  (goto-char (point-min))
  (while (search-forward "\^_" nil t)
    (replace-match "?" t t)))

(defun nnbabyl-check-mbox ()
  "Go through the nnbabyl mbox and make sure that no article numbers are reused."
  (interactive)
  (let ((idents (make-vector 1000 0))
	id)
    (save-excursion
      (when (or (not nnbabyl-mbox-buffer)
		(not (buffer-name nnbabyl-mbox-buffer)))
	(nnbabyl-read-mbox))
      (set-buffer nnbabyl-mbox-buffer)
      (goto-char (point-min))
      (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) "  nil t)
	(if (intern-soft (setq id (match-string 1)) idents)
	    (progn
	      (delete-region (progn (beginning-of-line) (point))
			     (progn (forward-line 1) (point)))
	      (nnheader-message 7 "Moving %s..." id)
	      (nnbabyl-save-mail
	       (nnmail-article-group 'nnbabyl-active-number)))
	  (intern id idents)))
      (when (buffer-modified-p (current-buffer))
	(save-buffer))
      (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
      (nnheader-message 5 ""))))

(provide 'nnbabyl)

;;; nnbabyl.el ends here