Patch by Ed L. Cashin to make gnus-move-split-methods move to
[gnus] / lisp / nnbabyl.el
index 5542804..ee82489 100644 (file)
@@ -1,7 +1,7 @@
 ;;; nnbabyl.el --- rmail mbox access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 
 ;;; Commentary:
 
 ;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
+;; Gnus sources.
 
 ;;; Code:
 
 (require 'nnheader)
-(require 'rmail)
+(condition-case nil
+    (require 'rmail)
+  (t (nnheader-message
+      5 "Ignore rmail errors from this file, you don't have rmail")))
 (require 'nnmail)
 (require 'nnoo)
 (eval-when-compile (require 'cl))
       (while (setq article (pop articles))
        (setq art-string (nnbabyl-article-string article))
        (set-buffer nnbabyl-mbox-buffer)
-       (beginning-of-line)
+       (end-of-line)
        (when (or (search-forward art-string nil t)
                  (search-backward art-string nil t))
-         (re-search-backward delim nil t)
+         (unless (re-search-backward delim nil t)
+           (goto-char (point-min)))
          (while (and (not (looking-at ".+:"))
                      (zerop (forward-line 1))))
          (setq start (point))
 (deffoo nnbabyl-open-server (server &optional defs)
   (nnoo-change-server 'nnbabyl server defs)
   (nnbabyl-create-mbox)
-  (cond 
+  (cond
    ((not (file-exists-p nnbabyl-mbox-file))
     (nnbabyl-close-server)
     (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
     (goto-char (point-min))
     (when (search-forward (nnbabyl-article-string article) nil t)
       (let (start stop summary-line)
-       (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+       (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+         (goto-char (point-min))
+         (end-of-line))
        (while (and (not (looking-at ".+:"))
                    (zerop (forward-line 1))))
        (setq start (point))
-       (or (when (re-search-forward 
+       (or (when (re-search-forward
                   (concat "^" nnbabyl-mail-delimiter) nil t)
              (beginning-of-line)
              t)
          (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. 
+         ;; duplicated headers.
          (setq summary-line (looking-at "Summary-line:"))
          (when (search-forward "\n*** EOOH ***" nil t)
            (if summary-line
 (deffoo nnbabyl-request-group (group &optional server dont-check)
   (let ((active (cadr (assoc group nnbabyl-group-alist))))
     (save-excursion
-      (cond 
+      (cond
        ((or (null active)
            (null (nnbabyl-possibly-change-newsgroup group server)))
        (nnheader-report 'nnbabyl "No such group: %s" group))
        (nnheader-insert ""))
        (t
        (nnheader-report 'nnbabyl "Selected group %s" group)
-       (nnheader-insert "211 %d %d %d %s\n" 
+       (nnheader-insert "211 %d %d %d %s\n"
                         (1+ (- (cdr active) (car active)))
                         (car active) (cdr active) group))))))
 
 (deffoo nnbabyl-request-scan (&optional group server)
   (nnbabyl-possibly-change-newsgroup group server)
   (nnbabyl-read-mbox)
-  (nnmail-get-new-mail 
-   'nnbabyl 
+  (nnmail-get-new-mail
+   'nnbabyl
    (lambda ()
      (save-excursion
        (set-buffer nnbabyl-mbox-buffer)
        (save-buffer)))
-   nnbabyl-mbox-file group
+   (file-name-directory nnbabyl-mbox-file)
+   group
    (lambda ()
      (save-excursion
        (let ((in-buf (current-buffer)))
   (nnmail-activate 'nnbabyl)
   (unless (assoc group nnbabyl-group-alist)
     (push (list group (cons 1 0))
-                                   nnbabyl-group-alist)
+         nnbabyl-group-alist)
     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
   t)
 
   (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
 
 (deffoo nnbabyl-request-expire-articles
-  (articles newsgroup &optional server force)
+    (articles newsgroup &optional server force)
   (nnbabyl-possibly-change-newsgroup newsgroup server)
   (let* ((is-old t)
         rest)
     (nnmail-activate 'nnbabyl)
 
-    (save-excursion 
+    (save-excursion
       (set-buffer nnbabyl-mbox-buffer)
       (gnus-set-text-properties (point-min) (point-max) nil)
       (while (and articles is-old)
          (if (setq is-old
                    (nnmail-expired-article-p
                     newsgroup
-                    (buffer-substring 
+                    (buffer-substring
                      (point) (progn (end-of-line) (point))) force))
              (progn
-               (nnheader-message 5 "Deleting article %d in %s..." 
+               (nnheader-message 5 "Deleting article %d in %s..."
                                  (car articles) newsgroup)
                (nnbabyl-delete-mail))
            (push (car articles) rest)))
       (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
       (nconc rest articles))))
 
-(deffoo nnbabyl-request-move-article 
-  (article group server accept-form &optional last)
+(deffoo nnbabyl-request-move-article
+    (article group server accept-form &optional last)
   (let ((buf (get-buffer-create " *nnbabyl move*"))
        result)
-    (and 
+    (and
      (nnbabyl-request-article article group server)
      (save-excursion
        (set-buffer buf)
        (insert-buffer-substring nntp-server-buffer)
        (goto-char (point-min))
-       (while (re-search-forward 
-              "^X-Gnus-Newsgroup:" 
+       (while (re-search-forward
+              "^X-Gnus-Newsgroup:"
               (save-excursion (search-forward "\n\n" nil t) (point)) t)
         (delete-region (progn (beginning-of-line) (point))
                        (progn (forward-line 1) (point))))
   (nnmail-check-syntax)
   (let ((buf (current-buffer))
        result beg)
-    (and 
+    (and
      (nnmail-activate 'nnbabyl)
      (save-excursion
        (goto-char (point-min))
        (save-excursion
         (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
           (delete-region (point) (progn (forward-line 1) (point)))))
-       (setq result (car (nnbabyl-save-mail
-                         (if (stringp group)
-                             (list (cons group (nnbabyl-active-number group)))
-                           (nnmail-article-group 'nnbabyl-active-number)))))
+       (when nnmail-cache-accepted-message-ids
+        (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+       (setq result
+            (if (stringp group)
+                (list (cons group (nnbabyl-active-number group)))
+              (nnmail-article-group 'nnbabyl-active-number)))
+       (if (and (null result)
+               (yes-or-no-p "Moved to `junk' group; delete article? "))
+          (setq result 'junk)
+        (setq result (car (nnbabyl-save-mail result))))
        (set-buffer nnbabyl-mbox-buffer)
        (goto-char (point-max))
        (search-backward "\n\^_")
        (goto-char (match-end 0))
        (insert-buffer-substring buf)
        (when last
+        (when nnmail-cache-accepted-message-ids
+          (nnmail-cache-insert (nnmail-fetch-field "message-id")))
         (save-buffer)
         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
        result))))
        (when found
          (save-buffer)))))
   ;; Remove the group from all structures.
-  (setq nnbabyl-group-alist 
+  (setq nnbabyl-group-alist
        (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
        nnbabyl-current-group nil)
   ;; Save the active file.
       (widen)
       (narrow-to-region
        (save-excursion
-        (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+        (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+          (goto-char (point-min))
+          (end-of-line))
         (if leave-delim (progn (forward-line 1) (point))
           (match-beginning 0)))
        (progn
        (delete-region (point-min) (point-max))))))
 
 (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
-  (when (and server 
+  (when (and server
             (not (nnbabyl-server-opened server)))
     (nnbabyl-open-server server))
   (when (or (not nnbabyl-mbox-buffer)
 
 (defun nnbabyl-article-string (article)
   (if (numberp article)
-      (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" 
+      (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
              (int-to-string article) " ")
     (concat "\nMessage-ID: " article)))
 
          (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. 
+       ;; Move back to the end of the headers.
        (goto-char (point-min))
        (search-forward "\n\n" nil t)
        (forward-char -1)
     (when (search-forward "\n\n" nil t)
       (forward-char -1)
       (while group-art
-       (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
+       (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n"
                        (caar group-art) (cdar group-art)
                        (current-time-string)))
        (setq group-art (cdr group-art))))
   (nnmail-activate 'nnbabyl)
   (nnbabyl-create-mbox)
 
-  (if (and nnbabyl-mbox-buffer
-          (buffer-name nnbabyl-mbox-buffer)
-          (save-excursion
-            (set-buffer nnbabyl-mbox-buffer)
-            (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
-      ()                               ; This buffer hasn't changed since we read it last.  Possibly.
+  (unless (and nnbabyl-mbox-buffer
+              (buffer-name nnbabyl-mbox-buffer)
+              (save-excursion
+                (set-buffer nnbabyl-mbox-buffer)
+                (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
+    ;; This buffer has changed since we read it last.  Possibly.
     (save-excursion
       (let ((delim (concat "^" nnbabyl-mail-delimiter))
            (alist nnbabyl-group-alist)
            start end number)
-       (set-buffer (setq nnbabyl-mbox-buffer 
-                         (nnheader-find-file-noselect 
-                          nnbabyl-mbox-file nil 'raw)))
+       (set-buffer (setq nnbabyl-mbox-buffer
+                         (nnheader-find-file-noselect
+                          nnbabyl-mbox-file nil t)))
        ;; Save previous buffer mode.
-       (setq nnbabyl-previous-buffer-mode 
+       (setq nnbabyl-previous-buffer-mode
              (cons (cons (point-min) (point-max))
                    major-mode))
 
-       (buffer-disable-undo (current-buffer))
+       (buffer-disable-undo)
        (widen)
        (setq buffer-read-only nil)
        (fundamental-mode)
                              (caar alist))
                      nil t)
                     (> (setq number
-                             (string-to-number 
+                             (string-to-number
                               (buffer-substring
                                (match-beginning 1) (match-end 1))))
                        (cdadar alist)))
-           (setcdr (cadar alist) (1+ number)))
+           (setcdr (cadar alist) number))
          (setq alist (cdr alist)))
-       
-       ;; We go through the mbox and make sure that each and 
+
+       ;; 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))
+       (if (looking-at "\^L")
+           (setq start (point))
+         (re-search-forward delim nil t)
+         (setq start (match-end 0)))
        (while (re-search-forward delim nil t)
          (setq end (match-end 0))
          (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
            (save-excursion
              (save-restriction
                (narrow-to-region (goto-char start) end)
-               (nnbabyl-save-mail 
+               (nnbabyl-save-mail
                 (nnmail-article-group 'nnbabyl-active-number))
                (setq end (point-max)))))
          (goto-char (setq start end)))
       (when (buffer-modified-p (current-buffer))
        (save-buffer))
       (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
-      (message ""))))
+      (nnheader-message 5 ""))))
 
 (provide 'nnbabyl)