diff lisp/gnus/nnmbox.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8b8b7f3559a2
children 0d2f883870bc
line wrap: on
line diff
--- a/lisp/gnus/nnmbox.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/gnus/nnmbox.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,5 +1,5 @@
 ;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -25,7 +25,7 @@
 ;;; Commentary:
 
 ;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.  
 
 ;;; Code:
 
@@ -82,21 +82,22 @@
 	(setq article (car sequence))
 	(setq art-string (nnmbox-article-string article))
 	(set-buffer nnmbox-mbox-buffer)
-	(when (or (search-forward art-string nil t)
-		  (progn (goto-char (point-min))
-			 (search-forward art-string nil t)))
-	  (setq start
-		(save-excursion
-		  (re-search-backward
-		   (concat "^" message-unix-mail-delimiter) nil t)
-		  (point)))
-	  (search-forward "\n\n" nil t)
-	  (setq stop (1- (point)))
-	  (set-buffer nntp-server-buffer)
-	  (insert (format "221 %d Article retrieved.\n" article))
-	  (insert-buffer-substring nnmbox-mbox-buffer start stop)
-	  (goto-char (point-max))
-	  (insert ".\n"))
+	(if (or (search-forward art-string nil t)
+		(progn (goto-char (point-min))
+		       (search-forward art-string nil t)))
+	    (progn
+	      (setq start 
+		    (save-excursion
+		      (re-search-backward 
+		       (concat "^" message-unix-mail-delimiter) nil t)
+		      (point)))
+	      (search-forward "\n\n" nil t)
+	      (setq stop (1- (point)))
+	      (set-buffer nntp-server-buffer)
+	      (insert (format "221 %d Article retrieved.\n" article))
+	      (insert-buffer-substring nnmbox-mbox-buffer start stop)
+	      (goto-char (point-max))
+	      (insert ".\n")))
 	(setq sequence (cdr sequence))
 	(setq count (1+ count))
 	(and (numberp nnmail-large-newsgroup)
@@ -115,8 +116,7 @@
 
 (deffoo nnmbox-open-server (server &optional defs)
   (nnoo-change-server 'nnmbox server defs)
-  (nnmbox-create-mbox)
-  (cond
+  (cond 
    ((not (file-exists-p nnmbox-mbox-file))
     (nnmbox-close-server)
     (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file))
@@ -147,32 +147,32 @@
   (save-excursion
     (set-buffer nnmbox-mbox-buffer)
     (goto-char (point-min))
-    (when (search-forward (nnmbox-article-string article) nil t)
-      (let (start stop)
-	(re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
-	(setq start (point))
-	(forward-line 1)
-	(or (and (re-search-forward
-		  (concat "^" message-unix-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 nnmbox-mbox-buffer start stop)
-	  (goto-char (point-min))
-	  (while (looking-at "From ")
-	    (delete-char 5)
-	    (insert "X-From-Line: ")
-	    (forward-line 1))
-	  (if (numberp article)
-	      (cons nnmbox-current-group article)
-	    (nnmbox-article-group-number)))))))
+    (if (search-forward (nnmbox-article-string article) nil t)
+	(let (start stop)
+	  (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+	  (setq start (point))
+	  (forward-line 1)
+	  (or (and (re-search-forward 
+		    (concat "^" message-unix-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 nnmbox-mbox-buffer start stop)
+	    (goto-char (point-min))
+	    (while (looking-at "From ")
+	      (delete-char 5)
+	      (insert "X-From-Line: ")
+	      (forward-line 1))
+	    (if (numberp article) 
+		(cons nnmbox-current-group article)
+	      (nnmbox-article-group-number)))))))
 
 (deffoo nnmbox-request-group (group &optional server dont-check)
   (let ((active (cadr (assoc group nnmbox-group-alist))))
-    (cond
+    (cond 
      ((or (null active)
 	  (null (nnmbox-possibly-change-newsgroup group server)))
       (nnheader-report 'nnmbox "No such group: %s" group))
@@ -181,21 +181,19 @@
       (nnheader-insert ""))
      (t
       (nnheader-report 'nnmbox "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 nnmbox-request-scan (&optional group server)
-  (nnmbox-possibly-change-newsgroup group server)
   (nnmbox-read-mbox)
-  (nnmail-get-new-mail
-   'nnmbox
+  (nnmail-get-new-mail 
+   'nnmbox 
    (lambda ()
      (save-excursion
        (set-buffer nnmbox-mbox-buffer)
        (save-buffer)))
-   (file-name-directory nnmbox-mbox-file)
-   group
+   nnmbox-mbox-file group
    (lambda ()
      (save-excursion
        (let ((in-buf (current-buffer)))
@@ -210,8 +208,7 @@
 (deffoo nnmbox-request-list (&optional server)
   (save-excursion
     (nnmail-find-file nnmbox-active-file)
-    (setq nnmbox-group-alist (nnmail-get-active))
-    t))
+    (setq nnmbox-group-alist (nnmail-get-active))))
 
 (deffoo nnmbox-request-newgroups (date &optional server)
   (nnmbox-request-list server))
@@ -219,28 +216,28 @@
 (deffoo nnmbox-request-list-newsgroups (&optional server)
   (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
 
-(deffoo nnmbox-request-expire-articles
+(deffoo nnmbox-request-expire-articles 
   (articles newsgroup &optional server force)
   (nnmbox-possibly-change-newsgroup newsgroup server)
   (let* ((is-old t)
 	 rest)
     (nnmail-activate 'nnmbox)
 
-    (save-excursion
+    (save-excursion 
       (set-buffer nnmbox-mbox-buffer)
       (while (and articles is-old)
 	(goto-char (point-min))
-	(when (search-forward (nnmbox-article-string (car articles)) nil t)
-	  (if (setq is-old
-		    (nnmail-expired-article-p
-		     newsgroup
-		     (buffer-substring
-		      (point) (progn (end-of-line) (point))) force))
-	      (progn
-		(nnheader-message 5 "Deleting article %d in %s..."
-				  (car articles) newsgroup)
-		(nnmbox-delete-mail))
-	    (push (car articles) rest)))
+	(if (search-forward (nnmbox-article-string (car articles)) nil t)
+	    (if (setq is-old
+		      (nnmail-expired-article-p
+		       newsgroup
+		       (buffer-substring 
+			(point) (progn (end-of-line) (point))) force))
+		(progn
+		  (nnheader-message 5 "Deleting article %d in %s..."
+				    (car articles) newsgroup)
+		  (nnmbox-delete-mail))
+	      (setq rest (cons (car articles) rest))))
 	(setq articles (cdr articles)))
       (save-buffer)
       ;; Find the lowest active article in this group.
@@ -256,9 +253,10 @@
 
 (deffoo nnmbox-request-move-article
   (article group server accept-form &optional last)
+  (nnmbox-possibly-change-newsgroup group server)
   (let ((buf (get-buffer-create " *nnmbox move*"))
 	result)
-    (and
+    (and 
      (nnmbox-request-article article group server)
      (save-excursion
        (set-buffer buf)
@@ -266,8 +264,8 @@
        (erase-buffer)
        (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))))
@@ -275,11 +273,10 @@
        (kill-buffer buf)
        result)
      (save-excursion
-       (nnmbox-possibly-change-newsgroup group server)
        (set-buffer nnmbox-mbox-buffer)
        (goto-char (point-min))
-       (when (search-forward (nnmbox-article-string article) nil t)
-	 (nnmbox-delete-mail))
+       (if (search-forward (nnmbox-article-string article) nil t)
+	   (nnmbox-delete-mail))
        (and last (save-buffer))))
     result))
 
@@ -295,7 +292,7 @@
     (if (looking-at "X-From-Line: ")
 	(replace-match "From ")
       (insert "From nobody " (current-time-string) "\n"))
-    (and
+    (and 
      (nnmail-activate 'nnmbox)
      (progn
        (set-buffer buf)
@@ -304,24 +301,15 @@
        (forward-line -1)
        (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
 	 (delete-region (point) (progn (forward-line 1) (point))))
-       (when nnmail-cache-accepted-message-ids
-	 (nnmail-cache-insert (nnmail-fetch-field "message-id")))
-       (setq result (if (stringp group)
-			(list (cons group (nnmbox-active-number group)))
-		      (nnmail-article-group 'nnmbox-active-number)))
-       (if (null result)
-	   (setq result 'junk)
-	 (setq result (car (nnmbox-save-mail result)))))
+       (setq result (nnmbox-save-mail (and (stringp group) group))))
      (save-excursion
        (set-buffer nnmbox-mbox-buffer)
        (goto-char (point-max))
        (insert-buffer-substring buf)
-       (when last
-	 (when nnmail-cache-accepted-message-ids
-	   (nnmail-cache-close))
-	 (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
-	 (save-buffer))))
-    result))
+       (and last (save-buffer))
+       result)
+     (nnmail-save-active nnmbox-group-alist nnmbox-active-file))
+    (car result)))
 
 (deffoo nnmbox-request-replace-article (article group buffer)
   (nnmbox-possibly-change-newsgroup group)
@@ -349,10 +337,9 @@
 	(while (search-forward ident nil t)
 	  (setq found t)
 	  (nnmbox-delete-mail))
-	(when found
-	  (save-buffer)))))
+	(and found (save-buffer)))))
   ;; Remove the group from all structures.
-  (setq nnmbox-group-alist
+  (setq nnmbox-group-alist 
 	(delq (assoc group nnmbox-group-alist) nnmbox-group-alist)
 	nnmbox-current-group nil)
   ;; Save the active file.
@@ -370,11 +357,9 @@
       (while (search-forward ident nil t)
 	(replace-match new-ident t t)
 	(setq found t))
-      (when found
-	(save-buffer))))
+      (and found (save-buffer))))
   (let ((entry (assoc group nnmbox-group-alist)))
-    (when entry
-      (setcar entry new-name))
+    (and entry (setcar entry new-name))
     (setq nnmbox-current-group nil)
     ;; Save the new group alist.
     (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
@@ -384,7 +369,7 @@
 ;;; Internal functions.
 
 ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
-;; headers there are.  If LEAVE-DELIM, don't delete the Unix mbox
+;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
 ;; delimiter line.
 (defun nnmbox-delete-mail (&optional force leave-delim)
   ;; Delete the current X-Gnus-Newsgroup line.
@@ -402,7 +387,7 @@
 	   (match-beginning 0)))
        (progn
 	 (forward-line 1)
-	 (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
+	 (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) 
 				     nil t)
 		  (if (and (not (bobp)) leave-delim)
 		      (progn (forward-line -2) (point))
@@ -410,45 +395,48 @@
 	     (point-max))))
       (goto-char (point-min))
       ;; Only delete the article if no other groups owns it as well.
-      (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
-	(delete-region (point-min) (point-max))))))
+      (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+	  (delete-region (point-min) (point-max))))))
 
 (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
-  (when (and server
+  (when (and server 
 	     (not (nnmbox-server-opened server)))
     (nnmbox-open-server server))
-  (when (or (not nnmbox-mbox-buffer)
-	    (not (buffer-name nnmbox-mbox-buffer)))
-    (save-excursion
-      (set-buffer (setq nnmbox-mbox-buffer
-			(nnheader-find-file-noselect
-			 nnmbox-mbox-file nil 'raw)))
-      (buffer-disable-undo (current-buffer))))
-  (when (not nnmbox-group-alist)
-    (nnmail-activate 'nnmbox))
+  (if (or (not nnmbox-mbox-buffer)
+	  (not (buffer-name nnmbox-mbox-buffer)))
+      (save-excursion
+	(set-buffer (setq nnmbox-mbox-buffer 
+			  (nnheader-find-file-noselect
+			   nnmbox-mbox-file nil 'raw)))
+	(buffer-disable-undo (current-buffer))))
+  (if (not nnmbox-group-alist)
+      (nnmail-activate 'nnmbox))
   (if newsgroup
-      (when (assoc newsgroup nnmbox-group-alist)
-	(setq nnmbox-current-group newsgroup))
+      (if (assoc newsgroup nnmbox-group-alist)
+	  (setq nnmbox-current-group newsgroup))
     t))
 
 (defun nnmbox-article-string (article)
   (if (numberp article)
-      (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"
+      (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" 
 	      (int-to-string article) " ")
     (concat "\nMessage-ID: " article)))
 
 (defun nnmbox-article-group-number ()
   (save-excursion
     (goto-char (point-min))
-    (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
-			     nil t)
-      (cons (buffer-substring (match-beginning 1) (match-end 1))
-	    (string-to-int
-	     (buffer-substring (match-beginning 2) (match-end 2)))))))
+    (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
+			    nil t)
+	 (cons (buffer-substring (match-beginning 1) (match-end 1))
+	       (string-to-int
+		(buffer-substring (match-beginning 2) (match-end 2)))))))
 
-(defun nnmbox-save-mail (group-art)
+(defun nnmbox-save-mail (&optional group)
   "Called narrowed to an article."
-  (let ((delim (concat "^" message-unix-mail-delimiter)))
+  (let* ((nnmail-split-methods 
+	  (if group (list (list group "")) nnmail-split-methods))
+	 (group-art (nreverse (nnmail-article-group 'nnmbox-active-number)))
+	 (delim (concat "^" message-unix-mail-delimiter)))
     (goto-char (point-min))
     ;; This might come from somewhere else.
     (unless (looking-at delim)
@@ -469,13 +457,14 @@
 (defun nnmbox-insert-newsgroup-line (group-art)
   (save-excursion
     (goto-char (point-min))
-    (when (search-forward "\n\n" nil t)
-      (forward-char -1)
-      (while group-art
-	(insert (format "X-Gnus-Newsgroup: %s:%d   %s\n"
-			(caar group-art) (cdar group-art)
-			(current-time-string)))
-	(setq group-art (cdr group-art))))
+    (if (search-forward "\n\n" nil t)
+	(progn
+	  (forward-char -1)
+	  (while group-art
+	    (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
+			    (caar group-art) (cdar group-art)
+			    (current-time-string)))
+	    (setq group-art (cdr group-art)))))
     t))
 
 (defun nnmbox-active-number (group)
@@ -486,17 +475,14 @@
       ;; This group is new, so we create a new entry for it.
       ;; This might be a bit naughty... creating groups on the drop of
       ;; a hat, but I don't know...
-      (push (list group (setq active (cons 1 1)))
-	    nnmbox-group-alist))
+      (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1)))
+				     nnmbox-group-alist)))
     (cdr active)))
 
-(defun nnmbox-create-mbox ()
-  (when (not (file-exists-p nnmbox-mbox-file))
-    (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))
-
 (defun nnmbox-read-mbox ()
   (nnmail-activate 'nnmbox)
-  (nnmbox-create-mbox)
+  (if (not (file-exists-p nnmbox-mbox-file))
+      (write-region 1 1 nnmbox-mbox-file t 'nomesg))
   (if (and nnmbox-mbox-buffer
 	   (buffer-name nnmbox-mbox-buffer)
 	   (save-excursion
@@ -507,7 +493,7 @@
       (let ((delim (concat "^" message-unix-mail-delimiter))
 	    (alist nnmbox-group-alist)
 	    start end number)
-	(set-buffer (setq nnmbox-mbox-buffer
+	(set-buffer (setq nnmbox-mbox-buffer 
 			  (nnheader-find-file-noselect
 			   nnmbox-mbox-file nil 'raw)))
 	(buffer-disable-undo (current-buffer))
@@ -520,30 +506,29 @@
 		      (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
 			      (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)))
 	  (setq alist (cdr alist)))
-
+	
 	(goto-char (point-min))
 	(while (re-search-forward delim nil t)
 	  (setq start (match-beginning 0))
-	  (when (not (search-forward "\nX-Gnus-Newsgroup: "
-				     (save-excursion
-				       (setq end
-					     (or
-					      (and
-					       (re-search-forward delim nil t)
-					       (match-beginning 0))
-					      (point-max))))
-				     t))
-	    (save-excursion
-	      (save-restriction
-		(narrow-to-region start end)
-		(nnmbox-save-mail
-		 (nnmail-article-group 'nnmbox-active-number)))))
+	  (if (not (search-forward "\nX-Gnus-Newsgroup: " 
+				   (save-excursion 
+				     (setq end
+					   (or
+					    (and
+					     (re-search-forward delim nil t)
+					     (match-beginning 0))
+					    (point-max))))
+				   t))
+	      (save-excursion
+		(save-restriction
+		  (narrow-to-region start end)
+		  (nnmbox-save-mail))))
 	  (goto-char end))))))
 
 (provide 'nnmbox)