cgit.sxemacs.org Git - gnus/blob - lisp/nnbabyl.el

   1 ;;; nnbabyl.el --- rmail mbox access for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   6 ;; Keywords: news, mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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.
  23
  24 ;;; Commentary:
  25
  26 ;; For an overview of what the interface functions do, please see the
  27 ;; Gnus sources.
  28
  29 ;;; Code:
  30
  31 (require 'nnheader)
  32 (require 'rmail)
  33 (require 'nnmail)
  34
  35 (defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL")
  36   "The name of the rmail box file in the users home directory.")
  37
  38 (defvar nnbabyl-active-file (expand-file-name "~/.rmail-active")
  39   "The name of the active file for the rmail box.")
  40
  41 (defvar nnbabyl-get-new-mail t
  42   "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
  43
  44 (defvar nnbabyl-prepare-save-mail-hook nil
  45   "Hook run narrowed to an article before saving.")
  46
  47 \f
  48
  49 (defvar nnbabyl-mail-delimiter "\^_")
  50
  51 (defconst nnbabyl-version "nnbabyl 1.0"
  52   "nnbabyl version.")
  53
  54 (defvar nnbabyl-mbox-buffer nil)
  55 (defvar nnbabyl-current-group nil)
  56 (defvar nnbabyl-status-string "")
  57 (defvar nnbabyl-group-alist nil)
  58 (defvar nnbabyl-active-timestamp nil)
  59
  60 (defvar nnbabyl-previous-buffer-mode nil)
  61
  62 \f
  63
  64 (defvar nnbabyl-current-server nil)
  65 (defvar nnbabyl-server-alist nil)
  66 (defvar nnbabyl-server-variables
  67   (list
  68    (list 'nnbabyl-mbox-file nnbabyl-mbox-file)
  69    (list 'nnbabyl-active-file nnbabyl-active-file)
  70    (list 'nnbabyl-get-new-mail nnbabyl-get-new-mail)
  71    '(nnbabyl-current-group nil)
  72    '(nnbabyl-status-string "")
  73    '(nnbabyl-previous-buffer-mode nil)
  74    '(nnbabyl-group-alist nil)))
  75
  76 \f
  77
  78 ;;; Interface functions
  79
  80 (defun nnbabyl-retrieve-headers (sequence &optional newsgroup server fetch-old)
  81   (save-excursion
  82     (set-buffer nntp-server-buffer)
  83     (erase-buffer)
  84     (let ((number (length sequence))
  85           (count 0)
  86           article art-string start stop)
  87       (nnbabyl-possibly-change-newsgroup newsgroup)
  88       (while sequence
  89         (setq article (car sequence))
  90         (setq art-string (nnbabyl-article-string article))
  91         (set-buffer nnbabyl-mbox-buffer)
  92         (if (or (search-forward art-string nil t)
  93                 (search-backward art-string nil t))
  94             (progn
  95               (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
  96               (while (and (not (looking-at ".+:"))
  97                           (zerop (forward-line 1))))
  98               (setq start (point))
  99               (search-forward "\n\n" nil t)
 100               (setq stop (1- (point)))
 101               (set-buffer nntp-server-buffer)
 102               (insert "221 " (int-to-string article) " Article retrieved.\n")
 103               (insert-buffer-substring nnbabyl-mbox-buffer start stop)
 104               (goto-char (point-max))
 105               (insert ".\n")))
 106         (setq sequence (cdr sequence))
 107         (setq count (1+ count))
 108         (and (numberp nnmail-large-newsgroup)
 109              (> number nnmail-large-newsgroup)
 110              (zerop (% count 20))
 111              gnus-verbose-backends
 112              (message "nnbabyl: Receiving headers... %d%%"
 113                       (/ (* count 100) number))))
 114
 115       (and (numberp nnmail-large-newsgroup)
 116            (> number nnmail-large-newsgroup)
 117            gnus-verbose-backends
 118            (message "nnbabyl: Receiving headers...done"))
 119
 120       ;; Fold continuation lines.
 121       (set-buffer nntp-server-buffer)
 122       (goto-char (point-min))
 123       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 124         (replace-match " " t t))
 125       'headers)))
 126
 127 (defun nnbabyl-open-server (server &optional defs)
 128   (nnheader-init-server-buffer)
 129   (if (equal server nnbabyl-current-server)
 130       t
 131     (if nnbabyl-current-server
 132         (setq nnbabyl-server-alist
 133               (cons (list nnbabyl-current-server
 134                           (nnheader-save-variables nnbabyl-server-variables))
 135                     nnbabyl-server-alist)))
 136     (let ((state (assoc server nnbabyl-server-alist)))
 137       (if state
 138           (progn
 139             (nnheader-restore-variables (nth 1 state))
 140             (setq nnbabyl-server-alist (delq state nnbabyl-server-alist)))
 141         (nnheader-set-init-variables nnbabyl-server-variables defs)))
 142     (setq nnbabyl-current-server server)))
 143
 144 (defun nnbabyl-close-server (&optional server)
 145   ;; Restore buffer mode.
 146   (when (and (nnbabyl-server-opened)
 147              nnbabyl-previous-buffer-mode)
 148     (save-excursion
 149       (set-buffer nnbabyl-mbox-buffer)
 150       (narrow-to-region
 151        (car (car nnbabyl-previous-buffer-mode))
 152        (cdr (car nnbabyl-previous-buffer-mode)))
 153       (funcall (cdr nnbabyl-previous-buffer-mode))))
 154   (setq nnbabyl-current-server nil
 155         nnbabyl-mbox-buffer nil)
 156   t)
 157
 158 (defun nnbabyl-server-opened (&optional server)
 159   (and (equal server nnbabyl-current-server)
 160        nnbabyl-mbox-buffer
 161        (buffer-name nnbabyl-mbox-buffer)
 162        nntp-server-buffer
 163        (buffer-name nntp-server-buffer)))
 164
 165 (defun nnbabyl-status-message (&optional server)
 166   nnbabyl-status-string)
 167
 168 (defun nnbabyl-request-article (article &optional newsgroup server buffer)
 169   (nnbabyl-possibly-change-newsgroup newsgroup)
 170   (save-excursion
 171     (set-buffer nnbabyl-mbox-buffer)
 172     (goto-char (point-min))
 173     (if (search-forward (nnbabyl-article-string article) nil t)
 174         (let (start stop summary-line)
 175           (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
 176           (while (and (not (looking-at ".+:"))
 177                       (zerop (forward-line 1))))
 178           (setq start (point))
 179           (or (and (re-search-forward
 180                     (concat "^" nnbabyl-mail-delimiter) nil t)
 181                    (forward-line -1))
 182               (goto-char (point-max)))
 183           (setq stop (point))
 184           (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 185             (set-buffer nntp-server-buffer)
 186             (erase-buffer)
 187             (insert-buffer-substring nnbabyl-mbox-buffer start stop)
 188             (goto-char (point-min))
 189             ;; If there is an EOOH header, then we have to remove some
 190             ;; duplicated headers.
 191             (setq summary-line (looking-at "Summary-line:"))
 192             (when (search-forward "\n*** EOOH ***" nil t)
 193               (if summary-line
 194                   ;; The headers to be deleted are located before the
 195                   ;; EOOH line...
 196                   (delete-region (point-min) (progn (forward-line 1)
 197                   (point)))
 198                 ;; ...or after.
 199                 (delete-region (progn (beginning-of-line) (point))
 200                                (or (search-forward "\n\n" nil t)
 201                                    (point)))))
 202             (if (numberp article)
 203                 (cons nnbabyl-current-group article)
 204               (nnbabyl-article-group-number)))))))
 205
 206 (defun nnbabyl-request-group (group &optional server dont-check)
 207   (save-excursion
 208     (if (nnbabyl-possibly-change-newsgroup group)
 209         (if dont-check
 210             t
 211           (save-excursion
 212             (set-buffer nntp-server-buffer)
 213             (erase-buffer)
 214             (let ((active (assoc group nnbabyl-group-alist)))
 215               (insert (format "211 %d %d %d %s\n"
 216                               (1+ (- (cdr (car (cdr active)))
 217                                      (car (car (cdr active)))))
 218                               (car (car (cdr active)))
 219                               (cdr (car (cdr active)))
 220                               (car active))))
 221             t)))))
 222
 223 (defun nnbabyl-request-scan (&optional group server)
 224   (nnbabyl-read-mbox)
 225   (nnmail-get-new-mail
 226    'nnbabyl
 227    (lambda ()
 228      (save-excursion
 229        (set-buffer nnbabyl-mbox-buffer)
 230        (save-buffer)))
 231    nnbabyl-mbox-file group
 232    (lambda ()
 233      (save-excursion
 234        (let ((in-buf (current-buffer)))
 235          (goto-char (point-min))
 236          (while (search-forward "\n\^_\n" nil t)
 237            (delete-char -1))
 238          (set-buffer nnbabyl-mbox-buffer)
 239          (goto-char (point-max))
 240          (search-backward "\n\^_" nil t)
 241          (goto-char (match-end 0))
 242          (insert-buffer-substring in-buf))))))
 243
 244 (defun nnbabyl-close-group (group &optional server)
 245   t)
 246
 247 (defun nnbabyl-request-create-group (group &optional server)
 248   (nnmail-activate 'nnbabyl)
 249   (or (assoc group nnbabyl-group-alist)
 250       (let (active)
 251         (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0)))
 252                                         nnbabyl-group-alist))
 253         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))
 254   t)
 255
 256 (defun nnbabyl-request-list (&optional server)
 257   (save-excursion
 258     (or (nnmail-find-file nnbabyl-active-file)
 259         (progn
 260           (setq nnbabyl-group-alist (nnmail-get-active))
 261           (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 262           (nnmail-find-file nnbabyl-active-file)))))
 263
 264 (defun nnbabyl-request-newgroups (date &optional server)
 265   (nnbabyl-request-list server))
 266
 267 (defun nnbabyl-request-list-newsgroups (&optional server)
 268   (setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.")
 269   nil)
 270
 271 (defun nnbabyl-request-post (&optional server)
 272   (mail-send-and-exit nil))
 273
 274 (defun nnbabyl-request-expire-articles
 275   (articles newsgroup &optional server force)
 276   (nnbabyl-possibly-change-newsgroup newsgroup)
 277   (let* ((days (or (and nnmail-expiry-wait-function
 278                         (funcall nnmail-expiry-wait-function newsgroup))
 279                    nnmail-expiry-wait))
 280          (is-old t)
 281          rest)
 282     (nnmail-activate 'nnbabyl)
 283
 284     (save-excursion
 285       (set-buffer nnbabyl-mbox-buffer)
 286       (set-text-properties (point-min) (point-max) nil)
 287       (while (and articles is-old)
 288         (goto-char (point-min))
 289         (if (search-forward (nnbabyl-article-string (car articles)) nil t)
 290             (if (or force
 291                     (setq is-old
 292                           (> (nnmail-days-between
 293                               (current-time-string)
 294                               (buffer-substring
 295                                (point) (progn (end-of-line) (point))))
 296                              days)))
 297                 (progn
 298                   (and gnus-verbose-backends
 299                        (message "Deleting article %d in %s..."
 300                                 (car articles) newsgroup))
 301                   (nnbabyl-delete-mail))
 302               (setq rest (cons (car articles) rest))))
 303         (setq articles (cdr articles)))
 304       (save-buffer)
 305       ;; Find the lowest active article in this group.
 306       (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
 307         (goto-char (point-min))
 308         (while (and (not (search-forward
 309                           (nnbabyl-article-string (car active)) nil t))
 310                     (<= (car active) (cdr active)))
 311           (setcar active (1+ (car active)))
 312           (goto-char (point-min))))
 313       (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 314       (nconc rest articles))))
 315
 316 (defun nnbabyl-request-move-article
 317   (article group server accept-form &optional last)
 318   (nnbabyl-possibly-change-newsgroup group)
 319   (let ((buf (get-buffer-create " *nnbabyl move*"))
 320         result)
 321     (and
 322      (nnbabyl-request-article article group server)
 323      (save-excursion
 324        (set-buffer buf)
 325        (insert-buffer-substring nntp-server-buffer)
 326        (goto-char (point-min))
 327        (if (re-search-forward
 328             "^X-Gnus-Newsgroup:"
 329             (save-excursion (search-forward "\n\n" nil t) (point)) t)
 330            (delete-region (progn (beginning-of-line) (point))
 331                           (progn (forward-line 1) (point))))
 332        (setq result (eval accept-form))
 333        (kill-buffer (current-buffer))
 334        result)
 335      (save-excursion
 336        (set-buffer nnbabyl-mbox-buffer)
 337        (goto-char (point-min))
 338        (if (search-forward (nnbabyl-article-string article) nil t)
 339            (nnbabyl-delete-mail))
 340        (and last (save-buffer))))
 341     result))
 342
 343 (defun nnbabyl-request-accept-article (group &optional last)
 344   (let ((buf (current-buffer))
 345         result beg)
 346     (and
 347      (nnmail-activate 'nnbabyl)
 348      (save-excursion
 349        (goto-char (point-min))
 350        (search-forward "\n\n" nil t)
 351        (forward-line -1)
 352        (save-excursion
 353          (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
 354            (delete-region (point) (progn (forward-line 1) (point)))))
 355        (let ((nnmail-split-methods
 356               (if (stringp group) (list (list group ""))
 357                 nnmail-split-methods)))
 358          (setq result (car (nnbabyl-save-mail))))
 359        (set-buffer nnbabyl-mbox-buffer)
 360        (goto-char (point-max))
 361        (search-backward "\n\^_")
 362        (goto-char (match-end 0))
 363        (insert-buffer-substring buf)
 364        (and last (progn
 365                    (save-buffer)
 366                    (nnmail-save-active
 367                     nnbabyl-group-alist nnbabyl-active-file)))
 368        result))))
 369
 370 (defun nnbabyl-request-replace-article (article group buffer)
 371   (nnbabyl-possibly-change-newsgroup group)
 372   (save-excursion
 373     (set-buffer nnbabyl-mbox-buffer)
 374     (goto-char (point-min))
 375     (if (not (search-forward (nnbabyl-article-string article) nil t))
 376         nil
 377       (nnbabyl-delete-mail t t)
 378       (insert-buffer-substring buffer)
 379       (save-buffer)
 380       t)))
 381
 382 (defun nnbabyl-request-delete-group (group &optional force server)
 383   (nnbabyl-possibly-change-newsgroup group)
 384   ;; Delete all articles in GROUP.
 385   (if (not force)
 386       ()                                ; Don't delete the articles.
 387     (save-excursion
 388       (set-buffer nnbabyl-mbox-buffer)
 389       (goto-char (point-min))
 390       ;; Delete all articles in this group.
 391       (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
 392             found)
 393         (while (search-forward ident nil t)
 394           (setq found t)
 395           (nnbabyl-delete-mail))
 396         (and found (save-buffer)))))
 397   ;; Remove the group from all structures.
 398   (setq nnbabyl-group-alist
 399         (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
 400         nnbabyl-current-group nil)
 401   ;; Save the active file.
 402   (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 403   t)
 404
 405 (defun nnbabyl-request-rename-group (group new-name &optional server)
 406   (nnbabyl-possibly-change-newsgroup group)
 407   (save-excursion
 408     (set-buffer nnbabyl-mbox-buffer)
 409     (goto-char (point-min))
 410     (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
 411           (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
 412           found)
 413       (while (search-forward ident nil t)
 414         (replace-match new-ident t t)
 415         (setq found t))
 416       (and found (save-buffer))))
 417   (let ((entry (assoc group nnbabyl-group-alist)))
 418     (and entry (setcar entry new-name))
 419     (setq nnbabyl-current-group nil)
 420     ;; Save the new group alist.
 421     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 422     t))
 423
 424 \f
 425 ;;; Internal functions.
 426
 427 ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
 428 ;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
 429 ;; delimeter line.
 430 (defun nnbabyl-delete-mail (&optional force leave-delim)
 431   ;; Delete the current X-Gnus-Newsgroup line.
 432   (or force
 433       (delete-region
 434        (progn (beginning-of-line) (point))
 435        (progn (forward-line 1) (point))))
 436   ;; Beginning of the article.
 437   (save-excursion
 438     (save-restriction
 439       (widen)
 440       (narrow-to-region
 441        (save-excursion
 442          (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
 443          (if leave-delim (progn (forward-line 1) (point))
 444            (match-beginning 0)))
 445        (progn
 446          (forward-line 1)
 447          (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter)
 448                                      nil t)
 449                   (if (and (not (bobp)) leave-delim)
 450                       (progn (forward-line -2) (point))
 451                     (match-beginning 0)))
 452              (point-max))))
 453       (goto-char (point-min))
 454       ;; Only delete the article if no other groups owns it as well.
 455       (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
 456           (delete-region (point-min) (point-max))))))
 457
 458 (defun nnbabyl-possibly-change-newsgroup (newsgroup)
 459   (if (or (not nnbabyl-mbox-buffer)
 460           (not (buffer-name nnbabyl-mbox-buffer)))
 461       (save-excursion (nnbabyl-read-mbox)))
 462   (or nnbabyl-group-alist
 463       (nnmail-activate 'nnbabyl))
 464   (if newsgroup
 465       (if (assoc newsgroup nnbabyl-group-alist)
 466           (setq nnbabyl-current-group newsgroup)
 467         (setq nnbabyl-status-string "No such group in file")
 468         nil)))
 469
 470 (defun nnbabyl-article-string (article)
 471   (if (numberp article)
 472       (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
 473               (int-to-string article) " ")
 474     (concat "\nMessage-ID: " article)))
 475
 476 (defun nnbabyl-article-group-number ()
 477   (save-excursion
 478     (goto-char (point-min))
 479     (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
 480                             nil t)
 481          (cons (buffer-substring (match-beginning 1) (match-end 1))
 482                (string-to-int
 483                 (buffer-substring (match-beginning 2) (match-end 2)))))))
 484
 485 (defun nnbabyl-insert-lines ()
 486   "Insert how many lines and chars there are in the body of the mail."
 487   (let (lines chars)
 488     (save-excursion
 489       (goto-char (point-min))
 490       (if (search-forward "\n\n" nil t)
 491           (progn
 492             ;; There may be an EOOH line here...
 493             (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 494                 (search-forward "\n\n" nil t))
 495             (setq chars (- (point-max) (point)))
 496             (setq lines (- (count-lines (point) (point-max)) 1))
 497             ;; Move back to the end of the headers.
 498             (goto-char (point-min))
 499             (search-forward "\n\n" nil t)
 500             (forward-char -1)
 501             (save-excursion
 502               (if (re-search-backward "^Lines: " nil t)
 503                   (delete-region (point) (progn (forward-line 1) (point)))))
 504             (insert (format "Lines: %d\n" lines))
 505             chars)))))
 506
 507 (defun nnbabyl-save-mail ()
 508   ;; Called narrowed to an article.
 509   (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number))))
 510     (nnbabyl-insert-lines)
 511     (nnmail-insert-xref group-art)
 512     (nnbabyl-insert-newsgroup-line group-art)
 513     (run-hooks 'nnbabyl-prepare-save-mail-hook)
 514     group-art))
 515
 516 (defun nnbabyl-insert-newsgroup-line (group-art)
 517   (save-excursion
 518     (goto-char (point-min))
 519     (while (looking-at "From ")
 520       (replace-match "Mail-from: From " t t)
 521       (forward-line 1))
 522     ;; If there is a C-l at the beginning of the narrowed region, this
 523     ;; isn't really a "save", but rather a "scan".
 524     (goto-char (point-min))
 525     (or (looking-at "\^L")
 526         (save-excursion
 527           (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
 528           (goto-char (point-max))
 529           (insert "\^_\n")))
 530     (if (search-forward "\n\n" nil t)
 531         (progn
 532           (forward-char -1)
 533           (while group-art
 534             (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n"
 535                             (car (car group-art)) (cdr (car group-art))
 536                             (current-time-string)))
 537             (setq group-art (cdr group-art)))))
 538     t))
 539
 540 (defun nnbabyl-active-number (group)
 541   ;; Find the next article number in GROUP.
 542   (let ((active (car (cdr (assoc group nnbabyl-group-alist)))))
 543     (if active
 544         (setcdr active (1+ (cdr active)))
 545       ;; This group is new, so we create a new entry for it.
 546       ;; This might be a bit naughty... creating groups on the drop of
 547       ;; a hat, but I don't know...
 548       (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1)))
 549                                       nnbabyl-group-alist)))
 550     (cdr active)))
 551
 552 (defun nnbabyl-read-mbox ()
 553   (nnmail-activate 'nnbabyl)
 554   (or (file-exists-p nnbabyl-mbox-file)
 555       (save-excursion
 556         (set-buffer (setq nnbabyl-mbox-buffer
 557                           (create-file-buffer nnbabyl-mbox-file)))
 558         (setq buffer-file-name nnbabyl-mbox-file)
 559         (insert "BABYL OPTIONS:\n\n\^_")
 560         (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
 561
 562   (if (and nnbabyl-mbox-buffer
 563            (buffer-name nnbabyl-mbox-buffer)
 564            (save-excursion
 565              (set-buffer nnbabyl-mbox-buffer)
 566              (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file)))))
 567       ()
 568     (save-excursion
 569       (let ((delim (concat "^" nnbabyl-mail-delimiter))
 570             start end)
 571         (set-buffer (setq nnbabyl-mbox-buffer
 572                           (nnheader-find-file-noselect
 573                            nnbabyl-mbox-file nil 'raw)))
 574         ;; Save buffer mode.
 575         (setq nnbabyl-previous-buffer-mode
 576               (cons (cons (point-min) (point-max))
 577                     major-mode))
 578
 579         (buffer-disable-undo (current-buffer))
 580         (widen)
 581         (setq buffer-read-only nil)
 582         (fundamental-mode)
 583
 584         (goto-char (point-min))
 585         (re-search-forward delim nil t)
 586         (setq start (match-end 0))
 587         (while (re-search-forward delim nil t)
 588           (setq end (match-end 0))
 589           (or (search-backward "\nX-Gnus-Newsgroup: " start t)
 590               (progn
 591                 (goto-char end)
 592                 (save-excursion
 593                   (save-restriction
 594                     (goto-char start)
 595                     (narrow-to-region start end)
 596                     (nnbabyl-save-mail)
 597                     (setq end (point-max))))))
 598           (goto-char (setq start end)))
 599         (and (buffer-modified-p (current-buffer)) (save-buffer))
 600         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
 601
 602 (defun nnbabyl-remove-incoming-delims ()
 603   (goto-char (point-min))
 604   (while (search-forward "\^_" nil t)
 605     (replace-match "?" t t)))
 606
 607 (provide 'nnbabyl)
 608
 609 ;;; nnbabyl.el ends here