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* ((is-old t)
 278          rest)
 279     (nnmail-activate 'nnbabyl)
 280
 281     (save-excursion
 282       (set-buffer nnbabyl-mbox-buffer)
 283       (set-text-properties (point-min) (point-max) nil)
 284       (while (and articles is-old)
 285         (goto-char (point-min))
 286         (if (search-forward (nnbabyl-article-string (car articles)) nil t)
 287             (if (setq is-old
 288                       (nnmail-expired-article-p
 289                        newsgroup
 290                        (buffer-substring
 291                         (point) (progn (end-of-line) (point))) force))
 292                 (progn
 293                   (and gnus-verbose-backends
 294                        (message "Deleting article %d in %s..."
 295                                 (car articles) newsgroup))
 296                   (nnbabyl-delete-mail))
 297               (setq rest (cons (car articles) rest))))
 298         (setq articles (cdr articles)))
 299       (save-buffer)
 300       ;; Find the lowest active article in this group.
 301       (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
 302         (goto-char (point-min))
 303         (while (and (not (search-forward
 304                           (nnbabyl-article-string (car active)) nil t))
 305                     (<= (car active) (cdr active)))
 306           (setcar active (1+ (car active)))
 307           (goto-char (point-min))))
 308       (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 309       (nconc rest articles))))
 310
 311 (defun nnbabyl-request-move-article
 312   (article group server accept-form &optional last)
 313   (nnbabyl-possibly-change-newsgroup group)
 314   (let ((buf (get-buffer-create " *nnbabyl move*"))
 315         result)
 316     (and
 317      (nnbabyl-request-article article group server)
 318      (save-excursion
 319        (set-buffer buf)
 320        (insert-buffer-substring nntp-server-buffer)
 321        (goto-char (point-min))
 322        (if (re-search-forward
 323             "^X-Gnus-Newsgroup:"
 324             (save-excursion (search-forward "\n\n" nil t) (point)) t)
 325            (delete-region (progn (beginning-of-line) (point))
 326                           (progn (forward-line 1) (point))))
 327        (setq result (eval accept-form))
 328        (kill-buffer (current-buffer))
 329        result)
 330      (save-excursion
 331        (set-buffer nnbabyl-mbox-buffer)
 332        (goto-char (point-min))
 333        (if (search-forward (nnbabyl-article-string article) nil t)
 334            (nnbabyl-delete-mail))
 335        (and last (save-buffer))))
 336     result))
 337
 338 (defun nnbabyl-request-accept-article (group &optional last)
 339   (let ((buf (current-buffer))
 340         result beg)
 341     (and
 342      (nnmail-activate 'nnbabyl)
 343      (save-excursion
 344        (goto-char (point-min))
 345        (search-forward "\n\n" nil t)
 346        (forward-line -1)
 347        (save-excursion
 348          (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
 349            (delete-region (point) (progn (forward-line 1) (point)))))
 350        (let ((nnmail-split-methods
 351               (if (stringp group) (list (list group ""))
 352                 nnmail-split-methods)))
 353          (setq result (car (nnbabyl-save-mail))))
 354        (set-buffer nnbabyl-mbox-buffer)
 355        (goto-char (point-max))
 356        (search-backward "\n\^_")
 357        (goto-char (match-end 0))
 358        (insert-buffer-substring buf)
 359        (and last (progn
 360                    (save-buffer)
 361                    (nnmail-save-active
 362                     nnbabyl-group-alist nnbabyl-active-file)))
 363        result))))
 364
 365 (defun nnbabyl-request-replace-article (article group buffer)
 366   (nnbabyl-possibly-change-newsgroup group)
 367   (save-excursion
 368     (set-buffer nnbabyl-mbox-buffer)
 369     (goto-char (point-min))
 370     (if (not (search-forward (nnbabyl-article-string article) nil t))
 371         nil
 372       (nnbabyl-delete-mail t t)
 373       (insert-buffer-substring buffer)
 374       (save-buffer)
 375       t)))
 376
 377 (defun nnbabyl-request-delete-group (group &optional force server)
 378   (nnbabyl-possibly-change-newsgroup group)
 379   ;; Delete all articles in GROUP.
 380   (if (not force)
 381       ()                                ; Don't delete the articles.
 382     (save-excursion
 383       (set-buffer nnbabyl-mbox-buffer)
 384       (goto-char (point-min))
 385       ;; Delete all articles in this group.
 386       (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
 387             found)
 388         (while (search-forward ident nil t)
 389           (setq found t)
 390           (nnbabyl-delete-mail))
 391         (and found (save-buffer)))))
 392   ;; Remove the group from all structures.
 393   (setq nnbabyl-group-alist
 394         (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
 395         nnbabyl-current-group nil)
 396   ;; Save the active file.
 397   (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 398   t)
 399
 400 (defun nnbabyl-request-rename-group (group new-name &optional server)
 401   (nnbabyl-possibly-change-newsgroup group)
 402   (save-excursion
 403     (set-buffer nnbabyl-mbox-buffer)
 404     (goto-char (point-min))
 405     (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
 406           (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
 407           found)
 408       (while (search-forward ident nil t)
 409         (replace-match new-ident t t)
 410         (setq found t))
 411       (and found (save-buffer))))
 412   (let ((entry (assoc group nnbabyl-group-alist)))
 413     (and entry (setcar entry new-name))
 414     (setq nnbabyl-current-group nil)
 415     ;; Save the new group alist.
 416     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
 417     t))
 418
 419 \f
 420 ;;; Internal functions.
 421
 422 ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
 423 ;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
 424 ;; delimeter line.
 425 (defun nnbabyl-delete-mail (&optional force leave-delim)
 426   ;; Delete the current X-Gnus-Newsgroup line.
 427   (or force
 428       (delete-region
 429        (progn (beginning-of-line) (point))
 430        (progn (forward-line 1) (point))))
 431   ;; Beginning of the article.
 432   (save-excursion
 433     (save-restriction
 434       (widen)
 435       (narrow-to-region
 436        (save-excursion
 437          (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
 438          (if leave-delim (progn (forward-line 1) (point))
 439            (match-beginning 0)))
 440        (progn
 441          (forward-line 1)
 442          (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter)
 443                                      nil t)
 444                   (if (and (not (bobp)) leave-delim)
 445                       (progn (forward-line -2) (point))
 446                     (match-beginning 0)))
 447              (point-max))))
 448       (goto-char (point-min))
 449       ;; Only delete the article if no other groups owns it as well.
 450       (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
 451           (delete-region (point-min) (point-max))))))
 452
 453 (defun nnbabyl-possibly-change-newsgroup (newsgroup)
 454   (if (or (not nnbabyl-mbox-buffer)
 455           (not (buffer-name nnbabyl-mbox-buffer)))
 456       (save-excursion (nnbabyl-read-mbox)))
 457   (or nnbabyl-group-alist
 458       (nnmail-activate 'nnbabyl))
 459   (if newsgroup
 460       (if (assoc newsgroup nnbabyl-group-alist)
 461           (setq nnbabyl-current-group newsgroup)
 462         (setq nnbabyl-status-string "No such group in file")
 463         nil)))
 464
 465 (defun nnbabyl-article-string (article)
 466   (if (numberp article)
 467       (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
 468               (int-to-string article) " ")
 469     (concat "\nMessage-ID: " article)))
 470
 471 (defun nnbabyl-article-group-number ()
 472   (save-excursion
 473     (goto-char (point-min))
 474     (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
 475                             nil t)
 476          (cons (buffer-substring (match-beginning 1) (match-end 1))
 477                (string-to-int
 478                 (buffer-substring (match-beginning 2) (match-end 2)))))))
 479
 480 (defun nnbabyl-insert-lines ()
 481   "Insert how many lines and chars there are in the body of the mail."
 482   (let (lines chars)
 483     (save-excursion
 484       (goto-char (point-min))
 485       (if (search-forward "\n\n" nil t)
 486           (progn
 487             ;; There may be an EOOH line here...
 488             (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 489                 (search-forward "\n\n" nil t))
 490             (setq chars (- (point-max) (point)))
 491             (setq lines (- (count-lines (point) (point-max)) 1))
 492             ;; Move back to the end of the headers.
 493             (goto-char (point-min))
 494             (search-forward "\n\n" nil t)
 495             (forward-char -1)
 496             (save-excursion
 497               (if (re-search-backward "^Lines: " nil t)
 498                   (delete-region (point) (progn (forward-line 1) (point)))))
 499             (insert (format "Lines: %d\n" lines))
 500             chars)))))
 501
 502 (defun nnbabyl-save-mail ()
 503   ;; Called narrowed to an article.
 504   (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number))))
 505     (nnbabyl-insert-lines)
 506     (nnmail-insert-xref group-art)
 507     (nnbabyl-insert-newsgroup-line group-art)
 508     (run-hooks 'nnbabyl-prepare-save-mail-hook)
 509     group-art))
 510
 511 (defun nnbabyl-insert-newsgroup-line (group-art)
 512   (save-excursion
 513     (goto-char (point-min))
 514     (while (looking-at "From ")
 515       (replace-match "Mail-from: From " t t)
 516       (forward-line 1))
 517     ;; If there is a C-l at the beginning of the narrowed region, this
 518     ;; isn't really a "save", but rather a "scan".
 519     (goto-char (point-min))
 520     (or (looking-at "\^L")
 521         (save-excursion
 522           (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
 523           (goto-char (point-max))
 524           (insert "\^_\n")))
 525     (if (search-forward "\n\n" nil t)
 526         (progn
 527           (forward-char -1)
 528           (while group-art
 529             (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n"
 530                             (car (car group-art)) (cdr (car group-art))
 531                             (current-time-string)))
 532             (setq group-art (cdr group-art)))))
 533     t))
 534
 535 (defun nnbabyl-active-number (group)
 536   ;; Find the next article number in GROUP.
 537   (let ((active (car (cdr (assoc group nnbabyl-group-alist)))))
 538     (if active
 539         (setcdr active (1+ (cdr active)))
 540       ;; This group is new, so we create a new entry for it.
 541       ;; This might be a bit naughty... creating groups on the drop of
 542       ;; a hat, but I don't know...
 543       (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1)))
 544                                       nnbabyl-group-alist)))
 545     (cdr active)))
 546
 547 (defun nnbabyl-read-mbox ()
 548   (nnmail-activate 'nnbabyl)
 549   (or (file-exists-p nnbabyl-mbox-file)
 550       (save-excursion
 551         (set-buffer (setq nnbabyl-mbox-buffer
 552                           (create-file-buffer nnbabyl-mbox-file)))
 553         (setq buffer-file-name nnbabyl-mbox-file)
 554         (insert "BABYL OPTIONS:\n\n\^_")
 555         (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
 556
 557   (if (and nnbabyl-mbox-buffer
 558            (buffer-name nnbabyl-mbox-buffer)
 559            (save-excursion
 560              (set-buffer nnbabyl-mbox-buffer)
 561              (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file)))))
 562       ()
 563     (save-excursion
 564       (let ((delim (concat "^" nnbabyl-mail-delimiter))
 565             start end)
 566         (set-buffer (setq nnbabyl-mbox-buffer
 567                           (nnheader-find-file-noselect
 568                            nnbabyl-mbox-file nil 'raw)))
 569         ;; Save buffer mode.
 570         (setq nnbabyl-previous-buffer-mode
 571               (cons (cons (point-min) (point-max))
 572                     major-mode))
 573
 574         (buffer-disable-undo (current-buffer))
 575         (widen)
 576         (setq buffer-read-only nil)
 577         (fundamental-mode)
 578
 579         (goto-char (point-min))
 580         (re-search-forward delim nil t)
 581         (setq start (match-end 0))
 582         (while (re-search-forward delim nil t)
 583           (setq end (match-end 0))
 584           (or (search-backward "\nX-Gnus-Newsgroup: " start t)
 585               (progn
 586                 (goto-char end)
 587                 (save-excursion
 588                   (save-restriction
 589                     (goto-char start)
 590                     (narrow-to-region start end)
 591                     (nnbabyl-save-mail)
 592                     (setq end (point-max))))))
 593           (goto-char (setq start end)))
 594         (and (buffer-modified-p (current-buffer)) (save-buffer))
 595         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
 596
 597 (defun nnbabyl-remove-incoming-delims ()
 598   (goto-char (point-min))
 599   (while (search-forward "\^_" nil t)
 600     (replace-match "?" t t)))
 601
 602 (provide 'nnbabyl)
 603
 604 ;;; nnbabyl.el ends here