emacs: lisp/mail/rmailout.el comparison

comparison lisp/mail/rmailout.el @ 88128:b621daa96824

Attempt to minimize byte compilation warnings. (rmail-output-to-rmail-file): Eliminate Babyl 5 code by using (rmail-output). (rmail-output): Generalize the use by GNUS; rewrite to reflect mbox as the default format. (rmail-output-body-to-file): Use the rmail message descriptor in setting the "stored" attribute.

author	Paul Reilly <pmr@pajato.com>
date	Sat, 15 Feb 2003 15:38:18 +0000
parents	e82b3fe06d4c
children	d7ddb3e565de

comparison

equal deleted inserted replaced

-:9c783aa2b379
+:b621daa96824
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
+;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
 ;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.
 ;; Maintainer: FSF
 ;; Keywords: mail
 ;;; Commentary:
 ;;; Code:
-(require 'rmail)
 (provide 'rmailout)
+(eval-when-compile
+(require 'rmail)
+(require 'rmaildesc))
 ;;;###autoload
 (defcustom rmail-output-file-alist nil
 "*Alist matching regexps to suggested output Rmail files.
 This is a list of elements of the form (REGEXP . NAME-EXP).
 	    ;; If no suggestions, use same file as last time.
 	    (expand-file-name (or answer rmail-default-rmail-file)))))
 (let ((read-file
 	   (expand-file-name
 	    (read-file-name
-	     (concat "Output message to Rmail file: (default "
+	     (concat "Output message to Rmail (mbox) file: (default "
 		     (file-name-nondirectory default-file)
 		     ") ")
 	     (file-name-directory default-file)
 	     (abbreviate-file-name default-file))
 	    (file-name-directory default-file))))
 	    (if (file-directory-p read-file)
 		(expand-file-name (file-name-nondirectory default-file)
 				  read-file)
 	      read-file)))))
+;;; mbox: deprecated
 (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."
 (let ((default-file
 	  (let (answer tail)
 				  read-file)
 	      (expand-file-name
 	       (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
 (defun rmail-output-to-rmail-file (file-name &optional count stay)
-"Append the current message to an Rmail file named FILE-NAME.
+"Append the current message to an Rmail (mbox) file named FILE-NAME.
 If the file does not exist, ask if it should be created.
 If file is being visited, the message is appended to the Emacs
 buffer visiting that file.
 If the file exists and is not an Rmail file, the message is
 appended in inbox format, the same way `rmail-output' does it.
 If optional argument STAY is non-nil, then leave the last filed
 mesasge up instead of moving forward to the next non-deleted message."
 (interactive
 (list (rmail-output-read-rmail-file-name)
 	 (prefix-numeric-value current-prefix-arg)))
-(or count (setq count 1))
-(setq file-name
+;; Use the 'rmail-output function to perform the output.
-	(expand-file-name file-name
+(rmail-output file-name count nil nil)
-			  (file-name-directory rmail-default-rmail-file)))
-(if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
+;; Deal with the next message
-(rmail-output file-name count)
+(if rmail-delete-after-output
-(rmail-maybe-set-message-counters)
+(unless
-(setq file-name (abbreviate-file-name file-name))
+(if (and (= count 0) stay)
-(or (find-buffer-visiting file-name)
+(rmail-delete-message)
-	(file-exists-p file-name)
+(rmail-delete-forward))
-	(if (yes-or-no-p
+(setq count 0))
-	     (concat "\"" file-name "\" does not exist, create it? "))
+(if (> count 0)
-	    (let ((file-buffer (create-file-buffer file-name)))
+(unless
-	      (save-excursion
+(if (not stay) (rmail-next-undeleted-message 1))
-		(set-buffer file-buffer)
+(setq count 0)))))
-		(rmail-insert-rmail-file-header)
-		(let ((require-final-newline nil)
+;;; mbox: deprecated
-		      (coding-system-for-write
-		       (or rmail-file-coding-system
-			   'emacs-mule-unix)))
-		  (write-region (point-min) (point-max) file-name t 1)))
-	      (kill-buffer file-buffer))
-	  (error "Output file does not exist")))
-(while (> count 0)
-(let (redelete)
-	(unwind-protect
-	    (progn
-	      (set-buffer rmail-buffer)
-	      ;; Temporarily turn off Deleted attribute.
-	      ;; Do this outside the save-restriction, since it would
-	      ;; shift the place in the buffer where the visible text starts.
-	      (if (rmail-message-deleted-p rmail-current-message)
-		  (progn (setq redelete t)
-			 (rmail-set-attribute "deleted" nil)))
-	      (save-restriction
-		(widen)
-		;; Decide whether to append to a file or to an Emacs buffer.
-		(save-excursion
-		  (let ((buf (find-buffer-visiting file-name))
-			(cur (current-buffer))
-			(beg (1+ (rmail-msgbeg rmail-current-message)))
-			(end (1+ (rmail-msgend rmail-current-message)))
-			(coding-system-for-write
-			 (or rmail-file-coding-system
-			     'emacs-mule-unix)))
-		    (if (not buf)
-			;; Output to a file.
-			(if rmail-fields-not-to-output
-			    ;; Delete some fields while we output.
-			    (let ((obuf (current-buffer)))
-			      (set-buffer (get-buffer-create " rmail-out-temp"))
-			      (insert-buffer-substring obuf beg end)
-			      (rmail-delete-unwanted-fields)
-			      (append-to-file (point-min) (point-max) file-name)
-			      (set-buffer obuf)
-			      (kill-buffer (get-buffer " rmail-out-temp")))
-			  (append-to-file beg end file-name))
-		      (if (eq buf (current-buffer))
-			  (error "Can't output message to same file it's already in"))
-		      ;; File has been visited, in buffer BUF.
-		      (set-buffer buf)
-		      (let ((buffer-read-only nil)
-			    (msg (and (boundp 'rmail-current-message)
-				      rmail-current-message)))
-			;; If MSG is non-nil, buffer is in RMAIL mode.
-			(if msg
-			    (progn
-			      ;; Turn on auto save mode, if it's off in this
-			      ;; buffer but enabled by default.
-			      (and (not buffer-auto-save-file-name)
-				   auto-save-default
-				   (auto-save-mode t))
-			      (rmail-maybe-set-message-counters)
-			      (widen)
-			      (narrow-to-region (point-max) (point-max))
-			      (insert-buffer-substring cur beg end)
-			      (goto-char (point-min))
-			      (widen)
-			      (search-backward "\n\^_")
-			      (narrow-to-region (point) (point-max))
-			      (rmail-delete-unwanted-fields)
-			      (rmail-count-new-messages t)
-			      (if (rmail-summary-exists)
-				  (rmail-select-summary
-				    (rmail-update-summary)))
-			      (rmail-show-message msg))
-			  ;; Output file not in rmail mode => just insert at the end.
-			  (narrow-to-region (point-min) (1+ (buffer-size)))
-			  (goto-char (point-max))
-			  (insert-buffer-substring cur beg end)
-			  (rmail-delete-unwanted-fields)))))))
-	      (rmail-set-attribute "filed" t))
-	  (if redelete (rmail-set-attribute "deleted" t))))
-(setq count (1- count))
-(if rmail-delete-after-output
-	  (unless
-	      (if (and (= count 0) stay)
-		  (rmail-delete-message)
-		(rmail-delete-forward))
-	    (setq count 0))
-	(if (> count 0)
-	    (unless
-		(if (not stay) (rmail-next-undeleted-message 1))
-	      (setq count 0)))))))
 ;;;###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
 	      (while (re-search-forward rmail-fields-not-to-output end t)
 		(beginning-of-line)
 		(delete-region (point)
 			       (progn (forward-line 1) (point)))))))))
+;;; mbox: ready
 ;;; 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 from-gnus)
+(defun rmail-output (file-name &optional count noattribute ext)
-"Append this message to system-inbox-format mail file named FILE-NAME.
+"Append an mbox formatted message to the mbox formatted file named
-A prefix argument N says to output N consecutive messages
+FILE-NAME.  A prefix argument COUNT says to output COUNT consecutive
-starting with the current one.  Deleted messages are skipped and don't count.
+messages starting with the current one.  Deleted messages are skipped
-When called from lisp code, N may be omitted.
+and don't count.  When called from lisp code, COUNT may be omitted.
-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.
 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 FROM-GNUS is set when called from GNUS."
+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)))
 (or count (setq count 1))
 (setq file-name
 	(expand-file-name file-name
 			  (and rmail-default-file
 			       (file-name-directory rmail-default-file))))
-(if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
-(rmail-output-to-rmail-file file-name count)
+;; Use the Rmail buffer, likely narrowed, as the message source
-(set-buffer rmail-buffer)
+;; unless being called from an external party, such as GNUS or
-(let ((orig-count count)
+;; Sendmail.
-	  (rmailbuf (current-buffer))
+(unless ext
-	  (case-fold-search t)
+(set-buffer rmail-buffer))
-	  (tembuf (get-buffer-create " rmail-output"))
-	  (original-headers-p
+(let ((orig-count count)
-	   (and (not from-gnus)
+	(src-buf (current-buffer))
-		(save-excursion
+(dst-buf (find-buffer-visiting file-name))
-		  (save-restriction
+(current-message rmail-current-message)
-		    (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
+	(tembuf (get-buffer-create " rmail-output"))
-		    (goto-char (point-min))
+	(original-headers-p
-		    (forward-line 1)
+	 (and (not ext) (not (rmail-msg-is-pruned)))))
-		    (= (following-char) ?0)))))
-	  header-beginning
+;; Output each message to the destination file.
-	  mail-from mime-version content-type)
+(while (> count 0)
-(while (> count 0)
+(save-excursion
-	;; Preserve the Mail-From and MIME-Version fields
-	;; even if they have been pruned.
+;; Copy the message, including all headers, to the temporary
-	(or from-gnus
+;; buffer.
-	    (save-excursion
+(set-buffer tembuf)
-	      (save-restriction
+(erase-buffer)
-		(widen)
+(insert-buffer-substring src-buf)
-		(goto-char (rmail-msgbeg rmail-current-message))
-		(setq header-beginning (point))
+;; Deal with MIME --- tbd.
-		(search-forward "\n*** EOOH ***\n")
+;;(when rmail-enable-mime ...
-		(narrow-to-region header-beginning (point))
-		(setq mail-from (mail-fetch-field "Mail-From"))
+;; Determine whether a buffer is already visiting the output
-		(unless rmail-enable-mime
+;; file.
-		  (setq mime-version (mail-fetch-field "MIME-Version")
+(if dst-buf
-			content-type (mail-fetch-field "Content-type"))))))
-	(save-excursion
+;; The destination file is being visited.  Update it.
-	  (set-buffer tembuf)
+(progn
-	  (erase-buffer)
+(set-buffer dst-buf)
-	  (insert-buffer-substring rmailbuf)
-	  (when rmail-enable-mime
+;; Determine if the destination file is an Rmail file.
-	    (if original-headers-p
+(let ((buffer-read-only nil)
-		(delete-region (goto-char (point-min))
+(dst-current-message (and (boundp 'rmail-current-message)
-			       (if (search-forward "\n*** EOOH ***\n")
+rmail-current-message)))
-				   (match-end 0)))
+(if dst-current-message
-	      (goto-char (point-min))
-	      (forward-line 2)
+;; The buffer is an Rmail buffer.  Append the message.
-	      (delete-region (point-min)(point))
+(progn
-	      (search-forward "\n*** EOOH ***\n")
+(widen)
-	      (delete-region (match-beginning 0)
+(narrow-to-region (point-max) (point-max))
-			     (if (search-forward "\n\n")
+(insert-buffer-substring src-buf)
-				 (1- (match-end 0)))))
+(insert "\n")
-	    (setq buffer-file-coding-system (or rmail-file-coding-system
+(rmail-process-new-messages)
-						'raw-text)))
+(rmail-show-message dst-current-message))
-	  (rmail-delete-unwanted-fields t)
-	  (or (bolp) (insert "\n"))
+;; The destination file is not an Rmail file, just
-	  (goto-char (point-min))
+;; insert at the end.
-	  (if mail-from
+(goto-char (point-max))
-	      (insert mail-from "\n")
+(insert-buffer-substring src-buf))))
-	    (insert "From "
-		    (mail-strip-quoted-names (or (mail-fetch-field "from")
+;; The destination file is not being visited, just write out
-						 (mail-fetch-field "really-from")
+;; the processed message.
-						 (mail-fetch-field "sender")
+(write-region (point-min) (point-max) file-name t
-						 "unknown"))
+(if noattribute 'nomsg))))
-		    " " (current-time-string) "\n"))
-	  (if mime-version
+;; Do housekeeping, such as setting the "Filed" attribute, if
-	      (insert "MIME-Version: " mime-version
+;; necessary and moving to the next message.
-		      "\nContent-type: " content-type "\n"))
+(or noattribute
-	  ;; ``Quote'' "\nFrom " as "\n>From "
+(if (equal major-mode 'rmail-mode)
-	  ;;  (note that this isn't really quoting, as there is no requirement
+(progn
-	  ;;   that "\n[>]+From " be quoted in the same transparent way.)
+(rmail-set-attribute "filed" t current-message)
-	  (let ((case-fold-search nil))
+(setq current-message (1+ current-message)))))
-	    (while (search-forward "\nFrom " nil t)
-	      (forward-char -5)
+;; Determine if Rmail post output operations need to be handled.
-	      (insert ?>)))
+(or ext
-	  (write-region (point-min) (point-max) file-name t
-			(if noattribute 'nomsg)))
+;; They do.  Move to the next non-deleted message.
-	(or noattribute
+(let ((next-message-p
-	    (if (equal major-mode 'rmail-mode)
+(if rmail-delete-after-output
-		(rmail-set-attribute "filed" t)))
+(rmail-delete-forward)
-	(setq count (1- count))
+(if (> count 1)
-	(or from-gnus
+(rmail-next-undeleted-message 1))))
-	    (let ((next-message-p
+(num-appended (- orig-count count)))
-		   (if rmail-delete-after-output
+(if (and (> count 1) (not next-message-p))
-		       (rmail-delete-forward)
+(progn
-		     (if (> count 0)
+(error
-			 (rmail-next-undeleted-message 1))))
+(save-excursion
-		  (num-appended (- orig-count count)))
+(set-buffer src-buf)
-	      (if (and next-message-p original-headers-p)
+(format "Only %d message%s appended" num-appended
-		  (rmail-toggle-header))
+(if (= num-appended 1) "" "s"))))
-	      (if (and (> count 0) (not next-message-p))
+(setq count 0)))))
-		  (progn
-		    (error
+;; Decrement the count for the next iteration.  If an error has
-		     (save-excursion
+;; occurred, then count will be -1, which is every bit as good
-		       (set-buffer rmailbuf)
+;; as 0.
-		       (format "Only %d message%s appended" num-appended
+(setq count (1- count)))
-			       (if (= num-appended 1) "" "s"))))
+(kill-buffer tembuf)))
-		    (setq count 0))))))
-(kill-buffer tembuf))))
+;;; mbox: ready
 ;;;###autoload
 (defun rmail-output-body-to-file (file-name)
 "Write this message body to the file FILE-NAME.
 FILE-NAME defaults, interactively, from the Subject field of the message."
 (interactive
 (and (file-exists-p file-name)
 	 (not (y-or-n-p (message "File %s exists; overwrite? " file-name)))
 	 (error "Operation aborted"))
 (write-region (point) (point-max) file-name)
 (if (equal major-mode 'rmail-mode)
-	(rmail-set-attribute "stored" t)))
+	(rmail-desc-set-attribute rmail-desc-stored-index t rmail-current-message)))
 (if rmail-delete-after-output
 (rmail-delete-forward)))
 ;;; rmailout.el ends here

Mercurial > emacs

comparison lisp/mail/rmailout.el @ 88128:b621daa96824