--- a/lisp/gnus/gnus-soup.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/gnus/gnus-soup.el	Mon Aug 13 08:49:20 2007 +0200
@@ -1,5 +1,5 @@
 ;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
 ;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -26,9 +26,11 @@
 
 ;;; Code:
 
-(require 'gnus-msg)
 (require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-art)
+(require 'message)
+(require 'gnus-start)
+(require 'gnus-range)
 
 ;;; User Variables:
 
@@ -44,7 +46,7 @@
 (defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
   "Format string command for packing a SOUP packet.
 The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
+This string MUST contain both %s and %d.  The file number will be
 inserted where %d appears.")
 
 (defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -"
@@ -70,7 +72,7 @@
 (defvar gnus-soup-index-type ?c
   "*Soup index type.
 `n' means no index file and `c' means standard Cnews overview
-format.") 
+format.")
 
 (defvar gnus-soup-areas nil)
 (defvar gnus-soup-last-prefix nil)
@@ -116,8 +118,8 @@
   (let ((packets (directory-files
 		  gnus-soup-packet-directory t gnus-soup-packet-regexp)))
     (while packets
-      (and (gnus-soup-send-packet (car packets))
-	   (delete-file (car packets)))
+      (when (gnus-soup-send-packet (car packets))
+	(delete-file (car packets)))
       (setq packets (cdr packets)))))
 
 (defun gnus-soup-add-article (n)
@@ -163,6 +165,10 @@
   "Make a SOUP packet from the SOUP areas."
   (interactive)
   (gnus-soup-read-areas)
+  (unless (file-exists-p gnus-soup-directory)
+    (message "No such directory: %s" gnus-soup-directory))
+  (when (null (directory-files gnus-soup-directory nil "\\.MSG$"))
+    (message "No files to pack."))
   (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
 
 (defun gnus-group-brew-soup (n)
@@ -182,8 +188,8 @@
   (let ((level (or level gnus-level-subscribed))
 	(newsrc (cdr gnus-newsrc-alist)))
     (while newsrc
-      (and (<= (nth 1 (car newsrc)) level)
-	   (gnus-soup-group-brew (caar newsrc) t))
+      (when (<= (nth 1 (car newsrc)) level)
+	(gnus-soup-group-brew (caar newsrc) t))
       (setq newsrc (cdr newsrc)))
     (gnus-soup-save-areas)))
 
@@ -198,34 +204,32 @@
 
 $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
   (interactive)
-  )
+  nil)
   
 ;;; Internal Functions:
 
 ;; Store the current buffer. 
 (defun gnus-soup-store (directory prefix headers format index)
   ;; Create the directory, if needed. 
-  (or (file-directory-p directory)
-      (gnus-make-directory directory))
-  (let* ((msg-buf (find-file-noselect
+  (gnus-make-directory directory)
+  (let* ((msg-buf (nnheader-find-file-noselect
 		   (concat directory prefix ".MSG")))
 	 (idx-buf (if (= index ?n)
 		      nil
-		    (find-file-noselect
+		    (nnheader-find-file-noselect
 		     (concat directory prefix ".IDX"))))
 	 (article-buf (current-buffer))
 	 from head-line beg type)
     (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
     (buffer-disable-undo msg-buf)
-    (and idx-buf 
-	 (progn
-	   (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers))
-	   (buffer-disable-undo idx-buf)))
+    (when idx-buf 
+      (push idx-buf gnus-soup-buffers)
+      (buffer-disable-undo idx-buf))
     (save-excursion
       ;; Make sure the last char in the buffer is a newline.
       (goto-char (point-max))
-      (or (= (current-column) 0)
-	  (insert "\n"))
+      (unless (= (current-column) 0)
+	(insert "\n"))
       ;; Find the "from".
       (goto-char (point-min))
       (setq from
@@ -300,7 +304,7 @@
 			(lambda (time) (int-to-string time))
 			(current-time) "-")))
 	   (or (mail-header-references header) "")
-	   (or (mail-header-chars header) 0) 
+	   (or (mail-header-chars header) 0)
 	   (or (mail-header-lines header) "0"))))
 
 (defun gnus-soup-save-areas ()
@@ -313,21 +317,20 @@
 	(if (not (buffer-name buf))
 	    ()
 	  (set-buffer buf)
-	  (and (buffer-modified-p) (save-buffer))
+	  (when (buffer-modified-p)
+	    (save-buffer))
 	  (kill-buffer (current-buffer)))))
     (gnus-soup-write-prefixes)))
 
 (defun gnus-soup-write-prefixes ()
-  (let ((prefix gnus-soup-last-prefix))
+  (let ((prefixes gnus-soup-last-prefix)
+	prefix)
     (save-excursion
-      (while prefix
-	(gnus-set-work-buffer)
-	(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix)))
-	(gnus-make-directory (caar prefix))
-	(write-region (point-min) (point-max)
-		      (concat (caar prefix) gnus-soup-prefix-file) 
-		      nil 'nomesg)
-	(setq prefix (cdr prefix))))))
+      (gnus-set-work-buffer)
+      (while (setq prefix (pop prefixes))
+	(erase-buffer)
+	(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
+	(gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))
 
 (defun gnus-soup-pack (dir packer)
   (let* ((files (mapconcat 'identity
@@ -342,8 +345,7 @@
 			   (string-to-int (gnus-soup-unique-prefix dir))
 			   files)))
 	 (dir (expand-file-name dir)))
-    (or (file-directory-p dir)
-	(gnus-make-directory dir))
+    (gnus-make-directory dir)
     (setq gnus-soup-areas nil)
     (gnus-message 4 "Packing %s..." packer)
     (if (zerop (call-process shell-file-name
@@ -363,40 +365,38 @@
 though the two last may be nil if they are missing."
   (let (areas)
     (save-excursion
-      (set-buffer (find-file-noselect file 'force))
+      (set-buffer (nnheader-find-file-noselect file 'force))
       (buffer-disable-undo (current-buffer))
       (goto-char (point-min))
       (while (not (eobp))
-	(setq areas
-	      (cons (vector (gnus-soup-field) 
-			    (gnus-soup-field)
-			    (gnus-soup-field)
-			    (and (eq (preceding-char) ?\t)
-				 (gnus-soup-field))
-			    (and (eq (preceding-char) ?\t)
-				 (string-to-int (gnus-soup-field))))
-		    areas))
-	(if (eq (preceding-char) ?\t)
-	    (beginning-of-line 2)))
+	(push (vector (gnus-soup-field)
+		      (gnus-soup-field)
+		      (gnus-soup-field)
+		      (and (eq (preceding-char) ?\t)
+			   (gnus-soup-field))
+		      (and (eq (preceding-char) ?\t)
+			   (string-to-int (gnus-soup-field))))
+	      areas)
+	(when (eq (preceding-char) ?\t)
+	  (beginning-of-line 2)))
       (kill-buffer (current-buffer)))
     areas))
 
 (defun gnus-soup-parse-replies (file)
   "Parse soup REPLIES file FILE.
 The result is a of vectors, each containing one entry from the REPLIES
-file. The vector contain three strings, [prefix name encoding]."
+file.  The vector contain three strings, [prefix name encoding]."
   (let (replies)
     (save-excursion
-      (set-buffer (find-file-noselect file))
+      (set-buffer (nnheader-find-file-noselect file))
       (buffer-disable-undo (current-buffer))
       (goto-char (point-min))
       (while (not (eobp))
-	(setq replies
-	      (cons (vector (gnus-soup-field) (gnus-soup-field)
-			    (gnus-soup-field))
-		    replies))
-	(if (eq (preceding-char) ?\t)
-	    (beginning-of-line 2)))
+	(push (vector (gnus-soup-field) (gnus-soup-field)
+		      (gnus-soup-field))
+	      replies)
+	(when (eq (preceding-char) ?\t)
+	  (beginning-of-line 2)))
       (kill-buffer (current-buffer)))
     replies))
 
@@ -422,9 +422,9 @@
 	   (format 
 	    "%s\t%s\t%s%s\n"
 	    (gnus-soup-area-prefix area)
-	    (gnus-soup-area-name area) 
+	    (gnus-soup-area-name area)
 	    (gnus-soup-area-encoding area)
-	    (if (or (gnus-soup-area-description area) 
+	    (if (or (gnus-soup-area-description area)
 		    (gnus-soup-area-number area))
 		(concat "\t" (or (gnus-soup-area-description
 				  area) "")
@@ -440,7 +440,7 @@
       (while (setq area (pop areas))
 	(insert (format "%s\t%s\t%s\n"
 			(gnus-soup-reply-prefix area)
-			(gnus-soup-reply-kind area) 
+			(gnus-soup-reply-kind area)
 			(gnus-soup-reply-encoding area)))))))
 
 (defun gnus-soup-area (group)
@@ -451,18 +451,18 @@
     (while areas
       (setq area (car areas)
 	    areas (cdr areas))
-      (if (equal (gnus-soup-area-name area) real-group)
-	  (setq result area)))
-    (or result
-	(setq result
-	      (vector (gnus-soup-unique-prefix)
-		      real-group 
-		      (format "%c%c%c"
-			      gnus-soup-encoding-type
-			      gnus-soup-index-type
-			      (if (gnus-member-of-valid 'mail group) ?m ?n))
-		      nil nil)
-	      gnus-soup-areas (cons result gnus-soup-areas)))
+      (when (equal (gnus-soup-area-name area) real-group)
+	(setq result area)))
+    (unless result
+      (setq result
+	    (vector (gnus-soup-unique-prefix)
+		    real-group 
+		    (format "%c%c%c"
+			    gnus-soup-encoding-type
+			    gnus-soup-index-type
+			    (if (gnus-member-of-valid 'mail group) ?m ?n))
+		    nil nil)
+	    gnus-soup-areas (cons result gnus-soup-areas)))
     result))
 
 (defun gnus-soup-unique-prefix (&optional dir)
@@ -471,13 +471,11 @@
 	 gnus-soup-prev-prefix)
     (if entry
 	()
-      (and (file-exists-p (concat dir gnus-soup-prefix-file))
-	   (condition-case nil
-	       (load (concat dir gnus-soup-prefix-file) nil t t)
-	     (error nil)))
-      (setq gnus-soup-last-prefix 
-	    (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
-		  gnus-soup-last-prefix)))
+      (when (file-exists-p (concat dir gnus-soup-prefix-file))
+	(ignore-errors
+	  (load (concat dir gnus-soup-prefix-file) nil t t)))
+      (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
+	    gnus-soup-last-prefix))
     (setcdr entry (1+ (cdr entry)))
     (gnus-soup-write-prefixes)
     (int-to-string (cdr entry))))
@@ -490,7 +488,7 @@
   (prog1
       (zerop (call-process
 	      shell-file-name nil nil nil shell-command-switch
-	      (format "cd %s ; %s" (expand-file-name dir) 
+	      (format "cd %s ; %s" (expand-file-name dir)
 		      (format unpacker packet))))
     (gnus-message 4 "Unpacking...done")))
 
@@ -505,12 +503,13 @@
 				 (gnus-soup-reply-prefix (car replies))
 				 ".MSG"))
 	       (msg-buf (and (file-exists-p msg-file)
-			     (find-file-noselect msg-file)))
+			     (nnheader-find-file-noselect msg-file)))
 	       (tmp-buf (get-buffer-create " *soup send*"))
 	       beg end)
 	  (cond 
 	   ((/= (gnus-soup-encoding-format 
-		 (gnus-soup-reply-encoding (car replies))) ?n)
+		 (gnus-soup-reply-encoding (car replies)))
+		?n)
 	    (error "Unsupported encoding"))
 	   ((null msg-buf)
 	    t)
@@ -520,8 +519,8 @@
 	    (set-buffer msg-buf)
 	    (goto-char (point-min))
 	    (while (not (eobp))
-	      (or (looking-at "#! *rnews +\\([0-9]+\\)")
-		  (error "Bad header."))
+	      (unless (looking-at "#! *rnews +\\([0-9]+\\)")
+		(error "Bad header."))
 	      (forward-line 1)
 	      (setq beg (point)
 		    end (+ (point) (string-to-int 
@@ -541,10 +540,12 @@
 		(gnus-message 5 "Sending news message to %s..."
 			      (mail-fetch-field "newsgroups"))
 		(sit-for 1)
-		(funcall message-send-news-function))
+		(let ((message-syntax-checks
+		       'dont-check-for-anything-just-trust-me))
+		  (funcall message-send-news-function)))
 	       ((string= (gnus-soup-reply-kind (car replies)) "mail")
 		(gnus-message 5 "Sending mail to %s..."
-			 (mail-fetch-field "to"))
+			      (mail-fetch-field "to"))
 		(sit-for 1)
 		(message-send-mail))
 	       (t