Mercurial > emacs

--- a/lisp/mail/rmailout.el	Wed Jan 25 16:39:44 2006 +0000
+++ b/lisp/mail/rmailout.el	Wed Jan 25 16:40:10 2006 +0000
@@ -47,6 +47,13 @@
 			       sexp)))
   :group 'rmail-output)

+;;;###autoload
+(defcustom rmail-fields-not-to-output nil
+  "*Regexp describing fields to exclude when outputting a message to a file."
+  :type '(choice (const :tag "None" nil)
+		 regexp)
+  :group 'rmail-output)
+
 (defun rmail-output-read-file-name ()
   "Read the file name to use for `rmail-output'.
 Set `rmail-default-file' to this name as well as returning it."
@@ -75,7 +82,6 @@
 	     (or read-file (file-name-nondirectory default-file))
 	     (file-name-directory default-file))))))

-;;; mbox: ready
 ;;; There are functions elsewhere in Emacs that use this function;
 ;;; look at them before you change the calling method.
 ;;;###autoload
@@ -110,40 +116,33 @@
 		(rmail-next-undeleted-message 1))
 	(setq count 0)))))

-;;; mbox: deprecated
-;;;###autoload
-(defcustom rmail-fields-not-to-output nil
-  "*Regexp describing fields to exclude when outputting a message to a file."
-  :type '(choice (const :tag "None" nil)
-		 regexp)
-  :group 'rmail-output)
-
-;;; mbox: deprecated
-;; Delete from the buffer header fields we don't want output.
-;; NOT-RMAIL if t means this buffer does not have the full header
-;; and *** EOOH *** that a message in an Rmail file has.
-(defun rmail-delete-unwanted-fields (&optional not-rmail)
-  (if rmail-fields-not-to-output
-      (save-excursion
+(defun rmail-delete-unwanted-fields ()
+  "Delete from the buffer header fields we don't want output."
+  (when rmail-fields-not-to-output
+    (save-excursion
+      (let ((limit (rmail-header-get-limit))
+	    (inhibit-point-motion-hooks t)
+	    start)
 	(goto-char (point-min))
-	;; Find the end of the header.
-	(if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t))
-		 (search-forward "\n\n" nil t))
-	    (let ((end (point-marker)))
-	      (goto-char (point-min))
-	      (while (re-search-forward rmail-fields-not-to-output end t)
-		(beginning-of-line)
-		(delete-region (point)
-			       (progn (forward-line 1) (point)))))))))
+	(while (re-search-forward rmail-fields-not-to-output limit t)
+	  (forward-line 0)
+	  (setq start (point))
+	  (while (progn (forward-line 1) (looking-at "[ \t]+"))
+	    (goto-char (line-end-position)))
+	  (delete-region start (point)))))))

 ;;; There are functions elsewhere in Emacs that use this function;
 ;;; look at them before you change the calling method.
 ;;;###autoload
-(defun rmail-output (file-name &optional count noattribute ext)
-  "Append an mbox formatted message to the mbox formatted file named
-FILE-NAME.  A prefix argument COUNT says to output COUNT consecutive
-messages starting with the current one.  Deleted messages are skipped
-and don't count.  When called from lisp code, COUNT may be omitted.
+(defun rmail-output (file-name &optional count noattribute from-gnus)
+  "Append this message to system-inbox-format mail file named FILE-NAME.
+A prefix argument COUNT says to output that many consecutive messages,
+starting with the current one.  Deleted messages are skipped and don't count.
+When called from lisp code, COUNT may be omitted and defaults to 1.
+
+If the pruned message header is shown on the current message, then
+messages will be appended with pruned headers; otherwise, messages
+will be appended with their original headers.

 The default file name comes from `rmail-default-file',
 which is updated to the name you use in this command.
@@ -151,90 +150,75 @@
 The optional third argument NOATTRIBUTE, if non-nil, says not
 to set the `filed' attribute, and not to display a message.

-The optional fourth argument EXT is set when called from outside of an
-Rmail function, for example by GNUS or Sendmail."
-  (interactive (list (rmail-output-read-file-name)
-		     (prefix-numeric-value current-prefix-arg)))
+The optional fourth argument FROM-GNUS is set when called from GNUS."
+  (interactive
+   (list (rmail-output-read-file-name)
+	 (prefix-numeric-value current-prefix-arg)))
   (or count (setq count 1))
   (setq file-name
 	(expand-file-name file-name
 			  (and rmail-default-file
 			       (file-name-directory rmail-default-file))))
-  ;; Use the Rmail buffer, likely narrowed, as the message source
-  ;; unless being called from an external party, such as GNUS or
-  ;; Sendmail.
-  (unless ext
-    (set-buffer rmail-buffer))
-  (let ((orig-count count)
-	(src-buf (current-buffer))
-        (dst-buf (find-buffer-visiting file-name))
-        (current-message rmail-current-message)
-	(tembuf (get-buffer-create " rmail-output"))
-	(original-headers-p (and (not ext) (not (rmail-msg-is-pruned)))))
-    ;; Output each message to the destination file.
-    (while (> count 0)
-      (save-excursion
-        ;; Copy the message, including all headers, to the temporary
-        ;; buffer.
-        (set-buffer tembuf)
-        (erase-buffer)
-        (insert-buffer-substring src-buf)
-
-        ;; Deal with MIME --- tbd.
-        ;;(when rmail-enable-mime ...
-
-        (if (not dst-buf)
-	    ;; The destination file is not being visited, just write out
-	    ;; the processed message.
-	    (write-region (point-min) (point-max) file-name
-			  t (if noattribute 'nomsg))
-	  ;; The destination file is being visited.  Update it.
-	  (with-current-buffer dst-buf
-	    ;; Determine if the destination file is an Rmail file.
-	    (let ((buffer-read-only nil)
-		  (dst-current-message
-		   (and (boundp 'rmail-current-message)
-			rmail-current-message)))
-	      (if dst-current-message
-		  ;; The buffer is an Rmail buffer.  Append the message.
-		  (progn
-		    (widen)
-		    (narrow-to-region (point-max) (point-max))
-		    (insert-buffer-substring src-buf)
-		    (insert "\n")
-		    (rmail-process-new-messages)
-		    (rmail-show-message dst-current-message))
-		;; The destination file is not an Rmail file, just
-		;; insert at the end.
-		(goto-char (point-max))
-		(insert-buffer-substring src-buf))))))
-      ;; Do housekeeping, such as setting the "Filed" attribute, if
-      ;; necessary and moving to the next message.
-      (unless noattribute
-	(if (equal major-mode 'rmail-mode)
-	    (rmail-set-attribute "filed" t current-message)
-	  (setq current-message (1+ current-message))))
-      ;; Determine if Rmail post output operations need to be handled.
-      (unless ext
-	;; They do.  Move to the next non-deleted message.
-	(let ((next-message-p
-	       (if rmail-delete-after-output
-		   (rmail-delete-forward)
-		 (when (> count 1)
-		   (rmail-next-undeleted-message 1))))
-	      (num-appended (- orig-count count)))
-	  (when (and (> count 1) (not next-message-p))
-	    (error (save-excursion
-		     (set-buffer src-buf)
-		     (format "Only %d message%s appended"
-			     num-appended
-			     (if (= num-appended 1) "" "s"))))
-	    (setq count 0))))
-      ;; Decrement the count for the next iteration.  If an error has
-      ;; occurred, then count will be -1, which is every bit as good as
-      ;; 0.
-      (setq count (1- count)))
-    (kill-buffer tembuf)))
+  (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
+      (error "BABYL output not supported.")
+    (with-current-buffer rmail-buffer
+      (let ((orig-count count)
+	    (rmailbuf (current-buffer))
+	    (destbuf (find-buffer-visiting file-name))
+	    (case-fold-search t))
+	(while (> count 0)
+	  (with-temp-buffer
+	    (insert-buffer-substring rmailbuf)
+	    (when rmail-enable-mime
+	      (setq buffer-file-coding-system
+	    	    (or rmail-file-coding-system
+	    		'raw-text)))
+	    (rmail-delete-unwanted-fields)
+	    (if (not destbuf)
+		;; The destination file is not being visited, just write
+		;; out the processed message.
+		(write-region (point-min) (point-max) file-name
+			      t (when noattribute 'nomsg))
+	      ;; The destination file is being visited.  Update it.
+	      (let ((msg-string (buffer-string)))
+		(with-current-buffer destbuf
+		  ;; Determine if the destination file is an Rmail file.
+		  (let ((buffer-read-only nil)
+			(dest-current-message
+			 (and (boundp 'rmail-current-message)
+			      rmail-current-message)))
+		    (if dest-current-message
+			;; The buffer is an Rmail buffer.  Append the
+			;; message.
+			(progn
+			  (widen)
+			  (narrow-to-region (point-max) (point-max))
+			  (insert msg-string)
+			  (insert "\n")
+			  (rmail-process-new-messages)
+			  (rmail-show-message dest-current-message))
+		      ;; The destination file is not an Rmail file, just
+		      ;; insert at the end.
+		      (goto-char (point-max))
+		      (insert msg-string)))))))
+	  (unless noattribute
+	    (when (equal major-mode 'rmail-mode)
+	      (rmail-set-attribute "filed" t)))
+	  (setq count (1- count))
+	  (unless from-gnus
+	    (let ((next-message-p
+		   (if rmail-delete-after-output
+		       (rmail-delete-forward)
+		     (when (> count 0)
+		       (rmail-next-undeleted-message 1))))
+		  (num-appended (- orig-count count)))
+	      (when (and next-message-p original-headers-p)
+		(rmail-toggle-header))
+	      (when (and (> count 0) (not next-message-p))
+		(error (with-current-buffer rmailbuf
+			 (format "Only %d message%s appended" num-appended
+				 (if (= num-appended 1) "" "s"))))
+		(setq count 0)))))))))

 ;;;###autoload
 (defun rmail-output-body-to-file (file-name)