Mercurial > emacs
annotate lisp/mail/rmailout.el @ 3281:49c371d2b020
(command-line-1): Pass arg to other-window.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 29 May 1993 22:34:54 +0000 |
parents | 67f34b0bc2d1 |
children | 7503a402c721 |
rev | line source |
---|---|
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
202
diff
changeset
|
1 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
202
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. |
4 | |
788
c8d4eb38ebfc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
713
diff
changeset
|
5 ;; Maintainer: FSF |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: mail |
788
c8d4eb38ebfc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
713
diff
changeset
|
7 |
63 | 8 ;; This file is part of GNU Emacs. |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
788
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
63 | 13 ;; any later version. |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
788
c8d4eb38ebfc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
713
diff
changeset
|
24 ;;; Code: |
63 | 25 |
26 ;; Temporary until Emacs always has this variable. | |
27 (defvar rmail-delete-after-output nil | |
28 "*Non-nil means automatically delete a message that is copied to a file.") | |
29 | |
145 | 30 (defvar rmail-output-file-alist nil |
31 "*Alist matching regexps to suggested output Rmail files. | |
32 This is a list of elements of the form (REGEXP . FILENAME).") | |
33 | |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
34 ;;; There are functions elsewhere in Emacs that use this function; check |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
35 ;;; them out before you change the calling method. |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
36 (defun rmail-output-to-rmail-file (file-name &optional count) |
63 | 37 "Append the current message to an Rmail file named FILE-NAME. |
38 If the file does not exist, ask if it should be created. | |
39 If file is being visited, the message is appended to the Emacs | |
40 buffer visiting that file. | |
41 A prefix argument N says to output N consecutive messages | |
42 starting with the current one. Deleted messages are skipped and don't count." | |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
43 (interactive (list (read-file-name |
63 | 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) | |
145 | 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. | |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
58 (or answer rmail-last-rmail-file))) |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
59 (prefix-numeric-value current-prefix-arg))) |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
60 (or count (setq count 1)) |
202 | 61 (setq file-name |
62 (expand-file-name file-name | |
63 (file-name-directory rmail-last-rmail-file))) | |
63 | 64 (setq rmail-last-rmail-file file-name) |
65 (rmail-maybe-set-message-counters) | |
1460
e60eef93a18f
(rmail-output-to-rmail-file): Call abbreviate-file-name.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
66 (setq file-name (abbreviate-file-name file-name)) |
63 | 67 (or (get-file-buffer file-name) |
68 (file-exists-p file-name) | |
69 (if (yes-or-no-p | |
70 (concat "\"" file-name "\" does not exist, create it? ")) | |
71 (let ((file-buffer (create-file-buffer file-name))) | |
72 (save-excursion | |
73 (set-buffer file-buffer) | |
74 (rmail-insert-rmail-file-header) | |
75 (let ((require-final-newline nil)) | |
76 (write-region (point-min) (point-max) file-name t 1))) | |
77 (kill-buffer file-buffer)) | |
78 (error "Output file does not exist"))) | |
79 (while (> count 0) | |
80 (let (redelete) | |
81 (unwind-protect | |
82 (progn | |
83 (save-restriction | |
84 (widen) | |
85 (if (rmail-message-deleted-p rmail-current-message) | |
86 (progn (setq redelete t) | |
87 (rmail-set-attribute "deleted" nil))) | |
88 ;; Decide whether to append to a file or to an Emacs buffer. | |
89 (save-excursion | |
90 (let ((buf (get-file-buffer file-name)) | |
91 (cur (current-buffer)) | |
92 (beg (1+ (rmail-msgbeg rmail-current-message))) | |
93 (end (1+ (rmail-msgend rmail-current-message)))) | |
94 (if (not buf) | |
95 (append-to-file beg end file-name) | |
96 (if (eq buf (current-buffer)) | |
97 (error "Can't output message to same file it's already in")) | |
98 ;; File has been visited, in buffer BUF. | |
99 (set-buffer buf) | |
100 (let ((buffer-read-only nil) | |
101 (msg (and (boundp 'rmail-current-message) | |
102 rmail-current-message))) | |
103 ;; If MSG is non-nil, buffer is in RMAIL mode. | |
104 (if msg | |
105 (progn | |
106 (rmail-maybe-set-message-counters) | |
107 (widen) | |
108 (narrow-to-region (point-max) (point-max)) | |
109 (insert-buffer-substring cur beg end) | |
110 (goto-char (point-min)) | |
111 (widen) | |
112 (search-backward "\n\^_") | |
113 (narrow-to-region (point) (point-max)) | |
114 (rmail-count-new-messages t) | |
115 (rmail-show-message msg)) | |
116 ;; Output file not in rmail mode => just insert at the end. | |
117 (narrow-to-region (point-min) (1+ (buffer-size))) | |
118 (goto-char (point-max)) | |
119 (insert-buffer-substring cur beg end))))))) | |
120 (rmail-set-attribute "filed" t)) | |
121 (if redelete (rmail-set-attribute "deleted" t)))) | |
122 (setq count (1- count)) | |
123 (if rmail-delete-after-output | |
124 (rmail-delete-forward) | |
125 (if (> count 0) | |
126 (rmail-next-undeleted-message 1))))) | |
127 | |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
128 ;;; There are functions elsewhere in Emacs that use this function; check |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
129 ;;; them out before you change the calling method. |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
130 (defun rmail-output (file-name &optional count) |
63 | 131 "Append this message to Unix mail file named FILE-NAME. |
132 A prefix argument N says to output N consecutive messages | |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
133 starting with the current one. Deleted messages are skipped and don't count. |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
134 When called from lisp code, N may be omitted." |
63 | 135 (interactive |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
136 (list (read-file-name |
63 | 137 (concat "Output message to Unix mail file" |
138 (if rmail-last-file | |
139 (concat " (default " | |
140 (file-name-nondirectory rmail-last-file) | |
141 "): " ) | |
142 ": ")) | |
143 (and rmail-last-file (file-name-directory rmail-last-file)) | |
1866
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
144 rmail-last-file) |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
145 (prefix-numeric-value current-prefix-arg))) |
a712cff3b6e7
* rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse
Jim Blandy <jimb@redhat.com>
parents:
1460
diff
changeset
|
146 (or count (setq count 1)) |
202 | 147 (setq file-name |
148 (expand-file-name file-name | |
149 (and rmail-last-file | |
150 (file-name-directory rmail-last-file)))) | |
63 | 151 (setq rmail-last-file file-name) |
152 (while (> count 0) | |
153 (let ((rmailbuf (current-buffer)) | |
154 (tembuf (get-buffer-create " rmail-output")) | |
155 (case-fold-search t)) | |
156 (save-excursion | |
157 (set-buffer tembuf) | |
158 (erase-buffer) | |
159 ;; If we can do it, read a little of the file | |
160 ;; to check whether it is an RMAIL file. | |
161 ;; If it is, don't mess it up. | |
162 (if (fboundp 'insert-partial-file-contents) | |
163 (progn | |
164 (insert-partial-file-contents file-name 0 20) | |
165 (if (looking-at "BABYL OPTIONS:\n") | |
166 (error (save-excursion | |
167 (set-buffer rmailbuf) | |
168 (substitute-command-keys | |
169 "File %s is an RMAIL file; use the \\[rmail-output-to-rmail-file] command")) | |
170 file-name)) | |
171 (erase-buffer))) | |
172 (insert-buffer-substring rmailbuf) | |
173 (insert "\n") | |
174 (goto-char (point-min)) | |
175 (insert "From " | |
176 (mail-strip-quoted-names (or (mail-fetch-field "from") | |
177 (mail-fetch-field "really-from") | |
178 (mail-fetch-field "sender") | |
179 "unknown")) | |
2717
67f34b0bc2d1
(rmail-output): Undo June 11 1992 change:
Richard M. Stallman <rms@gnu.org>
parents:
1866
diff
changeset
|
180 " " (current-time-string) "\n") |
63 | 181 ;; ``Quote'' "\nFrom " as "\n>From " |
182 ;; (note that this isn't really quoting, as there is no requirement | |
183 ;; that "\n[>]+From " be quoted in the same transparent way.) | |
184 (while (search-forward "\nFrom " nil t) | |
185 (forward-char -5) | |
186 (insert ?>)) | |
187 (append-to-file (point-min) (point-max) file-name)) | |
188 (kill-buffer tembuf)) | |
189 (if (equal major-mode 'rmail-mode) | |
190 (rmail-set-attribute "filed" t)) | |
191 (setq count (1- count)) | |
192 (if rmail-delete-after-output | |
193 (rmail-delete-forward) | |
194 (if (> count 0) | |
195 (rmail-next-undeleted-message 1))))) | |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
202
diff
changeset
|
196 |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
202
diff
changeset
|
197 ;;; rmailout.el ends here |