diff lisp/gnus/nnmbox.el @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children 4103f0995bd7
line wrap: on
line diff
--- a/lisp/gnus/nnmbox.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/gnus/nnmbox.el	Mon Aug 13 08:49:20 2007 +0200
@@ -1,5 +1,5 @@
 ;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -82,22 +82,21 @@
 	(setq article (car sequence))
 	(setq art-string (nnmbox-article-string article))
 	(set-buffer nnmbox-mbox-buffer)
-	(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")))
+	(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"))
 	(setq sequence (cdr sequence))
 	(setq count (1+ count))
 	(and (numberp nnmail-large-newsgroup)
@@ -116,6 +115,7 @@
 
 (deffoo nnmbox-open-server (server &optional defs)
   (nnoo-change-server 'nnmbox server defs)
+  (nnmbox-create-mbox)
   (cond 
    ((not (file-exists-p nnmbox-mbox-file))
     (nnmbox-close-server)
@@ -147,28 +147,28 @@
   (save-excursion
     (set-buffer nnmbox-mbox-buffer)
     (goto-char (point-min))
-    (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)))))))
+    (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)))))))
 
 (deffoo nnmbox-request-group (group &optional server dont-check)
   (let ((active (cadr (assoc group nnmbox-group-alist))))
@@ -186,6 +186,7 @@
 		       (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 
@@ -208,7 +209,8 @@
 (deffoo nnmbox-request-list (&optional server)
   (save-excursion
     (nnmail-find-file nnmbox-active-file)
-    (setq nnmbox-group-alist (nnmail-get-active))))
+    (setq nnmbox-group-alist (nnmail-get-active))
+    t))
 
 (deffoo nnmbox-request-newgroups (date &optional server)
   (nnmbox-request-list server))
@@ -227,17 +229,17 @@
       (set-buffer nnmbox-mbox-buffer)
       (while (and articles is-old)
 	(goto-char (point-min))
-	(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))))
+	(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)))
 	(setq articles (cdr articles)))
       (save-buffer)
       ;; Find the lowest active article in this group.
@@ -253,7 +255,6 @@
 
 (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 
@@ -273,10 +274,11 @@
        (kill-buffer buf)
        result)
      (save-excursion
+       (nnmbox-possibly-change-newsgroup group server)
        (set-buffer nnmbox-mbox-buffer)
        (goto-char (point-min))
-       (if (search-forward (nnmbox-article-string article) nil t)
-	   (nnmbox-delete-mail))
+       (when (search-forward (nnmbox-article-string article) nil t)
+	 (nnmbox-delete-mail))
        (and last (save-buffer))))
     result))
 
@@ -301,7 +303,10 @@
        (forward-line -1)
        (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
 	 (delete-region (point) (progn (forward-line 1) (point))))
-       (setq result (nnmbox-save-mail (and (stringp group) group))))
+       (setq result (nnmbox-save-mail
+		     (if (stringp group)
+			 (list (cons group (nnmbox-active-number group)))
+		       (nnmail-article-group 'nnmbox-active-number)))))
      (save-excursion
        (set-buffer nnmbox-mbox-buffer)
        (goto-char (point-max))
@@ -337,7 +342,8 @@
 	(while (search-forward ident nil t)
 	  (setq found t)
 	  (nnmbox-delete-mail))
-	(and found (save-buffer)))))
+	(when found
+	  (save-buffer)))))
   ;; Remove the group from all structures.
   (setq nnmbox-group-alist 
 	(delq (assoc group nnmbox-group-alist) nnmbox-group-alist)
@@ -357,9 +363,11 @@
       (while (search-forward ident nil t)
 	(replace-match new-ident t t)
 	(setq found t))
-      (and found (save-buffer))))
+      (when found
+	(save-buffer))))
   (let ((entry (assoc group nnmbox-group-alist)))
-    (and entry (setcar entry new-name))
+    (when entry
+      (setcar entry new-name))
     (setq nnmbox-current-group nil)
     ;; Save the new group alist.
     (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
@@ -369,7 +377,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.
@@ -387,7 +395,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))
@@ -395,25 +403,25 @@
 	     (point-max))))
       (goto-char (point-min))
       ;; Only delete the article if no other groups owns it as well.
-      (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
-	  (delete-region (point-min) (point-max))))))
+      (when (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 
 	     (not (nnmbox-server-opened server)))
     (nnmbox-open-server server))
-  (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))
+  (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 newsgroup
-      (if (assoc newsgroup nnmbox-group-alist)
-	  (setq nnmbox-current-group newsgroup))
+      (when (assoc newsgroup nnmbox-group-alist)
+	(setq nnmbox-current-group newsgroup))
     t))
 
 (defun nnmbox-article-string (article)
@@ -425,18 +433,15 @@
 (defun nnmbox-article-group-number ()
   (save-excursion
     (goto-char (point-min))
-    (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)))))))
+    (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)))))))
 
-(defun nnmbox-save-mail (&optional group)
+(defun nnmbox-save-mail (group-art)
   "Called narrowed to an article."
-  (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)))
+  (let ((delim (concat "^" message-unix-mail-delimiter)))
     (goto-char (point-min))
     ;; This might come from somewhere else.
     (unless (looking-at delim)
@@ -457,14 +462,13 @@
 (defun nnmbox-insert-newsgroup-line (group-art)
   (save-excursion
     (goto-char (point-min))
-    (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)))))
+    (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))))
     t))
 
 (defun nnmbox-active-number (group)
@@ -475,14 +479,17 @@
       ;; 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...
-      (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1)))
-				     nnmbox-group-alist)))
+      (push (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)
-  (if (not (file-exists-p nnmbox-mbox-file))
-      (write-region 1 1 nnmbox-mbox-file t 'nomesg))
+  (nnmbox-create-mbox)
   (if (and nnmbox-mbox-buffer
 	   (buffer-name nnmbox-mbox-buffer)
 	   (save-excursion
@@ -516,19 +523,20 @@
 	(goto-char (point-min))
 	(while (re-search-forward delim nil t)
 	  (setq start (match-beginning 0))
-	  (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))))
+	  (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)))))
 	  (goto-char end))))))
 
 (provide 'nnmbox)