Are there any RMAIL users out there? The following patch synch's XEmacs mail-lib's rmailout.el with the one in Emacs. I carefully synched this (XEmacs rmail package use different variable names so it's not a complete synch), but I make mistakes. 2001-01-13 Simon Josefsson <sj(a)extundo.com&gt; * rmailout.el (rmail-output-file-alist): Synch with Emacs: Defcustom `rmail-output-file-alist'. Add `rmail-output-read-rmail-file-name'. Use it in `rmail-output-to-rmail-file' and `rmail-output'. Use `find-buffer-visiting' instead of `get-file-buffer. Fix bug: disable deleted attribute outside of save-restriction. New variable `rmail-fields-not-to-output'. Turn on auto save in rmail buffer. Update summary buffer. New: extra optional argument `stay' in `rmail-output-to-rmail-file'. Alias `rmail-file-p' to `mail-file-babyl-p' (for backwards compatibility), use `mail-file-babyl-p' instead. Enhancement: exclude headers when outputting a message to a file (`rmail-fields-not-to-output'). Preserve MIME-Version as well as from. Fix bug: set case-fold-search to nil when searching for "^from" to escape. Add `rmail-output-body-to-file'. Index: rmailout.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-packages/libs/mail-lib/rmailout.el,v retrieving revision 1.2 diff -u -u -w -r1.2 rmailout.el --- rmailout.el 1998/01/18 23:39:02 1.2 +++ rmailout.el 2001/02/23 22:24:15 ＠＠ -1,8 +1,7 ＠＠ ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. -;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1993, 1994 Free Software Foundation, Inc. -;; Maintainer: FSF ;; Keywords: mail ;; This file is part of XEmacs. ＠＠ -28,27 +27,23 ＠＠ (defvar rmail-delete-after-output nil "*Non-nil means automatically delete a message that is copied to a file.") -(defvar rmail-output-file-alist nil +;;;###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). The suggestion is taken if REGEXP matches anywhere in the message buffer. NAME-EXP may be a string constant giving the file name to use, or more generally it may be any kind of expression that returns -a file name as a string.") - -;;; There are functions elsewhere in Emacs that use this function; check -;;; them out before you change the calling method. -(defun rmail-output-to-rmail-file (file-name &optional count) - "Append the current message to an Rmail 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. - -A prefix argument N says to output N consecutive messages -starting with the current one. Deleted messages are skipped and don't count." - (interactive +a file name as a string." + :type '(repeat (cons regexp + (choice :value "" + (string :tag "File Name") + sexp))) + :group 'rmail-output) + +(defun rmail-output-read-rmail-file-name () + "Read the file name to use for `rmail-output-to-rmail-file'. +Set `rmail-last-rmail-file' to this name as well as returning it." (let ((default-file (let (answer tail) (setq tail rmail-output-file-alist) ＠＠ -59,27 +54,88 ＠＠ (if (re-search-forward (car (car tail)) nil t) (setq answer (eval (cdr (car tail))))) (setq tail (cdr tail)))) - ;; If not suggestions, use same file as last time. - (or answer rmail-last-rmail-file)))) - (list (setq rmail-last-rmail-file - (if default-file + ;; If no suggestions, use same file as last time. + (expand-file-name (or answer rmail-last-rmail-file))))) + (let ((read-file + (expand-file-name (read-file-name (concat "Output message to Rmail file: (default " (file-name-nondirectory default-file) ") ") (file-name-directory default-file) - default-file) - (read-file-name "Output message to Rmail file: "))) - (prefix-numeric-value current-prefix-arg)))) + (abbreviate-file-name default-file)) + (file-name-directory default-file)))) + ;; If the user enters just a directory, + ;; use the name within that directory chosen by the default. + (setq rmail-last-rmail-file + (if (file-directory-p read-file) + (expand-file-name (file-name-nondirectory default-file) + read-file) + read-file))))) + +(defun rmail-output-read-file-name () + "Read the file name to use for `rmail-output'. +Set `rmail-last-file' to this name as well as returning it." + (let ((default-file + (let (answer tail) + (setq tail rmail-output-file-alist) + ;; Suggest a file based on a pattern match. + (while (and tail (not answer)) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (car (car tail)) nil t) + (setq answer (eval (cdr (car tail))))) + (setq tail (cdr tail)))) + ;; If no suggestion, use same file as last time. + (or answer rmail-last-file)))) + (let ((read-file + (expand-file-name + (read-file-name + (concat "Output message to Unix mail file: (default " + (file-name-nondirectory default-file) + ") ") + (file-name-directory default-file) + (abbreviate-file-name default-file)) + (file-name-directory default-file)))) + (setq rmail-last-file + (if (file-directory-p read-file) + (expand-file-name (file-name-nondirectory default-file) + read-file) + (expand-file-name + (or read-file (file-name-nondirectory default-file)) + (file-name-directory default-file))))))) + +;;; 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. +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. + +The default file name comes from `rmail-last-rmail-file', +which is updated to the name you use in this command. + +A prefix argument N says to output N consecutive messages +starting with the current one. Deleted messages are skipped and don't count. + +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 (expand-file-name file-name (file-name-directory rmail-last-rmail-file))) - (if (and (file-readable-p file-name) (not (rmail-file-p file-name))) + (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name))) (rmail-output file-name count) (rmail-maybe-set-message-counters) (setq file-name (abbreviate-file-name file-name)) - (or (get-file-buffer file-name) + (or (find-buffer-visiting file-name) (file-exists-p file-name) (if (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? ")) ＠＠ -95,19 +151,32 ＠＠ (let (redelete) (unwind-protect (progn - (save-restriction - (widen) + ;; 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 (get-file-buffer file-name)) + (let ((buf (find-buffer-visiting file-name)) (cur (current-buffer)) (beg (1+ (rmail-msgbeg rmail-current-message))) (end (1+ (rmail-msgend rmail-current-message)))) (if (not buf) - (append-to-file beg end file-name) + ;; 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. ＠＠ -118,6 +187,11 ＠＠ ;; 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)) ＠＠ -126,37 +200,65 ＠＠ (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))))))) + (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 - (rmail-delete-forward) + (unless + (if (and (= count 0) stay) + (rmail-delete-message) + (rmail-delete-forward)) + (setq count 0)) (if (> count 0) - (rmail-next-undeleted-message 1)))))) + (unless + (if (not stay) (rmail-next-undeleted-message 1)) + (setq count 0))))))) -;; Returns t if file FILE is an Rmail file. ;;;###autoload -(defun rmail-file-p (file) - (let ((buf (generate-new-buffer " *rmail-file-p*"))) - (unwind-protect +(defalias 'mail-file-babyl-p 'rmail-file-p) + +;;;###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) + +;; 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 - (set-buffer buf) - (insert-file-contents file nil 0 100) - (looking-at "BABYL OPTIONS:")) - (kill-buffer buf)))) + (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))))))))) -;;; There are functions elsewhere in Emacs that use this function; check -;;; them out before you change the calling method. +;;; There are functions elsewhere in Emacs that use this function; +;;; look at them before you change the calling method. ;;; ####Boy, FROM-GNUS, what wonderful abstraction. You loser. +;;;###autoload (defun rmail-output (file-name &optional count noattribute from-gnus) - "Append this message to Unix mail file named FILE-NAME. + "Append this message to system-inbox-format mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. When called from lisp code, N may be omitted. ＠＠ -165,28 +267,22 ＠＠ messages will be appended with pruned headers; otherwise, messages will be appended with their original headers. +The default file name comes from `rmail-last-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." (interactive - (list (setq rmail-last-file - (read-file-name - (concat "Output message to Unix mail file" - (if rmail-last-file - (concat " (default " - (file-name-nondirectory rmail-last-file) - "): " ) - ": ")) - (and rmail-last-file (file-name-directory rmail-last-file)) - rmail-last-file)) + (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-last-file (file-name-directory rmail-last-file)))) - (if (and (file-readable-p file-name) (rmail-file-p file-name)) + (if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) (rmail-output-to-rmail-file file-name count) (let ((orig-count count) (rmailbuf (current-buffer)) ＠＠ -201,10 +297,11 ＠＠ (forward-line 1) (= (following-char) ?0))))) header-beginning - mail-from) + mail-from mime-version) (while (> count 0) + ;; Preserve the Mail-From and MIME-Version fields + ;; even if they have been pruned. (or from-gnus - (setq mail-from (save-excursion (save-restriction (widen) ＠＠ -212,12 +309,16 ＠＠ (setq header-beginning (point)) (search-forward "\n*** EOOH ***\n") (narrow-to-region header-beginning (point)) - (mail-fetch-field "Mail-From"))))) + (setq mail-from + (mail-fetch-field "Mail-From") + mime-version + (mail-fetch-field "MIME-Version"))))) (save-excursion (set-buffer tembuf) (erase-buffer) (insert-buffer-substring rmailbuf) - (insert "\n") + (rmail-delete-unwanted-fields t) + (or (bolp) (insert "\n")) (goto-char (point-min)) (if mail-from (insert mail-from "\n") ＠＠ -227,12 +328,15 ＠＠ (mail-fetch-field "sender") "unknown")) " " (current-time-string) "\n")) + (if mime-version + (insert "MIME-Version: " mime-version "\n")) ;; ``Quote'' "\nFrom " as "\n>From " ;; (note that this isn't really quoting, as there is no requirement ;; that "\n[>]+From " be quoted in the same transparent way.) + (let ((case-fold-search nil)) (while (search-forward "\nFrom " nil t) (forward-char -5) - (insert ?>)) + (insert ?>))) (write-region (point-min) (point-max) file-name t (if noattribute 'nomsg))) (or noattribute ＠＠ -257,6 +361,37 ＠＠ (if (= num-appended 1) "" "s")))) (setq count 0)))))) (kill-buffer tembuf)))) + + +;;;###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 + (let ((default-file + (or (mail-fetch-field "Subject") + rmail-default-body-file))) + (list (setq rmail-default-body-file + (read-file-name + "Output message body to file: " + (and default-file (file-name-directory default-file)) + default-file + nil default-file))))) + (setq file-name + (expand-file-name file-name + (and rmail-default-body-file + (file-name-directory rmail-default-body-file)))) + (save-excursion + (goto-char (point-min)) + (search-forward "\n\n") + (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))) + (if rmail-delete-after-output + (rmail-delete-forward))) (provide 'rmailout)