aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-07-09 20:46:42 +0000
committerRichard M. Stallman1993-07-09 20:46:42 +0000
commitdba3adb09b723188607eb156d6d51a4bb5d3ae5f (patch)
tree4b4a1b20f06d77afada0f95f52b57118f9991446
parentf920529b21e5729a63681f2590e31887314c9716 (diff)
downloademacs-dba3adb09b723188607eb156d6d51a4bb5d3ae5f.tar.gz
emacs-dba3adb09b723188607eb156d6d51a4bb5d3ae5f.zip
(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.
-rw-r--r--lisp/mail/rmailout.el226
1 files changed, 117 insertions, 109 deletions
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index f97cb2dcb04..d2584dd848b 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,6 +1,6 @@
1;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. 1;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
2 2
3;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc.
4 4
5;; Maintainer: FSF 5;; Maintainer: FSF
6;; Keywords: mail 6;; Keywords: mail
@@ -29,7 +29,10 @@
29 29
30(defvar rmail-output-file-alist nil 30(defvar rmail-output-file-alist nil
31 "*Alist matching regexps to suggested output Rmail files. 31 "*Alist matching regexps to suggested output Rmail files.
32This is a list of elements of the form (REGEXP . FILENAME).") 32This is a list of elements of the form (REGEXP . NAME-EXP).
33NAME-EXP may be a string constant giving the file name to use,
34or more generally it may be any kind of expression that returns
35a file name as a string.")
33 36
34;;; There are functions elsewhere in Emacs that use this function; check 37;;; There are functions elsewhere in Emacs that use this function; check
35;;; them out before you change the calling method. 38;;; them out before you change the calling method.
@@ -38,6 +41,9 @@ This is a list of elements of the form (REGEXP . FILENAME).")
38If the file does not exist, ask if it should be created. 41If the file does not exist, ask if it should be created.
39If file is being visited, the message is appended to the Emacs 42If file is being visited, the message is appended to the Emacs
40buffer visiting that file. 43buffer visiting that file.
44If the file exists and is not an Rmail file,
45the message is appended in inbox format.
46
41A prefix argument N says to output N consecutive messages 47A prefix argument N says to output N consecutive messages
42starting with the current one. Deleted messages are skipped and don't count." 48starting with the current one. Deleted messages are skipped and don't count."
43 (interactive 49 (interactive
@@ -49,7 +55,7 @@ starting with the current one. Deleted messages are skipped and don't count."
49 (save-excursion 55 (save-excursion
50 (goto-char (point-min)) 56 (goto-char (point-min))
51 (if (re-search-forward (car (car tail)) nil t) 57 (if (re-search-forward (car (car tail)) nil t)
52 (setq answer (cdr (car tail)))) 58 (setq answer (eval (cdr (car tail)))))
53 (setq tail (cdr tail)))) 59 (setq tail (cdr tail))))
54 ;; If not suggestions, use same file as last time. 60 ;; If not suggestions, use same file as last time.
55 (or answer rmail-last-rmail-file)))) 61 (or answer rmail-last-rmail-file))))
@@ -64,69 +70,81 @@ starting with the current one. Deleted messages are skipped and don't count."
64 (setq file-name 70 (setq file-name
65 (expand-file-name file-name 71 (expand-file-name file-name
66 (file-name-directory rmail-last-rmail-file))) 72 (file-name-directory rmail-last-rmail-file)))
67 (setq rmail-last-rmail-file file-name) 73 (if (and (file-readable-p file-name) (not (rmail-file-p file-name)))
68 (rmail-maybe-set-message-counters) 74 (rmail-output file-name count)
69 (setq file-name (abbreviate-file-name file-name)) 75 (setq rmail-last-rmail-file file-name)
70 (or (get-file-buffer file-name) 76 (rmail-maybe-set-message-counters)
71 (file-exists-p file-name) 77 (setq file-name (abbreviate-file-name file-name))
72 (if (yes-or-no-p 78 (or (get-file-buffer file-name)
73 (concat "\"" file-name "\" does not exist, create it? ")) 79 (file-exists-p file-name)
74 (let ((file-buffer (create-file-buffer file-name))) 80 (if (yes-or-no-p
75 (save-excursion 81 (concat "\"" file-name "\" does not exist, create it? "))
76 (set-buffer file-buffer) 82 (let ((file-buffer (create-file-buffer file-name)))
77 (rmail-insert-rmail-file-header)
78 (let ((require-final-newline nil))
79 (write-region (point-min) (point-max) file-name t 1)))
80 (kill-buffer file-buffer))
81 (error "Output file does not exist")))
82 (while (> count 0)
83 (let (redelete)
84 (unwind-protect
85 (progn
86 (save-restriction
87 (widen)
88 (if (rmail-message-deleted-p rmail-current-message)
89 (progn (setq redelete t)
90 (rmail-set-attribute "deleted" nil)))
91 ;; Decide whether to append to a file or to an Emacs buffer.
92 (save-excursion 83 (save-excursion
93 (let ((buf (get-file-buffer file-name)) 84 (set-buffer file-buffer)
94 (cur (current-buffer)) 85 (rmail-insert-rmail-file-header)
95 (beg (1+ (rmail-msgbeg rmail-current-message))) 86 (let ((require-final-newline nil))
96 (end (1+ (rmail-msgend rmail-current-message)))) 87 (write-region (point-min) (point-max) file-name t 1)))
97 (if (not buf) 88 (kill-buffer file-buffer))
98 (append-to-file beg end file-name) 89 (error "Output file does not exist")))
99 (if (eq buf (current-buffer)) 90 (while (> count 0)
100 (error "Can't output message to same file it's already in")) 91 (let (redelete)
101 ;; File has been visited, in buffer BUF. 92 (unwind-protect
102 (set-buffer buf) 93 (progn
103 (let ((buffer-read-only nil) 94 (save-restriction
104 (msg (and (boundp 'rmail-current-message) 95 (widen)
105 rmail-current-message))) 96 (if (rmail-message-deleted-p rmail-current-message)
106 ;; If MSG is non-nil, buffer is in RMAIL mode. 97 (progn (setq redelete t)
107 (if msg 98 (rmail-set-attribute "deleted" nil)))
108 (progn 99 ;; Decide whether to append to a file or to an Emacs buffer.
109 (rmail-maybe-set-message-counters) 100 (save-excursion
110 (widen) 101 (let ((buf (get-file-buffer file-name))
111 (narrow-to-region (point-max) (point-max)) 102 (cur (current-buffer))
112 (insert-buffer-substring cur beg end) 103 (beg (1+ (rmail-msgbeg rmail-current-message)))
113 (goto-char (point-min)) 104 (end (1+ (rmail-msgend rmail-current-message))))
114 (widen) 105 (if (not buf)
115 (search-backward "\n\^_") 106 (append-to-file beg end file-name)
116 (narrow-to-region (point) (point-max)) 107 (if (eq buf (current-buffer))
117 (rmail-count-new-messages t) 108 (error "Can't output message to same file it's already in"))
118 (rmail-show-message msg)) 109 ;; File has been visited, in buffer BUF.
119 ;; Output file not in rmail mode => just insert at the end. 110 (set-buffer buf)
120 (narrow-to-region (point-min) (1+ (buffer-size))) 111 (let ((buffer-read-only nil)
121 (goto-char (point-max)) 112 (msg (and (boundp 'rmail-current-message)
122 (insert-buffer-substring cur beg end))))))) 113 rmail-current-message)))
123 (rmail-set-attribute "filed" t)) 114 ;; If MSG is non-nil, buffer is in RMAIL mode.
124 (if redelete (rmail-set-attribute "deleted" t)))) 115 (if msg
125 (setq count (1- count)) 116 (progn
126 (if rmail-delete-after-output 117 (rmail-maybe-set-message-counters)
127 (rmail-delete-forward) 118 (widen)
128 (if (> count 0) 119 (narrow-to-region (point-max) (point-max))
129 (rmail-next-undeleted-message 1))))) 120 (insert-buffer-substring cur beg end)
121 (goto-char (point-min))
122 (widen)
123 (search-backward "\n\^_")
124 (narrow-to-region (point) (point-max))
125 (rmail-count-new-messages t)
126 (rmail-show-message msg))
127 ;; Output file not in rmail mode => just insert at the end.
128 (narrow-to-region (point-min) (1+ (buffer-size)))
129 (goto-char (point-max))
130 (insert-buffer-substring cur beg end)))))))
131 (rmail-set-attribute "filed" t))
132 (if redelete (rmail-set-attribute "deleted" t))))
133 (setq count (1- count))
134 (if rmail-delete-after-output
135 (rmail-delete-forward)
136 (if (> count 0)
137 (rmail-next-undeleted-message 1))))))
138
139;; Returns t if file FILE is an Rmail file.
140(defun rmail-file-p (file)
141 (let ((buf (generate-new-buffer " *rmail-file-p*")))
142 (unwind-protect
143 (save-excursion
144 (set-buffer buf)
145 (insert-file-contents file nil 0 100)
146 (looking-at "BABYL OPTIONS:"))
147 (kill-buffer buf))))
130 148
131;;; There are functions elsewhere in Emacs that use this function; check 149;;; There are functions elsewhere in Emacs that use this function; check
132;;; them out before you change the calling method. 150;;; them out before you change the calling method.
@@ -151,49 +169,39 @@ When called from lisp code, N may be omitted."
151 (expand-file-name file-name 169 (expand-file-name file-name
152 (and rmail-last-file 170 (and rmail-last-file
153 (file-name-directory rmail-last-file)))) 171 (file-name-directory rmail-last-file))))
154 (setq rmail-last-file file-name) 172 (if (and (file-readable-p file) (rmail-file-p file-name))
155 (while (> count 0) 173 (rmail-output-to-rmail-file file-name count)
156 (let ((rmailbuf (current-buffer)) 174 (setq rmail-last-file file-name)
157 (tembuf (get-buffer-create " rmail-output")) 175 (while (> count 0)
158 (case-fold-search t)) 176 (let ((rmailbuf (current-buffer))
159 (save-excursion 177 (tembuf (get-buffer-create " rmail-output"))
160 (set-buffer tembuf) 178 (case-fold-search t))
161 (erase-buffer) 179 (save-excursion
162 ;; If we can do it, read a little of the file 180 (set-buffer tembuf)
163 ;; to check whether it is an RMAIL file. 181 (erase-buffer)
164 ;; If it is, don't mess it up. 182 (insert-buffer-substring rmailbuf)
165 (and (file-readable-p file-name) 183 (insert "\n")
166 (progn (insert-file-contents file-name nil 0 20) 184 (goto-char (point-min))
167 (looking-at "BABYL OPTIONS:\n")) 185 (insert "From "
168 (error (save-excursion 186 (mail-strip-quoted-names (or (mail-fetch-field "from")
169 (set-buffer rmailbuf) 187 (mail-fetch-field "really-from")
170 (substitute-command-keys 188 (mail-fetch-field "sender")
171 "Use \\[rmail-output-to-rmail-file] to output to Rmail file `%s'")) 189 "unknown"))
172 (file-name-nondirectory file-name))) 190 " " (current-time-string) "\n")
173 (erase-buffer) 191 ;; ``Quote'' "\nFrom " as "\n>From "
174 (insert-buffer-substring rmailbuf) 192 ;; (note that this isn't really quoting, as there is no requirement
175 (insert "\n") 193 ;; that "\n[>]+From " be quoted in the same transparent way.)
176 (goto-char (point-min)) 194 (while (search-forward "\nFrom " nil t)
177 (insert "From " 195 (forward-char -5)
178 (mail-strip-quoted-names (or (mail-fetch-field "from") 196 (insert ?>))
179 (mail-fetch-field "really-from") 197 (append-to-file (point-min) (point-max) file-name))
180 (mail-fetch-field "sender") 198 (kill-buffer tembuf))
181 "unknown")) 199 (if (equal major-mode 'rmail-mode)
182 " " (current-time-string) "\n") 200 (rmail-set-attribute "filed" t))
183 ;; ``Quote'' "\nFrom " as "\n>From " 201 (setq count (1- count))
184 ;; (note that this isn't really quoting, as there is no requirement 202 (if rmail-delete-after-output
185 ;; that "\n[>]+From " be quoted in the same transparent way.) 203 (rmail-delete-forward)
186 (while (search-forward "\nFrom " nil t) 204 (if (> count 0)
187 (forward-char -5) 205 (rmail-next-undeleted-message 1)))))
188 (insert ?>))
189 (append-to-file (point-min) (point-max) file-name))
190 (kill-buffer tembuf))
191 (if (equal major-mode 'rmail-mode)
192 (rmail-set-attribute "filed" t))
193 (setq count (1- count))
194 (if rmail-delete-after-output
195 (rmail-delete-forward)
196 (if (> count 0)
197 (rmail-next-undeleted-message 1)))))
198 206
199;;; rmailout.el ends here 207;;; rmailout.el ends here