mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-23 10:34:07 +00:00
Code Issues Releases Activity

rmail-output-read-file-name fix for bug#12214

Browse Source 
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.
This commit is contained in:
Glenn Morris 2012-08-17 16:38:47 -04:00
parent 0b390a9dcf
commit ee21815118
3 changed files with 48 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/ChangeLog
View File

@ -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

1
lisp/mail/rmail.el
View File

@ -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

71
lisp/mail/rmailout.el
View File

@ -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'.