Update copyright year to 2014 by running admin/update-copyright.

[bpt/emacs.git] / lisp / mail / rmailout.el

diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 3926b42..3ca46d3 100644 (file)
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,7 +1,7 @@
 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
 
-;; Copyright (C) 1985, 1987, 1993-1994, 2001-2011
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1993-1994, 2001-2014 Free Software
+;; Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
@@ -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,57 @@ 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))))
+Set `rmail-default-file' to this name as well as returning it.
+This uses `rmail-output-file-alist'."
+  (let* ((default-file
+          (or
+           (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 err)
+                       ;; 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
+                                   (condition-case err
+                                       (eval (cdar tail))
+                                     (error
+                                      (display-warning
+                                       :error
+                                       (format "Error evaluating \
+`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n"
+                                               (caar tail) (cdar tail) err))
+                                      nil))))
+                         (setq tail (cdr tail)))
+                       answer))))))
            ;; 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)))))))
+           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'.
@@ -377,11 +399,12 @@ display message number MSG."
     (rmail-maybe-set-message-counters)
     ;; Insert the new message after the last old message.
     (widen)
-    ;; Make sure the last old message ends with a blank line.
-    (goto-char (point-max))
-    (rmail-ensure-blank-line)
-    ;; Insert the new message at the end.
-    (narrow-to-region (point-max) (point-max))
+    (unless (zerop (buffer-size))
+      ;; Make sure the last old message ends with a blank line.
+      (goto-char (point-max))
+      (rmail-ensure-blank-line)
+      ;; Insert the new message at the end.
+      (narrow-to-region (point-max) (point-max)))
     (insert-buffer-substring tembuf)
     (rmail-count-new-messages t)
     ;; FIXME should re-use existing windows.
@@ -467,6 +490,8 @@ from a non-Rmail buffer.  In this case, COUNT is ignored."
       (if rmail-buffer
          (set-buffer rmail-buffer)
        (error "There is no Rmail buffer"))
+      (if (zerop rmail-total-messages)
+         (error "No messages to output"))
       (let ((orig-count count)
            beg end)
        (while (> count 0)
@@ -532,6 +557,8 @@ so you should call `rmail-output' directly in that case."
     (if rmail-buffer
        (set-buffer rmail-buffer)
       (error "There is no Rmail buffer"))
+    (if (zerop rmail-total-messages)
+       (error "No messages to output"))
     (let ((orig-count count)
          (cur (current-buffer)))
       (while (> count 0)
@@ -593,6 +620,8 @@ than appending to it.  Deletes the message after writing if
        (expand-file-name file-name
                          (and rmail-default-body-file
                               (file-name-directory rmail-default-body-file))))
+  (if (zerop rmail-current-message)
+      (error "No message to output"))
   (save-excursion
     (goto-char (point-min))
     (search-forward "\n\n")