Commit | Line | Data |
---|---|---|
8f88558f | 1 | ;; "RMAIL" mail reader for Emacs: output message to a file. |
2 | ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. | |
3 | ||
4 | ;; This file is part of GNU Emacs. | |
5 | ||
6 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 | ;; it under the terms of the GNU General Public License as published by | |
8 | ;; the Free Software Foundation; either version 1, or (at your option) | |
9 | ;; any later version. | |
10 | ||
11 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;; GNU General Public License for more details. | |
15 | ||
16 | ;; You should have received a copy of the GNU General Public License | |
17 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | ||
20 | ||
21 | ;; Temporary until Emacs always has this variable. | |
22 | (defvar rmail-delete-after-output nil | |
23 | "*Non-nil means automatically delete a message that is copied to a file.") | |
24 | ||
0f91ee7e RS |
25 | (defvar rmail-output-file-alist nil |
26 | "*Alist matching regexps to suggested output Rmail files. | |
27 | This is a list of elements of the form (REGEXP . FILENAME).") | |
28 | ||
8f88558f | 29 | (defun rmail-output-to-rmail-file (count file-name) |
30 | "Append the current message to an Rmail file named FILE-NAME. | |
31 | If the file does not exist, ask if it should be created. | |
32 | If file is being visited, the message is appended to the Emacs | |
33 | buffer visiting that file. | |
34 | A prefix argument N says to output N consecutive messages | |
35 | starting with the current one. Deleted messages are skipped and don't count." | |
36 | (interactive (list (prefix-numeric-value current-prefix-arg) | |
37 | (read-file-name | |
38 | (concat "Output message to Rmail file: (default " | |
39 | (file-name-nondirectory rmail-last-rmail-file) | |
40 | ") ") | |
41 | (file-name-directory rmail-last-rmail-file) | |
0f91ee7e RS |
42 | (let (answer tail) |
43 | (setq tail rmail-output-file-alist) | |
44 | ;; Suggest a file based on a pattern match. | |
45 | (while (and tail (not answer)) | |
46 | (save-excursion | |
47 | (goto-char (point-min)) | |
48 | (if (re-search-forward (car (car tail)) nil t) | |
49 | (setq answer (cdr (car tail)))) | |
50 | (setq tail (cdr tail)))) | |
51 | ;; If not suggestions, use same file as last time. | |
52 | (or answer rmail-last-rmail-file))))) | |
3bfd7edb JB |
53 | (setq file-name |
54 | (expand-file-name file-name | |
55 | (file-name-directory rmail-last-rmail-file))) | |
8f88558f | 56 | (setq rmail-last-rmail-file file-name) |
57 | (rmail-maybe-set-message-counters) | |
58 | (or (get-file-buffer file-name) | |
59 | (file-exists-p file-name) | |
60 | (if (yes-or-no-p | |
61 | (concat "\"" file-name "\" does not exist, create it? ")) | |
62 | (let ((file-buffer (create-file-buffer file-name))) | |
63 | (save-excursion | |
64 | (set-buffer file-buffer) | |
65 | (rmail-insert-rmail-file-header) | |
66 | (let ((require-final-newline nil)) | |
67 | (write-region (point-min) (point-max) file-name t 1))) | |
68 | (kill-buffer file-buffer)) | |
69 | (error "Output file does not exist"))) | |
70 | (while (> count 0) | |
71 | (let (redelete) | |
72 | (unwind-protect | |
73 | (progn | |
74 | (save-restriction | |
75 | (widen) | |
76 | (if (rmail-message-deleted-p rmail-current-message) | |
77 | (progn (setq redelete t) | |
78 | (rmail-set-attribute "deleted" nil))) | |
79 | ;; Decide whether to append to a file or to an Emacs buffer. | |
80 | (save-excursion | |
81 | (let ((buf (get-file-buffer file-name)) | |
82 | (cur (current-buffer)) | |
83 | (beg (1+ (rmail-msgbeg rmail-current-message))) | |
84 | (end (1+ (rmail-msgend rmail-current-message)))) | |
85 | (if (not buf) | |
86 | (append-to-file beg end file-name) | |
87 | (if (eq buf (current-buffer)) | |
88 | (error "Can't output message to same file it's already in")) | |
89 | ;; File has been visited, in buffer BUF. | |
90 | (set-buffer buf) | |
91 | (let ((buffer-read-only nil) | |
92 | (msg (and (boundp 'rmail-current-message) | |
93 | rmail-current-message))) | |
94 | ;; If MSG is non-nil, buffer is in RMAIL mode. | |
95 | (if msg | |
96 | (progn | |
97 | (rmail-maybe-set-message-counters) | |
98 | (widen) | |
99 | (narrow-to-region (point-max) (point-max)) | |
100 | (insert-buffer-substring cur beg end) | |
101 | (goto-char (point-min)) | |
102 | (widen) | |
103 | (search-backward "\n\^_") | |
104 | (narrow-to-region (point) (point-max)) | |
105 | (rmail-count-new-messages t) | |
106 | (rmail-show-message msg)) | |
107 | ;; Output file not in rmail mode => just insert at the end. | |
108 | (narrow-to-region (point-min) (1+ (buffer-size))) | |
109 | (goto-char (point-max)) | |
110 | (insert-buffer-substring cur beg end))))))) | |
111 | (rmail-set-attribute "filed" t)) | |
112 | (if redelete (rmail-set-attribute "deleted" t)))) | |
113 | (setq count (1- count)) | |
114 | (if rmail-delete-after-output | |
115 | (rmail-delete-forward) | |
116 | (if (> count 0) | |
117 | (rmail-next-undeleted-message 1))))) | |
118 | ||
119 | (defun rmail-output (count file-name) | |
120 | "Append this message to Unix mail file named FILE-NAME. | |
121 | A prefix argument N says to output N consecutive messages | |
122 | starting with the current one. Deleted messages are skipped and don't count." | |
123 | (interactive | |
124 | (list (prefix-numeric-value current-prefix-arg) | |
125 | (read-file-name | |
126 | (concat "Output message to Unix mail file" | |
127 | (if rmail-last-file | |
128 | (concat " (default " | |
129 | (file-name-nondirectory rmail-last-file) | |
130 | "): " ) | |
131 | ": ")) | |
132 | (and rmail-last-file (file-name-directory rmail-last-file)) | |
133 | rmail-last-file))) | |
3bfd7edb JB |
134 | (setq file-name |
135 | (expand-file-name file-name | |
136 | (and rmail-last-file | |
137 | (file-name-directory rmail-last-file)))) | |
8f88558f | 138 | (setq rmail-last-file file-name) |
139 | (while (> count 0) | |
140 | (let ((rmailbuf (current-buffer)) | |
141 | (tembuf (get-buffer-create " rmail-output")) | |
142 | (case-fold-search t)) | |
143 | (save-excursion | |
144 | (set-buffer tembuf) | |
145 | (erase-buffer) | |
146 | ;; If we can do it, read a little of the file | |
147 | ;; to check whether it is an RMAIL file. | |
148 | ;; If it is, don't mess it up. | |
149 | (if (fboundp 'insert-partial-file-contents) | |
150 | (progn | |
151 | (insert-partial-file-contents file-name 0 20) | |
152 | (if (looking-at "BABYL OPTIONS:\n") | |
153 | (error (save-excursion | |
154 | (set-buffer rmailbuf) | |
155 | (substitute-command-keys | |
156 | "File %s is an RMAIL file; use the \\[rmail-output-to-rmail-file] command")) | |
157 | file-name)) | |
158 | (erase-buffer))) | |
159 | (insert-buffer-substring rmailbuf) | |
160 | (insert "\n") | |
161 | (goto-char (point-min)) | |
162 | (insert "From " | |
163 | (mail-strip-quoted-names (or (mail-fetch-field "from") | |
164 | (mail-fetch-field "really-from") | |
165 | (mail-fetch-field "sender") | |
166 | "unknown")) | |
167 | " " (current-time-string) "\n") | |
168 | ;; ``Quote'' "\nFrom " as "\n>From " | |
169 | ;; (note that this isn't really quoting, as there is no requirement | |
170 | ;; that "\n[>]+From " be quoted in the same transparent way.) | |
171 | (while (search-forward "\nFrom " nil t) | |
172 | (forward-char -5) | |
173 | (insert ?>)) | |
174 | (append-to-file (point-min) (point-max) file-name)) | |
175 | (kill-buffer tembuf)) | |
176 | (if (equal major-mode 'rmail-mode) | |
177 | (rmail-set-attribute "filed" t)) | |
178 | (setq count (1- count)) | |
179 | (if rmail-delete-after-output | |
180 | (rmail-delete-forward) | |
181 | (if (> count 0) | |
182 | (rmail-next-undeleted-message 1))))) |