;;; 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
;;; Code:
+(require 'rmail)
+
;; Temporary until Emacs always has this variable.
(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
"*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.")
+(defun rmail-output-menu (event)
+ "Output current message to another Rmail file, chosen with a menu.
+Also set the default for subsequent \\[rmail-output-to-rmail-file] commands.
+The variables `rmail-secondary-file-directory' and
+`rmail-secondary-file-regexp' control which files are offered in the menu."
+ (interactive "e")
+ (let ((file-name (rmail-secondary-file-menu event)))
+ (if file-name
+ (rmail-output-to-rmail-file
+ (setq rmail-default-rmail-file file-name)))))
+
;;; 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)
If the file exists and is not an Rmail file,
the message is appended in inbox format.
+The default file name comes from `rmail-default-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."
(interactive
(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
- (read-file-name
- (concat "Output message to Rmail file: (default "
- (file-name-nondirectory default-file)
- ") ")
- (file-name-directory default-file)
- default-file))
+ (or answer rmail-default-rmail-file))))
+ (list (setq rmail-default-rmail-file
+ (let ((read-file
+ (read-file-name
+ (concat "Output message to Rmail file: (default "
+ (file-name-nondirectory default-file)
+ ") ")
+ (file-name-directory default-file)
+ default-file)))
+ (if (file-directory-p read-file)
+ (expand-file-name (file-name-nondirectory default-file)
+ read-file)
+ (expand-file-name
+ (or read-file default-file)
+ (file-name-directory default-file)))))
(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)))
+ (file-name-directory rmail-default-rmail-file)))
(if (and (file-readable-p file-name) (not (rmail-file-p file-name)))
(rmail-output file-name count)
(rmail-maybe-set-message-counters)
(let (redelete)
(unwind-protect
(progn
+ ;; 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)
- (if (rmail-message-deleted-p rmail-current-message)
- (progn (setq redelete t)
- (rmail-set-attribute "deleted" nil)))
;; Decide whether to append to a file or to an Emacs buffer.
(save-excursion
(let ((buf (get-file-buffer file-name))
;; 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))
(search-backward "\n\^_")
(narrow-to-region (point) (point-max))
(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)))
(rmail-next-undeleted-message 1))))))
;; 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
;;; There are functions elsewhere in Emacs that use this function; check
;;; them out before you change the calling method.
-(defun rmail-output (file-name &optional count noattribute)
- "Append this message to Unix mail file named FILE-NAME.
+(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 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.
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."
+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))
- (prefix-numeric-value current-prefix-arg)))
+ (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 not suggestions, use same file as last time.
+ (or answer rmail-default-file))))
+ (list (setq rmail-default-file
+ (let ((read-file
+ (read-file-name
+ (concat "Output message to Unix mail file: (default "
+ (file-name-nondirectory default-file)
+ ") ")
+ (file-name-directory default-file)
+ default-file)))
+ (if (file-directory-p read-file)
+ (expand-file-name (file-name-nondirectory default-file)
+ read-file)
+ (expand-file-name
+ (or read-file default-file)
+ (file-name-directory default-file)))))
+ (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))))
+ (and rmail-default-file
+ (file-name-directory rmail-default-file))))
(if (and (file-readable-p file-name) (rmail-file-p file-name))
(rmail-output-to-rmail-file file-name count)
(let ((orig-count count)
(case-fold-search t)
(tembuf (get-buffer-create " rmail-output"))
(original-headers-p
- (save-excursion
- (save-restriction
- (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
- (goto-char (point-min))
- (forward-line 1)
- (= (following-char) ?0))))
+ (and (not from-gnus)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
+ (goto-char (point-min))
+ (forward-line 1)
+ (= (following-char) ?0)))))
header-beginning
mail-from)
(while (> count 0)
- (setq mail-from
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (rmail-msgbeg rmail-current-message))
- (setq header-beginning (point))
- (search-forward "\n*** EOOH ***\n")
- (narrow-to-region header-beginning (point))
- (mail-fetch-field "Mail-From"))))
+ (or from-gnus
+ (setq mail-from
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (rmail-msgbeg rmail-current-message))
+ (setq header-beginning (point))
+ (search-forward "\n*** EOOH ***\n")
+ (narrow-to-region header-beginning (point))
+ (mail-fetch-field "Mail-From")))))
(save-excursion
(set-buffer tembuf)
(erase-buffer)
(if (equal major-mode 'rmail-mode)
(rmail-set-attribute "filed" t)))
(setq count (1- count))
- (let ((next-message-p
- (if rmail-delete-after-output
- (rmail-delete-forward)
- (if (> count 0)
- (rmail-next-undeleted-message 1))))
- (num-appended (- orig-count count)))
- (if (and next-message-p original-headers-p)
- (rmail-toggle-header))
- (if (and (> count 0) (not next-message-p))
- (progn
- (error
- (save-excursion
- (set-buffer rmailbuf)
- (format "Only %d message%s appended" num-appended
- (if (= num-appended 1) "" "s"))))
- (setq count 0)))))
+ (or from-gnus
+ (let ((next-message-p
+ (if rmail-delete-after-output
+ (rmail-delete-forward)
+ (if (> count 0)
+ (rmail-next-undeleted-message 1))))
+ (num-appended (- orig-count count)))
+ (if (and next-message-p original-headers-p)
+ (rmail-toggle-header))
+ (if (and (> count 0) (not next-message-p))
+ (progn
+ (error
+ (save-excursion
+ (set-buffer rmailbuf)
+ (format "Only %d message%s appended" num-appended
+ (if (= num-appended 1) "" "s"))))
+ (setq count 0))))))
(kill-buffer tembuf))))
;;; rmailout.el ends here
HCoop / bpt / emacs.git / blobdiff