(rmail-output): If file is an Rmail file,
use rmail-output-to-rmail-file. (rmail-output-to-rmail-file): If file exists and is not an Rmail file, use rmail-output. If we find an element in rmail-output-file-alist, eval it. (rmail-file-p): New function. (rmail-output-file-alist): Now contains expressions to eval.
This commit is contained in:
Richard M. Stallman
parent
f920529b21
commit
dba3adb09b
1 changed files with 117 additions and 109 deletions
|
|
@ -1,6 +1,6 @@
|
||||||
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
|
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
|
||||||
|
|
||||||
;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
|
;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc.
|
||||||
|
|
||||||
;; Maintainer: FSF
|
;; Maintainer: FSF
|
||||||
;; Keywords: mail
|
;; Keywords: mail
|
||||||
|
|
@ -29,7 +29,10 @@
|
||||||
|
|
||||||
(defvar rmail-output-file-alist nil
|
(defvar rmail-output-file-alist nil
|
||||||
"*Alist matching regexps to suggested output Rmail files.
|
"*Alist matching regexps to suggested output Rmail files.
|
||||||
This is a list of elements of the form (REGEXP . FILENAME).")
|
This is a list of elements of the form (REGEXP . NAME-EXP).
|
||||||
|
NAME-EXP may be a string constant giving the file name to use,
|
||||||
|
or more generally it may be any kind of expression that returns
|
||||||
|
a file name as a string.")
|
||||||
|
|
||||||
;;; There are functions elsewhere in Emacs that use this function; check
|
;;; There are functions elsewhere in Emacs that use this function; check
|
||||||
;;; them out before you change the calling method.
|
;;; them out before you change the calling method.
|
||||||
|
|
@ -38,6 +41,9 @@ This is a list of elements of the form (REGEXP . FILENAME).")
|
||||||
If the file does not exist, ask if it should be created.
|
If the file does not exist, ask if it should be created.
|
||||||
If file is being visited, the message is appended to the Emacs
|
If file is being visited, the message is appended to the Emacs
|
||||||
buffer visiting that file.
|
buffer visiting that file.
|
||||||
|
If the file exists and is not an Rmail file,
|
||||||
|
the message is appended in inbox format.
|
||||||
|
|
||||||
A prefix argument N says to output N consecutive messages
|
A prefix argument N says to output N consecutive messages
|
||||||
starting with the current one. Deleted messages are skipped and don't count."
|
starting with the current one. Deleted messages are skipped and don't count."
|
||||||
(interactive
|
(interactive
|
||||||
|
|
@ -49,7 +55,7 @@ starting with the current one. Deleted messages are skipped and don't count."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(if (re-search-forward (car (car tail)) nil t)
|
(if (re-search-forward (car (car tail)) nil t)
|
||||||
(setq answer (cdr (car tail))))
|
(setq answer (eval (cdr (car tail)))))
|
||||||
(setq tail (cdr tail))))
|
(setq tail (cdr tail))))
|
||||||
;; If not suggestions, use same file as last time.
|
;; If not suggestions, use same file as last time.
|
||||||
(or answer rmail-last-rmail-file))))
|
(or answer rmail-last-rmail-file))))
|
||||||
|
|
@ -64,69 +70,81 @@ starting with the current one. Deleted messages are skipped and don't count."
|
||||||
(setq file-name
|
(setq file-name
|
||||||
(expand-file-name file-name
|
(expand-file-name file-name
|
||||||
(file-name-directory rmail-last-rmail-file)))
|
(file-name-directory rmail-last-rmail-file)))
|
||||||
(setq rmail-last-rmail-file file-name)
|
(if (and (file-readable-p file-name) (not (rmail-file-p file-name)))
|
||||||
(rmail-maybe-set-message-counters)
|
(rmail-output file-name count)
|
||||||
(setq file-name (abbreviate-file-name file-name))
|
(setq rmail-last-rmail-file file-name)
|
||||||
(or (get-file-buffer file-name)
|
(rmail-maybe-set-message-counters)
|
||||||
(file-exists-p file-name)
|
(setq file-name (abbreviate-file-name file-name))
|
||||||
(if (yes-or-no-p
|
(or (get-file-buffer file-name)
|
||||||
(concat "\"" file-name "\" does not exist, create it? "))
|
(file-exists-p file-name)
|
||||||
(let ((file-buffer (create-file-buffer file-name)))
|
(if (yes-or-no-p
|
||||||
(save-excursion
|
(concat "\"" file-name "\" does not exist, create it? "))
|
||||||
(set-buffer file-buffer)
|
(let ((file-buffer (create-file-buffer file-name)))
|
||||||
(rmail-insert-rmail-file-header)
|
|
||||||
(let ((require-final-newline nil))
|
|
||||||
(write-region (point-min) (point-max) file-name t 1)))
|
|
||||||
(kill-buffer file-buffer))
|
|
||||||
(error "Output file does not exist")))
|
|
||||||
(while (> count 0)
|
|
||||||
(let (redelete)
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(save-restriction
|
|
||||||
(widen)
|
|
||||||
(if (rmail-message-deleted-p rmail-current-message)
|
|
||||||
(progn (setq redelete t)
|
|
||||||
(rmail-set-attribute "deleted" nil)))
|
|
||||||
;; Decide whether to append to a file or to an Emacs buffer.
|
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((buf (get-file-buffer file-name))
|
(set-buffer file-buffer)
|
||||||
(cur (current-buffer))
|
(rmail-insert-rmail-file-header)
|
||||||
(beg (1+ (rmail-msgbeg rmail-current-message)))
|
(let ((require-final-newline nil))
|
||||||
(end (1+ (rmail-msgend rmail-current-message))))
|
(write-region (point-min) (point-max) file-name t 1)))
|
||||||
(if (not buf)
|
(kill-buffer file-buffer))
|
||||||
(append-to-file beg end file-name)
|
(error "Output file does not exist")))
|
||||||
(if (eq buf (current-buffer))
|
(while (> count 0)
|
||||||
(error "Can't output message to same file it's already in"))
|
(let (redelete)
|
||||||
;; File has been visited, in buffer BUF.
|
(unwind-protect
|
||||||
(set-buffer buf)
|
(progn
|
||||||
(let ((buffer-read-only nil)
|
(save-restriction
|
||||||
(msg (and (boundp 'rmail-current-message)
|
(widen)
|
||||||
rmail-current-message)))
|
(if (rmail-message-deleted-p rmail-current-message)
|
||||||
;; If MSG is non-nil, buffer is in RMAIL mode.
|
(progn (setq redelete t)
|
||||||
(if msg
|
(rmail-set-attribute "deleted" nil)))
|
||||||
(progn
|
;; Decide whether to append to a file or to an Emacs buffer.
|
||||||
(rmail-maybe-set-message-counters)
|
(save-excursion
|
||||||
(widen)
|
(let ((buf (get-file-buffer file-name))
|
||||||
(narrow-to-region (point-max) (point-max))
|
(cur (current-buffer))
|
||||||
(insert-buffer-substring cur beg end)
|
(beg (1+ (rmail-msgbeg rmail-current-message)))
|
||||||
(goto-char (point-min))
|
(end (1+ (rmail-msgend rmail-current-message))))
|
||||||
(widen)
|
(if (not buf)
|
||||||
(search-backward "\n\^_")
|
(append-to-file beg end file-name)
|
||||||
(narrow-to-region (point) (point-max))
|
(if (eq buf (current-buffer))
|
||||||
(rmail-count-new-messages t)
|
(error "Can't output message to same file it's already in"))
|
||||||
(rmail-show-message msg))
|
;; File has been visited, in buffer BUF.
|
||||||
;; Output file not in rmail mode => just insert at the end.
|
(set-buffer buf)
|
||||||
(narrow-to-region (point-min) (1+ (buffer-size)))
|
(let ((buffer-read-only nil)
|
||||||
(goto-char (point-max))
|
(msg (and (boundp 'rmail-current-message)
|
||||||
(insert-buffer-substring cur beg end)))))))
|
rmail-current-message)))
|
||||||
(rmail-set-attribute "filed" t))
|
;; If MSG is non-nil, buffer is in RMAIL mode.
|
||||||
(if redelete (rmail-set-attribute "deleted" t))))
|
(if msg
|
||||||
(setq count (1- count))
|
(progn
|
||||||
(if rmail-delete-after-output
|
(rmail-maybe-set-message-counters)
|
||||||
(rmail-delete-forward)
|
(widen)
|
||||||
(if (> count 0)
|
(narrow-to-region (point-max) (point-max))
|
||||||
(rmail-next-undeleted-message 1)))))
|
(insert-buffer-substring cur beg end)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(widen)
|
||||||
|
(search-backward "\n\^_")
|
||||||
|
(narrow-to-region (point) (point-max))
|
||||||
|
(rmail-count-new-messages t)
|
||||||
|
(rmail-show-message msg))
|
||||||
|
;; Output file not in rmail mode => just insert at the end.
|
||||||
|
(narrow-to-region (point-min) (1+ (buffer-size)))
|
||||||
|
(goto-char (point-max))
|
||||||
|
(insert-buffer-substring cur beg end)))))))
|
||||||
|
(rmail-set-attribute "filed" t))
|
||||||
|
(if redelete (rmail-set-attribute "deleted" t))))
|
||||||
|
(setq count (1- count))
|
||||||
|
(if rmail-delete-after-output
|
||||||
|
(rmail-delete-forward)
|
||||||
|
(if (> count 0)
|
||||||
|
(rmail-next-undeleted-message 1))))))
|
||||||
|
|
||||||
|
;; Returns t if file FILE is an Rmail file.
|
||||||
|
(defun rmail-file-p (file)
|
||||||
|
(let ((buf (generate-new-buffer " *rmail-file-p*")))
|
||||||
|
(unwind-protect
|
||||||
|
(save-excursion
|
||||||
|
(set-buffer buf)
|
||||||
|
(insert-file-contents file nil 0 100)
|
||||||
|
(looking-at "BABYL OPTIONS:"))
|
||||||
|
(kill-buffer buf))))
|
||||||
|
|
||||||
;;; There are functions elsewhere in Emacs that use this function; check
|
;;; There are functions elsewhere in Emacs that use this function; check
|
||||||
;;; them out before you change the calling method.
|
;;; them out before you change the calling method.
|
||||||
|
|
@ -151,49 +169,39 @@ When called from lisp code, N may be omitted."
|
||||||
(expand-file-name file-name
|
(expand-file-name file-name
|
||||||
(and rmail-last-file
|
(and rmail-last-file
|
||||||
(file-name-directory rmail-last-file))))
|
(file-name-directory rmail-last-file))))
|
||||||
(setq rmail-last-file file-name)
|
(if (and (file-readable-p file) (rmail-file-p file-name))
|
||||||
(while (> count 0)
|
(rmail-output-to-rmail-file file-name count)
|
||||||
(let ((rmailbuf (current-buffer))
|
(setq rmail-last-file file-name)
|
||||||
(tembuf (get-buffer-create " rmail-output"))
|
(while (> count 0)
|
||||||
(case-fold-search t))
|
(let ((rmailbuf (current-buffer))
|
||||||
(save-excursion
|
(tembuf (get-buffer-create " rmail-output"))
|
||||||
(set-buffer tembuf)
|
(case-fold-search t))
|
||||||
(erase-buffer)
|
(save-excursion
|
||||||
;; If we can do it, read a little of the file
|
(set-buffer tembuf)
|
||||||
;; to check whether it is an RMAIL file.
|
(erase-buffer)
|
||||||
;; If it is, don't mess it up.
|
(insert-buffer-substring rmailbuf)
|
||||||
(and (file-readable-p file-name)
|
(insert "\n")
|
||||||
(progn (insert-file-contents file-name nil 0 20)
|
(goto-char (point-min))
|
||||||
(looking-at "BABYL OPTIONS:\n"))
|
(insert "From "
|
||||||
(error (save-excursion
|
(mail-strip-quoted-names (or (mail-fetch-field "from")
|
||||||
(set-buffer rmailbuf)
|
(mail-fetch-field "really-from")
|
||||||
(substitute-command-keys
|
(mail-fetch-field "sender")
|
||||||
"Use \\[rmail-output-to-rmail-file] to output to Rmail file `%s'"))
|
"unknown"))
|
||||||
(file-name-nondirectory file-name)))
|
" " (current-time-string) "\n")
|
||||||
(erase-buffer)
|
;; ``Quote'' "\nFrom " as "\n>From "
|
||||||
(insert-buffer-substring rmailbuf)
|
;; (note that this isn't really quoting, as there is no requirement
|
||||||
(insert "\n")
|
;; that "\n[>]+From " be quoted in the same transparent way.)
|
||||||
(goto-char (point-min))
|
(while (search-forward "\nFrom " nil t)
|
||||||
(insert "From "
|
(forward-char -5)
|
||||||
(mail-strip-quoted-names (or (mail-fetch-field "from")
|
(insert ?>))
|
||||||
(mail-fetch-field "really-from")
|
(append-to-file (point-min) (point-max) file-name))
|
||||||
(mail-fetch-field "sender")
|
(kill-buffer tembuf))
|
||||||
"unknown"))
|
(if (equal major-mode 'rmail-mode)
|
||||||
" " (current-time-string) "\n")
|
(rmail-set-attribute "filed" t))
|
||||||
;; ``Quote'' "\nFrom " as "\n>From "
|
(setq count (1- count))
|
||||||
;; (note that this isn't really quoting, as there is no requirement
|
(if rmail-delete-after-output
|
||||||
;; that "\n[>]+From " be quoted in the same transparent way.)
|
(rmail-delete-forward)
|
||||||
(while (search-forward "\nFrom " nil t)
|
(if (> count 0)
|
||||||
(forward-char -5)
|
(rmail-next-undeleted-message 1)))))
|
||||||
(insert ?>))
|
|
||||||
(append-to-file (point-min) (point-max) file-name))
|
|
||||||
(kill-buffer tembuf))
|
|
||||||
(if (equal major-mode 'rmail-mode)
|
|
||||||
(rmail-set-attribute "filed" t))
|
|
||||||
(setq count (1- count))
|
|
||||||
(if rmail-delete-after-output
|
|
||||||
(rmail-delete-forward)
|
|
||||||
(if (> count 0)
|
|
||||||
(rmail-next-undeleted-message 1)))))
|
|
||||||
|
|
||||||
;;; rmailout.el ends here
|
;;; rmailout.el ends here
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue