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