diff options
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 1 | ||||
| -rw-r--r-- | lisp/mail/rmailout.el | 71 |
3 files changed, 48 insertions, 30 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6be54850414..84a8ec18507 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-08-17 Glenn Morris <rgm@gnu.org> + + * mail/rmailout.el (rmail-output-read-file-name): + Check rmail-output-file-alist against the full message body + in the correct rmail buffer. (Bug#12214) + 2012-08-17 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-start-file-process): Eliminate diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 9fe8f28a59f..d88862b2d47 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -663,6 +663,7 @@ Element N specifies the summary line for message N+1.") (defvar rmail-last-regexp nil) (put 'rmail-last-regexp 'permanent-local t) +;; Note that rmail-output-read-file-name modifies this. (defcustom rmail-default-file "~/xmail" "Default file name for \\[rmail-output]." :type 'file diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 9c5b99c5184..5d500135b7a 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -34,7 +34,6 @@ :type 'boolean :group 'rmail-output) -;; FIXME risky? (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). @@ -47,6 +46,7 @@ a file name as a string." (string :tag "File Name") sexp))) :group 'rmail-output) +;; This is risky because NAME-EXP gets evalled. ;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t) (defcustom rmail-fields-not-to-output nil @@ -58,35 +58,46 @@ The function `rmail-delete-unwanted-fields' uses this, ignoring case." (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) - (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-default-file)))) - (let ((read-file - (expand-file-name - (read-file-name - (concat "Output message to 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-default-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))))))) +Set `rmail-default-file' to this name as well as returning it. +This uses `rmail-output-file-alist'." + (let* ((default-file + (when rmail-output-file-alist + (or rmail-buffer (error "There is no Rmail buffer")) + (save-current-buffer + (set-buffer rmail-buffer) + (let ((beg (rmail-msgbeg rmail-current-message)) + (end (rmail-msgend rmail-current-message))) + (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) + (save-excursion + (save-restriction + (widen) + (narrow-to-region beg end) + (let ((tail rmail-output-file-alist) + answer) + ;; Suggest a file based on a pattern match. + (while (and tail (not answer)) + (goto-char (point-min)) + (if (re-search-forward (caar tail) nil t) + (setq answer (eval (cdar tail)))) + (setq tail (cdr tail))) + ;; If no suggestion, use same file as last time. + (or answer rmail-default-file)))))))) + (read-file + (expand-file-name + (read-file-name + (concat "Output message to 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-default-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)))))) (defun rmail-delete-unwanted-fields (preserve) "Delete all headers matching `rmail-fields-not-to-output'. |