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