1 |
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file |
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. |
2 |
|
|
3 |
;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc. |
4 |
|
|
26 |
|
|
27 |
;;; Code: |
;;; Code: |
28 |
|
|
|
(require 'rmail) |
|
29 |
(provide 'rmailout) |
(provide 'rmailout) |
30 |
|
|
31 |
|
(eval-when-compile |
32 |
|
(require 'rmail) |
33 |
|
(require 'rmaildesc)) |
34 |
|
|
35 |
|
|
36 |
;;;###autoload |
;;;###autoload |
37 |
(defcustom rmail-output-file-alist nil |
(defcustom rmail-output-file-alist nil |
38 |
"*Alist matching regexps to suggested output Rmail files. |
"*Alist matching regexps to suggested output Rmail files. |
66 |
(let ((read-file |
(let ((read-file |
67 |
(expand-file-name |
(expand-file-name |
68 |
(read-file-name |
(read-file-name |
69 |
(concat "Output message to Rmail file: (default " |
(concat "Output message to Rmail (mbox) file: (default " |
70 |
(file-name-nondirectory default-file) |
(file-name-nondirectory default-file) |
71 |
") ") |
") ") |
72 |
(file-name-directory default-file) |
(file-name-directory default-file) |
80 |
read-file) |
read-file) |
81 |
read-file))))) |
read-file))))) |
82 |
|
|
83 |
|
;;; mbox: deprecated |
84 |
(defun rmail-output-read-file-name () |
(defun rmail-output-read-file-name () |
85 |
"Read the file name to use for `rmail-output'. |
"Read the file name to use for `rmail-output'. |
86 |
Set `rmail-default-file' to this name as well as returning it." |
Set `rmail-default-file' to this name as well as returning it." |
113 |
(or read-file (file-name-nondirectory default-file)) |
(or read-file (file-name-nondirectory default-file)) |
114 |
(file-name-directory default-file))))))) |
(file-name-directory default-file))))))) |
115 |
|
|
116 |
|
;;; mbox: ready |
117 |
;;; There are functions elsewhere in Emacs that use this function; |
;;; There are functions elsewhere in Emacs that use this function; |
118 |
;;; look at them before you change the calling method. |
;;; look at them before you change the calling method. |
119 |
;;;###autoload |
;;;###autoload |
120 |
(defun rmail-output-to-rmail-file (file-name &optional count stay) |
(defun rmail-output-to-rmail-file (file-name &optional count stay) |
121 |
"Append the current message to an Rmail file named FILE-NAME. |
"Append the current message to an Rmail (mbox) file named FILE-NAME. |
122 |
If the file does not exist, ask if it should be created. |
If the file does not exist, ask if it should be created. |
123 |
If file is being visited, the message is appended to the Emacs |
If file is being visited, the message is appended to the Emacs |
124 |
buffer visiting that file. |
buffer visiting that file. |
136 |
(interactive |
(interactive |
137 |
(list (rmail-output-read-rmail-file-name) |
(list (rmail-output-read-rmail-file-name) |
138 |
(prefix-numeric-value current-prefix-arg))) |
(prefix-numeric-value current-prefix-arg))) |
139 |
(or count (setq count 1)) |
|
140 |
(setq file-name |
;; Use the 'rmail-output function to perform the output. |
141 |
(expand-file-name file-name |
(rmail-output file-name count nil nil) |
142 |
(file-name-directory rmail-default-rmail-file))) |
|
143 |
(if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name))) |
;; Deal with the next message |
144 |
(rmail-output file-name count) |
(if rmail-delete-after-output |
145 |
(rmail-maybe-set-message-counters) |
(unless |
146 |
(setq file-name (abbreviate-file-name file-name)) |
(if (and (= count 0) stay) |
147 |
(or (find-buffer-visiting file-name) |
(rmail-delete-message) |
148 |
(file-exists-p file-name) |
(rmail-delete-forward)) |
149 |
(if (yes-or-no-p |
(setq count 0)) |
150 |
(concat "\"" file-name "\" does not exist, create it? ")) |
(if (> count 0) |
151 |
(let ((file-buffer (create-file-buffer file-name))) |
(unless |
152 |
(save-excursion |
(if (not stay) (rmail-next-undeleted-message 1)) |
153 |
(set-buffer file-buffer) |
(setq count 0))))) |
|
(rmail-insert-rmail-file-header) |
|
|
(let ((require-final-newline nil) |
|
|
(coding-system-for-write |
|
|
(or rmail-file-coding-system |
|
|
'emacs-mule-unix))) |
|
|
(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 |
|
|
(set-buffer rmail-buffer) |
|
|
;; Temporarily turn off Deleted attribute. |
|
|
;; Do this outside the save-restriction, since it would |
|
|
;; shift the place in the buffer where the visible text starts. |
|
|
(if (rmail-message-deleted-p rmail-current-message) |
|
|
(progn (setq redelete t) |
|
|
(rmail-set-attribute "deleted" nil))) |
|
|
(save-restriction |
|
|
(widen) |
|
|
;; Decide whether to append to a file or to an Emacs buffer. |
|
|
(save-excursion |
|
|
(let ((buf (find-buffer-visiting file-name)) |
|
|
(cur (current-buffer)) |
|
|
(beg (1+ (rmail-msgbeg rmail-current-message))) |
|
|
(end (1+ (rmail-msgend rmail-current-message))) |
|
|
(coding-system-for-write |
|
|
(or rmail-file-coding-system |
|
|
'emacs-mule-unix))) |
|
|
(if (not buf) |
|
|
;; Output to a file. |
|
|
(if rmail-fields-not-to-output |
|
|
;; Delete some fields while we output. |
|
|
(let ((obuf (current-buffer))) |
|
|
(set-buffer (get-buffer-create " rmail-out-temp")) |
|
|
(insert-buffer-substring obuf beg end) |
|
|
(rmail-delete-unwanted-fields) |
|
|
(append-to-file (point-min) (point-max) file-name) |
|
|
(set-buffer obuf) |
|
|
(kill-buffer (get-buffer " rmail-out-temp"))) |
|
|
(append-to-file beg end file-name)) |
|
|
(if (eq buf (current-buffer)) |
|
|
(error "Can't output message to same file it's already in")) |
|
|
;; File has been visited, in buffer BUF. |
|
|
(set-buffer buf) |
|
|
(let ((buffer-read-only nil) |
|
|
(msg (and (boundp 'rmail-current-message) |
|
|
rmail-current-message))) |
|
|
;; If MSG is non-nil, buffer is in RMAIL mode. |
|
|
(if msg |
|
|
(progn |
|
|
;; 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) |
|
|
(widen) |
|
|
(narrow-to-region (point-max) (point-max)) |
|
|
(insert-buffer-substring cur beg end) |
|
|
(goto-char (point-min)) |
|
|
(widen) |
|
|
(search-backward "\n\^_") |
|
|
(narrow-to-region (point) (point-max)) |
|
|
(rmail-delete-unwanted-fields) |
|
|
(rmail-count-new-messages t) |
|
|
(if (rmail-summary-exists) |
|
|
(rmail-select-summary |
|
|
(rmail-update-summary))) |
|
|
(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-delete-unwanted-fields))))))) |
|
|
(rmail-set-attribute "filed" t)) |
|
|
(if redelete (rmail-set-attribute "deleted" t)))) |
|
|
(setq count (1- count)) |
|
|
(if rmail-delete-after-output |
|
|
(unless |
|
|
(if (and (= count 0) stay) |
|
|
(rmail-delete-message) |
|
|
(rmail-delete-forward)) |
|
|
(setq count 0)) |
|
|
(if (> count 0) |
|
|
(unless |
|
|
(if (not stay) (rmail-next-undeleted-message 1)) |
|
|
(setq count 0))))))) |
|
154 |
|
|
155 |
|
;;; mbox: deprecated |
156 |
;;;###autoload |
;;;###autoload |
157 |
(defcustom rmail-fields-not-to-output nil |
(defcustom rmail-fields-not-to-output nil |
158 |
"*Regexp describing fields to exclude when outputting a message to a file." |
"*Regexp describing fields to exclude when outputting a message to a file." |
160 |
regexp) |
regexp) |
161 |
:group 'rmail-output) |
:group 'rmail-output) |
162 |
|
|
163 |
|
;;; mbox: deprecated |
164 |
;; Delete from the buffer header fields we don't want output. |
;; Delete from the buffer header fields we don't want output. |
165 |
;; NOT-RMAIL if t means this buffer does not have the full header |
;; NOT-RMAIL if t means this buffer does not have the full header |
166 |
;; and *** EOOH *** that a message in an Rmail file has. |
;; and *** EOOH *** that a message in an Rmail file has. |
178 |
(delete-region (point) |
(delete-region (point) |
179 |
(progn (forward-line 1) (point))))))))) |
(progn (forward-line 1) (point))))))))) |
180 |
|
|
181 |
|
;;; mbox: ready |
182 |
;;; There are functions elsewhere in Emacs that use this function; |
;;; There are functions elsewhere in Emacs that use this function; |
183 |
;;; look at them before you change the calling method. |
;;; look at them before you change the calling method. |
184 |
;;;###autoload |
;;;###autoload |
185 |
(defun rmail-output (file-name &optional count noattribute from-gnus) |
(defun rmail-output (file-name &optional count noattribute ext) |
186 |
"Append this message to system-inbox-format mail file named FILE-NAME. |
"Append an mbox formatted message to the mbox formatted file named |
187 |
A prefix argument N says to output N consecutive messages |
FILE-NAME. A prefix argument COUNT says to output COUNT consecutive |
188 |
starting with the current one. Deleted messages are skipped and don't count. |
messages starting with the current one. Deleted messages are skipped |
189 |
When called from lisp code, N may be omitted. |
and don't count. When called from lisp code, COUNT may be omitted. |
|
|
|
|
If the pruned message header is shown on the current message, then |
|
|
messages will be appended with pruned headers; otherwise, messages |
|
|
will be appended with their original headers. |
|
190 |
|
|
191 |
The default file name comes from `rmail-default-file', |
The default file name comes from `rmail-default-file', |
192 |
which is updated to the name you use in this command. |
which is updated to the name you use in this command. |
194 |
The optional third argument NOATTRIBUTE, if non-nil, says not |
The optional third argument NOATTRIBUTE, if non-nil, says not |
195 |
to set the `filed' attribute, and not to display a message. |
to set the `filed' attribute, and not to display a message. |
196 |
|
|
197 |
The optional fourth argument FROM-GNUS is set when called from GNUS." |
The optional fourth argument EXT is set when called from outside of an |
198 |
|
Rmail function, for example by GNUS or Sendmail." |
199 |
(interactive |
(interactive |
200 |
(list (rmail-output-read-file-name) |
(list (rmail-output-read-file-name) |
201 |
(prefix-numeric-value current-prefix-arg))) |
(prefix-numeric-value current-prefix-arg))) |
204 |
(expand-file-name file-name |
(expand-file-name file-name |
205 |
(and rmail-default-file |
(and rmail-default-file |
206 |
(file-name-directory rmail-default-file)))) |
(file-name-directory rmail-default-file)))) |
|
(if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) |
|
|
(rmail-output-to-rmail-file file-name count) |
|
|
(set-buffer rmail-buffer) |
|
|
(let ((orig-count count) |
|
|
(rmailbuf (current-buffer)) |
|
|
(case-fold-search t) |
|
|
(tembuf (get-buffer-create " rmail-output")) |
|
|
(original-headers-p |
|
|
(and (not from-gnus) |
|
|
(save-excursion |
|
|
(save-restriction |
|
|
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
|
|
(goto-char (point-min)) |
|
|
(forward-line 1) |
|
|
(= (following-char) ?0))))) |
|
|
header-beginning |
|
|
mail-from mime-version content-type) |
|
|
(while (> count 0) |
|
|
;; Preserve the Mail-From and MIME-Version fields |
|
|
;; even if they have been pruned. |
|
|
(or from-gnus |
|
|
(save-excursion |
|
|
(save-restriction |
|
|
(widen) |
|
|
(goto-char (rmail-msgbeg rmail-current-message)) |
|
|
(setq header-beginning (point)) |
|
|
(search-forward "\n*** EOOH ***\n") |
|
|
(narrow-to-region header-beginning (point)) |
|
|
(setq mail-from (mail-fetch-field "Mail-From")) |
|
|
(unless rmail-enable-mime |
|
|
(setq mime-version (mail-fetch-field "MIME-Version") |
|
|
content-type (mail-fetch-field "Content-type")))))) |
|
|
(save-excursion |
|
|
(set-buffer tembuf) |
|
|
(erase-buffer) |
|
|
(insert-buffer-substring rmailbuf) |
|
|
(when rmail-enable-mime |
|
|
(if original-headers-p |
|
|
(delete-region (goto-char (point-min)) |
|
|
(if (search-forward "\n*** EOOH ***\n") |
|
|
(match-end 0))) |
|
|
(goto-char (point-min)) |
|
|
(forward-line 2) |
|
|
(delete-region (point-min)(point)) |
|
|
(search-forward "\n*** EOOH ***\n") |
|
|
(delete-region (match-beginning 0) |
|
|
(if (search-forward "\n\n") |
|
|
(1- (match-end 0))))) |
|
|
(setq buffer-file-coding-system (or rmail-file-coding-system |
|
|
'raw-text))) |
|
|
(rmail-delete-unwanted-fields t) |
|
|
(or (bolp) (insert "\n")) |
|
|
(goto-char (point-min)) |
|
|
(if mail-from |
|
|
(insert mail-from "\n") |
|
|
(insert "From " |
|
|
(mail-strip-quoted-names (or (mail-fetch-field "from") |
|
|
(mail-fetch-field "really-from") |
|
|
(mail-fetch-field "sender") |
|
|
"unknown")) |
|
|
" " (current-time-string) "\n")) |
|
|
(if mime-version |
|
|
(insert "MIME-Version: " mime-version |
|
|
"\nContent-type: " content-type "\n")) |
|
|
;; ``Quote'' "\nFrom " as "\n>From " |
|
|
;; (note that this isn't really quoting, as there is no requirement |
|
|
;; that "\n[>]+From " be quoted in the same transparent way.) |
|
|
(let ((case-fold-search nil)) |
|
|
(while (search-forward "\nFrom " nil t) |
|
|
(forward-char -5) |
|
|
(insert ?>))) |
|
|
(write-region (point-min) (point-max) file-name t |
|
|
(if noattribute 'nomsg))) |
|
|
(or noattribute |
|
|
(if (equal major-mode 'rmail-mode) |
|
|
(rmail-set-attribute "filed" t))) |
|
|
(setq count (1- count)) |
|
|
(or from-gnus |
|
|
(let ((next-message-p |
|
|
(if rmail-delete-after-output |
|
|
(rmail-delete-forward) |
|
|
(if (> count 0) |
|
|
(rmail-next-undeleted-message 1)))) |
|
|
(num-appended (- orig-count count))) |
|
|
(if (and next-message-p original-headers-p) |
|
|
(rmail-toggle-header)) |
|
|
(if (and (> count 0) (not next-message-p)) |
|
|
(progn |
|
|
(error |
|
|
(save-excursion |
|
|
(set-buffer rmailbuf) |
|
|
(format "Only %d message%s appended" num-appended |
|
|
(if (= num-appended 1) "" "s")))) |
|
|
(setq count 0)))))) |
|
|
(kill-buffer tembuf)))) |
|
207 |
|
|
208 |
|
;; Use the Rmail buffer, likely narrowed, as the message source |
209 |
|
;; unless being called from an external party, such as GNUS or |
210 |
|
;; Sendmail. |
211 |
|
(unless ext |
212 |
|
(set-buffer rmail-buffer)) |
213 |
|
|
214 |
|
(let ((orig-count count) |
215 |
|
(src-buf (current-buffer)) |
216 |
|
(dst-buf (find-buffer-visiting file-name)) |
217 |
|
(current-message rmail-current-message) |
218 |
|
(tembuf (get-buffer-create " rmail-output")) |
219 |
|
(original-headers-p |
220 |
|
(and (not ext) (not (rmail-msg-is-pruned))))) |
221 |
|
|
222 |
|
;; Output each message to the destination file. |
223 |
|
(while (> count 0) |
224 |
|
(save-excursion |
225 |
|
|
226 |
|
;; Copy the message, including all headers, to the temporary |
227 |
|
;; buffer. |
228 |
|
(set-buffer tembuf) |
229 |
|
(erase-buffer) |
230 |
|
(insert-buffer-substring src-buf) |
231 |
|
|
232 |
|
;; Deal with MIME --- tbd. |
233 |
|
;;(when rmail-enable-mime ... |
234 |
|
|
235 |
|
;; Determine whether a buffer is already visiting the output |
236 |
|
;; file. |
237 |
|
(if dst-buf |
238 |
|
|
239 |
|
;; The destination file is being visited. Update it. |
240 |
|
(progn |
241 |
|
(set-buffer dst-buf) |
242 |
|
|
243 |
|
;; Determine if the destination file is an Rmail file. |
244 |
|
(let ((buffer-read-only nil) |
245 |
|
(dst-current-message (and (boundp 'rmail-current-message) |
246 |
|
rmail-current-message))) |
247 |
|
(if dst-current-message |
248 |
|
|
249 |
|
;; The buffer is an Rmail buffer. Append the message. |
250 |
|
(progn |
251 |
|
(widen) |
252 |
|
(narrow-to-region (point-max) (point-max)) |
253 |
|
(insert-buffer-substring src-buf) |
254 |
|
(insert "\n") |
255 |
|
(rmail-process-new-messages) |
256 |
|
(rmail-show-message dst-current-message)) |
257 |
|
|
258 |
|
;; The destination file is not an Rmail file, just |
259 |
|
;; insert at the end. |
260 |
|
(goto-char (point-max)) |
261 |
|
(insert-buffer-substring src-buf)))) |
262 |
|
|
263 |
|
;; The destination file is not being visited, just write out |
264 |
|
;; the processed message. |
265 |
|
(write-region (point-min) (point-max) file-name t |
266 |
|
(if noattribute 'nomsg)))) |
267 |
|
|
268 |
|
;; Do housekeeping, such as setting the "Filed" attribute, if |
269 |
|
;; necessary and moving to the next message. |
270 |
|
(or noattribute |
271 |
|
(if (equal major-mode 'rmail-mode) |
272 |
|
(progn |
273 |
|
(rmail-set-attribute "filed" t current-message) |
274 |
|
(setq current-message (1+ current-message))))) |
275 |
|
|
276 |
|
;; Determine if Rmail post output operations need to be handled. |
277 |
|
(or ext |
278 |
|
|
279 |
|
;; They do. Move to the next non-deleted message. |
280 |
|
(let ((next-message-p |
281 |
|
(if rmail-delete-after-output |
282 |
|
(rmail-delete-forward) |
283 |
|
(if (> count 1) |
284 |
|
(rmail-next-undeleted-message 1)))) |
285 |
|
(num-appended (- orig-count count))) |
286 |
|
(if (and (> count 1) (not next-message-p)) |
287 |
|
(progn |
288 |
|
(error |
289 |
|
(save-excursion |
290 |
|
(set-buffer src-buf) |
291 |
|
(format "Only %d message%s appended" num-appended |
292 |
|
(if (= num-appended 1) "" "s")))) |
293 |
|
(setq count 0))))) |
294 |
|
|
295 |
|
;; Decrement the count for the next iteration. If an error has |
296 |
|
;; occurred, then count will be -1, which is every bit as good |
297 |
|
;; as 0. |
298 |
|
(setq count (1- count))) |
299 |
|
(kill-buffer tembuf))) |
300 |
|
|
301 |
|
;;; mbox: ready |
302 |
;;;###autoload |
;;;###autoload |
303 |
(defun rmail-output-body-to-file (file-name) |
(defun rmail-output-body-to-file (file-name) |
304 |
"Write this message body to the file FILE-NAME. |
"Write this message body to the file FILE-NAME. |
325 |
(error "Operation aborted")) |
(error "Operation aborted")) |
326 |
(write-region (point) (point-max) file-name) |
(write-region (point) (point-max) file-name) |
327 |
(if (equal major-mode 'rmail-mode) |
(if (equal major-mode 'rmail-mode) |
328 |
(rmail-set-attribute "stored" t))) |
(rmail-desc-set-attribute rmail-desc-stored-index t rmail-current-message))) |
329 |
(if rmail-delete-after-output |
(if rmail-delete-after-output |
330 |
(rmail-delete-forward))) |
(rmail-delete-forward))) |
331 |
|
|