10:26 p.m.
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>
* 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)