*** empty log message ***
[gnus] / lisp / nnbabyl.el
index bb73390..c3c0266 100644 (file)
 (require 'nnheader)
 (require 'rmail)
 (require 'nnmail)
+(require 'nnoo)
 (eval-when-compile (require 'cl))
 
-(defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL")
+(nnoo-declare nnbabyl)
+
+(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
   "The name of the rmail box file in the users home directory.")
 
-(defvar nnbabyl-active-file (expand-file-name "~/.rmail-active")
+(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
   "The name of the active file for the rmail box.")
 
-(defvar nnbabyl-get-new-mail t
+(defvoo nnbabyl-get-new-mail t
   "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
 
-(defvar nnbabyl-prepare-save-mail-hook nil
+(defvoo nnbabyl-prepare-save-mail-hook nil
   "Hook run narrowed to an article before saving.")
 
 \f
 (defconst nnbabyl-version "nnbabyl 1.0"
   "nnbabyl version.")
 
-(defvar nnbabyl-mbox-buffer nil)
-(defvar nnbabyl-current-group nil)
-(defvar nnbabyl-status-string "")
-(defvar nnbabyl-group-alist nil)
-(defvar nnbabyl-active-timestamp nil)
-
-(defvar nnbabyl-previous-buffer-mode nil)
+(defvoo nnbabyl-mbox-buffer nil)
+(defvoo nnbabyl-current-group nil)
+(defvoo nnbabyl-status-string "")
+(defvoo nnbabyl-group-alist nil)
+(defvoo nnbabyl-active-timestamp nil)
 
-\f
+(defvoo nnbabyl-previous-buffer-mode nil)
 
-(defvar nnbabyl-current-server nil)
-(defvar nnbabyl-server-alist nil)
-(defvar nnbabyl-server-variables 
-  (list
-   (list 'nnbabyl-mbox-file nnbabyl-mbox-file)
-   (list 'nnbabyl-active-file nnbabyl-active-file)
-   (list 'nnbabyl-get-new-mail nnbabyl-get-new-mail)
-   '(nnbabyl-current-group nil)
-   '(nnbabyl-status-string "")
-   '(nnbabyl-previous-buffer-mode nil)
-   '(nnbabyl-group-alist nil)))
+(eval-and-compile
+  (autoload 'gnus-set-text-properties "gnus-ems"))
 
 \f
 
 ;;; Interface functions
 
-(defun nnbabyl-retrieve-headers (sequence &optional newsgroup server fetch-old)
+(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 sequence))
+    (let ((number (length articles))
          (count 0)
+         (delim (concat "^" nnbabyl-mail-delimiter))
          article art-string start stop)
-      (nnbabyl-possibly-change-newsgroup newsgroup)
-      (while sequence
-       (setq article (car sequence))
+      (nnbabyl-possibly-change-newsgroup group server)
+      (while (setq article (pop articles))
        (setq art-string (nnbabyl-article-string article))
        (set-buffer nnbabyl-mbox-buffer)
-       (if (or (search-forward art-string nil t)
-               (search-backward art-string nil t))
-           (progn
-             (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
-             (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 " (int-to-string article) " Article retrieved.\n")
-             (insert-buffer-substring nnbabyl-mbox-buffer start stop)
-             (goto-char (point-max))
-             (insert ".\n")))
-       (setq sequence (cdr sequence))
-       (setq count (1+ count))
+       (beginning-of-line)
+       (when (or (search-forward art-string nil t)
+                 (search-backward art-string nil t))
+         (re-search-backward delim nil t)
+         (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 (% count 20))
+            (zerop (% (incf count) 20))
             (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
                               (/ (* count 100) number))))
 
       (nnheader-fold-continuation-lines)
       'headers)))
 
-(defun nnbabyl-open-server (server &optional defs)
-  (nnheader-init-server-buffer)
-  (if (equal server nnbabyl-current-server)
-      t
-    (if nnbabyl-current-server
-       (setq nnbabyl-server-alist 
-             (cons (list nnbabyl-current-server
-                         (nnheader-save-variables nnbabyl-server-variables))
-                   nnbabyl-server-alist)))
-    (let ((state (assoc server nnbabyl-server-alist)))
-      (if state 
-         (progn
-           (nnheader-restore-variables (nth 1 state))
-           (setq nnbabyl-server-alist (delq state nnbabyl-server-alist)))
-       (nnheader-set-init-variables nnbabyl-server-variables defs)))
-    (setq nnbabyl-current-server server)))
-
-(defun nnbabyl-close-server (&optional server)
+(deffoo nnbabyl-open-server (server &optional defs)
+  (nnoo-change-server 'nnbabyl server defs)
+  (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
-       (car (car nnbabyl-previous-buffer-mode))
-       (cdr (car nnbabyl-previous-buffer-mode)))
+       (caar nnbabyl-previous-buffer-mode)
+       (cdar nnbabyl-previous-buffer-mode))
       (funcall (cdr nnbabyl-previous-buffer-mode))))
-  (setq nnbabyl-current-server nil
-       nnbabyl-mbox-buffer nil)
+  (nnoo-close-server 'nnbabyl server)
+  (setq nnbabyl-mbox-buffer nil)
   t)
 
-(defun nnbabyl-server-opened (&optional server)
-  (and (equal server nnbabyl-current-server)
+(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)))
 
-(defun nnbabyl-status-message (&optional server)
-  nnbabyl-status-string)
-
-(defun nnbabyl-request-article (article &optional newsgroup server buffer)
-  (nnbabyl-possibly-change-newsgroup newsgroup)
+(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))
-    (if (search-forward (nnbabyl-article-string article) nil t)
-       (let (start stop summary-line)
-         (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
-         (while (and (not (looking-at ".+:"))
-                     (zerop (forward-line 1))))
-         (setq start (point))
-         (or (and (re-search-forward 
-                   (concat "^" nnbabyl-mail-delimiter) nil t)
-                  (forward-line -1))
-             (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)))))))
-
-(defun nnbabyl-request-group (group &optional server dont-check)
+    (when (search-forward (nnbabyl-article-string article) nil t)
+      (let (start stop summary-line)
+       (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+       (while (and (not (looking-at ".+:"))
+                   (zerop (forward-line 1))))
+       (setq start (point))
+       (or (and (re-search-forward 
+                 (concat "^" nnbabyl-mail-delimiter) nil t)
+                (forward-line -1))
+           (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 
-       ((null active)
-       (nnheader-report 'nnbabyl "No such group: %s" group))
-       ((null (nnbabyl-possibly-change-newsgroup group))
+       ((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)
-       t)
+       (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)
-       t)))))
+                        (car active) (cdr active) group))))))
 
-(defun nnbabyl-request-scan (&optional group server)
+(deffoo nnbabyl-request-scan (&optional group server)
+  (nnbabyl-possibly-change-newsgroup group server)
   (nnbabyl-read-mbox)
   (nnmail-get-new-mail 
    'nnbabyl 
         (goto-char (point-max))
         (search-backward "\n\^_" nil t)
         (goto-char (match-end 0))
-        (insert-buffer-substring in-buf))))))
+        (insert-buffer-substring in-buf)))
+     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
 
-(defun nnbabyl-close-group (group &optional server)
+(deffoo nnbabyl-close-group (group &optional server)
   t)
 
-(defun nnbabyl-request-create-group (group &optional server) 
+(deffoo nnbabyl-request-create-group (group &optional server) 
   (nnmail-activate 'nnbabyl)
-  (or (assoc group nnbabyl-group-alist)
-      (let (active)
-       (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0)))
-                                       nnbabyl-group-alist))
-       (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))
+  (unless (assoc group nnbabyl-group-alist)
+    (setq nnbabyl-group-alist (cons (list group (cons 1 0))
+                                   nnbabyl-group-alist))
+    (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
   t)
 
-(defun nnbabyl-request-list (&optional server)
+(deffoo nnbabyl-request-list (&optional server)
   (save-excursion
-    (or (nnmail-find-file nnbabyl-active-file)
-       (progn
-         (setq nnbabyl-group-alist (nnmail-get-active))
-         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
-         (nnmail-find-file nnbabyl-active-file)))))
+    (nnmail-find-file nnbabyl-active-file)
+    (setq nnbabyl-group-alist (nnmail-get-active))))
 
-(defun nnbabyl-request-newgroups (date &optional server)
+(deffoo nnbabyl-request-newgroups (date &optional server)
   (nnbabyl-request-list server))
 
-(defun nnbabyl-request-list-newsgroups (&optional server)
-  (setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.")
-  nil)
+(deffoo nnbabyl-request-list-newsgroups (&optional server)
+  (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
 
-(defun nnbabyl-request-post (&optional server)
-  (mail-send-and-exit nil))
-
-(defun nnbabyl-request-expire-articles
+(deffoo nnbabyl-request-expire-articles
   (articles newsgroup &optional server force)
-  (nnbabyl-possibly-change-newsgroup newsgroup)
+  (nnbabyl-possibly-change-newsgroup newsgroup server)
   (let* ((is-old t)
         rest)
     (nnmail-activate 'nnbabyl)
 
     (save-excursion 
       (set-buffer nnbabyl-mbox-buffer)
-      (set-text-properties (point-min) (point-max) nil)
+      (gnus-set-text-properties (point-min) (point-max) nil)
       (while (and articles is-old)
        (goto-char (point-min))
        (if (search-forward (nnbabyl-article-string (car articles)) nil t)
       (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
       (nconc rest articles))))
 
-(defun nnbabyl-request-move-article 
+(deffoo nnbabyl-request-move-article 
   (article group server accept-form &optional last)
-  (nnbabyl-possibly-change-newsgroup group)
+  (nnbabyl-possibly-change-newsgroup group server)
   (let ((buf (get-buffer-create " *nnbabyl move*"))
        result)
     (and 
        (and last (save-buffer))))
     result))
 
-(defun nnbabyl-request-accept-article (group &optional last)
+(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 
        (save-excursion
         (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
           (delete-region (point) (progn (forward-line 1) (point)))))
-       (let ((nnmail-split-methods
-             (if (stringp group) (list (list group "")) 
-               nnmail-split-methods)))
-        (setq result (car (nnbabyl-save-mail))))
+       (setq result (car (nnbabyl-save-mail
+                         (if (stringp group)
+                             (list (cons group (nnbabyl-active-number group)))
+                           (nnmail-article-group 'nnbabyl-active-number)))))
        (set-buffer nnbabyl-mbox-buffer)
        (goto-char (point-max))
        (search-backward "\n\^_")
        (goto-char (match-end 0))
        (insert-buffer-substring buf)
-       (and last (progn 
-                  (save-buffer)
-                  (nnmail-save-active
-                   nnbabyl-group-alist nnbabyl-active-file)))
+       (when last
+        (save-buffer)
+        (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
        result))))
 
-(defun nnbabyl-request-replace-article (article group buffer)
+(deffoo nnbabyl-request-replace-article (article group buffer)
   (nnbabyl-possibly-change-newsgroup group)
   (save-excursion
     (set-buffer nnbabyl-mbox-buffer)
       (save-buffer)
       t)))
 
-(defun nnbabyl-request-delete-group (group &optional force server)
-  (nnbabyl-possibly-change-newsgroup group)
+(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.
   (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
   t)
 
-(defun nnbabyl-request-rename-group (group new-name &optional server)
-  (nnbabyl-possibly-change-newsgroup group)
+(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))
       (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
          (delete-region (point-min) (point-max))))))
 
-(defun nnbabyl-possibly-change-newsgroup (newsgroup)
+(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
+  (when (and server 
+            (not (nnbabyl-server-opened server)))
+    (nnbabyl-open-server server))
   (if (or (not nnbabyl-mbox-buffer)
          (not (buffer-name nnbabyl-mbox-buffer)))
       (save-excursion (nnbabyl-read-mbox)))
   (if newsgroup
       (if (assoc newsgroup nnbabyl-group-alist)
          (setq nnbabyl-current-group newsgroup)
-       (setq nnbabyl-status-string "No such group in file")
-       nil)
+       (nnheader-report 'nnbabyl "No such group in file"))
     t))
 
 (defun nnbabyl-article-string (article)
   (let (lines chars)
     (save-excursion
       (goto-char (point-min))
-      (if (search-forward "\n\n" nil t) 
-         (progn
-           ;; There may be an EOOH line here...
-           (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
-               (search-forward "\n\n" nil t))
-           (setq chars (- (point-max) (point)))
-           (setq lines (- (count-lines (point) (point-max)) 1))
-           ;; Move back to the end of the headers. 
-           (goto-char (point-min))
-           (search-forward "\n\n" nil t)
-           (forward-char -1)
-           (save-excursion
-             (if (re-search-backward "^Lines: " nil t)
-                 (delete-region (point) (progn (forward-line 1) (point)))))
-           (insert (format "Lines: %d\n" lines))
-           chars)))))
+      (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 ()
+(defun nnbabyl-save-mail (group-art)
   ;; Called narrowed to an article.
-  (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number))))
-    (nnbabyl-insert-lines)
-    (nnmail-insert-xref group-art)
-    (nnbabyl-insert-newsgroup-line group-art)
-    (run-hooks 'nnbabyl-prepare-save-mail-hook)
-    group-art))
+  (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
          (forward-char -1)
          (while group-art
            (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
-                           (car (car group-art)) (cdr (car group-art))
+                           (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 (car (cdr (assoc group nnbabyl-group-alist)))))
+  (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.
 
 (defun nnbabyl-read-mbox ()
   (nnmail-activate 'nnbabyl)
-  (or (file-exists-p nnbabyl-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\^_")
-       (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
+  (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)))
 
   (if (and nnbabyl-mbox-buffer
           (buffer-name nnbabyl-mbox-buffer)
           (save-excursion
             (set-buffer nnbabyl-mbox-buffer)
-            (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file)))))
-      ()
+            (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
+      () ; This buffer hasn't changed since we read it last.  Possibly.
     (save-excursion
       (let ((delim (concat "^" nnbabyl-mail-delimiter))
-           start end)
+           (alist nnbabyl-group-alist)
+           start end number)
        (set-buffer (setq nnbabyl-mbox-buffer 
                          (nnheader-find-file-noselect 
                           nnbabyl-mbox-file nil 'raw)))
-       ;; Save buffer mode.
+       ;; Save previous buffer mode.
        (setq nnbabyl-previous-buffer-mode 
              (cons (cons (point-min) (point-max))
                    major-mode))
        (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) (1+ 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))
        (re-search-forward delim nil t)
        (setq start (match-end 0))
        (while (re-search-forward delim nil t)
          (setq end (match-end 0))
-         (or (search-backward "\nX-Gnus-Newsgroup: " start t)
-             (progn
-               (goto-char end)
-               (save-excursion
-                 (save-restriction
-                   (goto-char start)
-                   (narrow-to-region start end)
-                   (nnbabyl-save-mail)
-                   (setq end (point-max))))))
+         (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)))
-       (and (buffer-modified-p (current-buffer)) (save-buffer))
+       (when (buffer-modified-p (current-buffer))
+         (save-buffer))
        (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
 
 (defun nnbabyl-remove-incoming-delims ()
   (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)
+      (message ""))))
+
 (provide 'nnbabyl)
 
 ;;; nnbabyl.el ends here