X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/412f24b9ddf1e07022f8c5fe05f0717f130c4c02..ba3189039adc8ec5eba5ed3e21d42019a4616b7c:/lisp/mail/rmailout.el

diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 3926b426a6..3ca46d3559 100644
--- 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")