[Emacs-diffs] /srv/bzr/emacs/trunk r109665: rmail-output-read-file-name fix for bug#12214

[Glenn Morris]

------------------------------------------------------------
revno: 109665
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Fri 2012-08-17 16:38:47 -0400
message:
  rmail-output-read-file-name fix for bug#12214
  
  This resembles the 2001-05-07 change to rmail-output-read-rmail-file-name,
  which was never copied to rmail-output-read-file-name.
  It's more complicated now due to Rmail's buffer swapping.
  
  * lisp/mail/rmailout.el (rmail-output-read-file-name):
  Check rmail-output-file-alist against the full message body
  in the correct rmail buffer.
  
  * lisp/mail/rmail.el: Comment.
modified:
  lisp/ChangeLog
  lisp/mail/rmail.el
  lisp/mail/rmailout.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-08-17 09:18:18 +0000
+++ b/lisp/ChangeLog    2012-08-17 20:38:47 +0000
@@ -1,3 +1,9 @@
+2012-08-17  Glenn Morris  <address@hidden>
+
+       * 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  <address@hidden>
 
        * net/tramp-sh.el (tramp-sh-handle-start-file-process): Eliminate

=== modified file 'lisp/mail/rmail.el'
--- a/lisp/mail/rmail.el        2012-06-10 13:20:58 +0000
+++ b/lisp/mail/rmail.el        2012-08-17 20:38:47 +0000
@@ -663,6 +663,7 @@
 (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

=== modified file 'lisp/mail/rmailout.el'
--- a/lisp/mail/rmailout.el     2012-01-19 07:21:25 +0000
+++ b/lisp/mail/rmailout.el     2012-08-17 20:38:47 +0000
@@ -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 @@
                               (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 @@
 
 (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'.