;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
-;; Copyright (C) 1985, 1987, 1993, 1994, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1993-1994, 2001-2012
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
(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
"Regexp describing fields to exclude when outputting a message to a file.
(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'.
(save-restriction
(unless (looking-at "^From ")
(error "Invalid mbox message"))
- (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
+ (insert "\^L\n0,,\n*** EOOH ***\n")
(rmail-nuke-pinhead-header)
;; Decode base64 or quoted printable contents, Rmail style.
(let* ((header-end (save-excursion
(widen)
;; Make sure message ends with blank line.
(goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (unless (looking-back "\n\n")
- (insert "\n"))
+ (rmail-ensure-blank-line)
(goto-char (point-min))
(let ((buf (find-buffer-visiting file-name))
(tembuf (current-buffer)))
(if (null buf)
(let ((coding-system-for-write 'raw-text-unix))
+ ;; FIXME should ensure existing file ends with a blank line.
(write-region (point-min) (point-max) file-name t nomsg))
(if (eq buf (current-buffer))
(error "Can't output message to same file it's already in"))
display message number MSG."
(save-excursion
(rmail-swap-buffers-maybe)
- ;; Turn on Auto Save mode, if it's off in this
- ;; buffer but enabled by default.
+ (rmail-modify-format)
+ ;; Turn on Auto Save mode, if it's off in this buffer but enabled
+ ;; by default.
(and (not buffer-auto-save-file-name)
auto-save-default
(auto-save-mode t))
(rmail-maybe-set-message-counters)
- (narrow-to-region (point-max) (point-max))
+ ;; Insert the new message after the last old message.
+ (widen)
+ (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.
(if (rmail-summary-exists)
(rmail-select-summary (rmail-update-summary)))
(rmail-show-message-1 msg)))
(if noattribute (setq noattribute 'nomsg))
(let ((babyl-format (and (file-readable-p file-name)
(mail-file-babyl-p file-name)))
- (cur (current-buffer)))
+ (cur (current-buffer))
+ (buf (find-buffer-visiting file-name)))
+
+ ;; If a babyl file is visited in a buffer, is it visited as babyl
+ ;; or as mbox?
+ (and babyl-format buf
+ (with-current-buffer buf
+ (save-restriction
+ (widen)
+ (save-excursion
+ (goto-char (point-min))
+ (setq babyl-format
+ (looking-at "BABYL OPTIONS:"))))))
+
(if not-rmail ; eg via message-fcc-handler-function
(with-temp-buffer
(insert-buffer-substring cur)
(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)
;; FIXME nothing outside uses this, so NOT-RMAIL could be dropped.
;; FIXME this duplicates code from rmail-output.
+;;;###autoload
(defun rmail-output-as-seen (file-name &optional count noattribute not-rmail)
"Append this message to mbox file named FILE-NAME.
The details are as for `rmail-output', except that:
(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)
(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")
(if rmail-delete-after-output
(rmail-delete-forward)))
-;; arch-tag: 4059abf0-f249-4be4-8e0d-602d370d01d1
;;; rmailout.el ends here
HCoop / bpt / emacs.git / blobdiff