Mercurial > emacs
comparison lisp/mail/rmailout.el @ 63:714e88ef93c8
Initial revision
author | root <root> |
---|---|
date | Tue, 22 May 1990 23:49:44 +0000 |
parents | |
children | 1a0f15a66c06 |
comparison
equal
deleted
inserted
replaced
62:b469d69e9f03 | 63:714e88ef93c8 |
---|---|
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 | |
25 (defun rmail-output-to-rmail-file (count file-name) | |
26 "Append the current message to an Rmail file named FILE-NAME. | |
27 If the file does not exist, ask if it should be created. | |
28 If file is being visited, the message is appended to the Emacs | |
29 buffer visiting that file. | |
30 A prefix argument N says to output N consecutive messages | |
31 starting with the current one. Deleted messages are skipped and don't count." | |
32 (interactive (list (prefix-numeric-value current-prefix-arg) | |
33 (read-file-name | |
34 (concat "Output message to Rmail file: (default " | |
35 (file-name-nondirectory rmail-last-rmail-file) | |
36 ") ") | |
37 (file-name-directory rmail-last-rmail-file) | |
38 rmail-last-rmail-file))) | |
39 (setq file-name (expand-file-name file-name)) | |
40 (setq rmail-last-rmail-file file-name) | |
41 (rmail-maybe-set-message-counters) | |
42 (or (get-file-buffer file-name) | |
43 (file-exists-p file-name) | |
44 (if (yes-or-no-p | |
45 (concat "\"" file-name "\" does not exist, create it? ")) | |
46 (let ((file-buffer (create-file-buffer file-name))) | |
47 (save-excursion | |
48 (set-buffer file-buffer) | |
49 (rmail-insert-rmail-file-header) | |
50 (let ((require-final-newline nil)) | |
51 (write-region (point-min) (point-max) file-name t 1))) | |
52 (kill-buffer file-buffer)) | |
53 (error "Output file does not exist"))) | |
54 (while (> count 0) | |
55 (let (redelete) | |
56 (unwind-protect | |
57 (progn | |
58 (save-restriction | |
59 (widen) | |
60 (if (rmail-message-deleted-p rmail-current-message) | |
61 (progn (setq redelete t) | |
62 (rmail-set-attribute "deleted" nil))) | |
63 ;; Decide whether to append to a file or to an Emacs buffer. | |
64 (save-excursion | |
65 (let ((buf (get-file-buffer file-name)) | |
66 (cur (current-buffer)) | |
67 (beg (1+ (rmail-msgbeg rmail-current-message))) | |
68 (end (1+ (rmail-msgend rmail-current-message)))) | |
69 (if (not buf) | |
70 (append-to-file beg end file-name) | |
71 (if (eq buf (current-buffer)) | |
72 (error "Can't output message to same file it's already in")) | |
73 ;; File has been visited, in buffer BUF. | |
74 (set-buffer buf) | |
75 (let ((buffer-read-only nil) | |
76 (msg (and (boundp 'rmail-current-message) | |
77 rmail-current-message))) | |
78 ;; If MSG is non-nil, buffer is in RMAIL mode. | |
79 (if msg | |
80 (progn | |
81 (rmail-maybe-set-message-counters) | |
82 (widen) | |
83 (narrow-to-region (point-max) (point-max)) | |
84 (insert-buffer-substring cur beg end) | |
85 (goto-char (point-min)) | |
86 (widen) | |
87 (search-backward "\n\^_") | |
88 (narrow-to-region (point) (point-max)) | |
89 (rmail-count-new-messages t) | |
90 (rmail-show-message msg)) | |
91 ;; Output file not in rmail mode => just insert at the end. | |
92 (narrow-to-region (point-min) (1+ (buffer-size))) | |
93 (goto-char (point-max)) | |
94 (insert-buffer-substring cur beg end))))))) | |
95 (rmail-set-attribute "filed" t)) | |
96 (if redelete (rmail-set-attribute "deleted" t)))) | |
97 (setq count (1- count)) | |
98 (if rmail-delete-after-output | |
99 (rmail-delete-forward) | |
100 (if (> count 0) | |
101 (rmail-next-undeleted-message 1))))) | |
102 | |
103 (defun rmail-output (count file-name) | |
104 "Append this message to Unix mail file named FILE-NAME. | |
105 A prefix argument N says to output N consecutive messages | |
106 starting with the current one. Deleted messages are skipped and don't count." | |
107 (interactive | |
108 (list (prefix-numeric-value current-prefix-arg) | |
109 (read-file-name | |
110 (concat "Output message to Unix mail file" | |
111 (if rmail-last-file | |
112 (concat " (default " | |
113 (file-name-nondirectory rmail-last-file) | |
114 "): " ) | |
115 ": ")) | |
116 (and rmail-last-file (file-name-directory rmail-last-file)) | |
117 rmail-last-file))) | |
118 (setq file-name (expand-file-name file-name)) | |
119 (setq rmail-last-file file-name) | |
120 (while (> count 0) | |
121 (let ((rmailbuf (current-buffer)) | |
122 (tembuf (get-buffer-create " rmail-output")) | |
123 (case-fold-search t)) | |
124 (save-excursion | |
125 (set-buffer tembuf) | |
126 (erase-buffer) | |
127 ;; If we can do it, read a little of the file | |
128 ;; to check whether it is an RMAIL file. | |
129 ;; If it is, don't mess it up. | |
130 (if (fboundp 'insert-partial-file-contents) | |
131 (progn | |
132 (insert-partial-file-contents file-name 0 20) | |
133 (if (looking-at "BABYL OPTIONS:\n") | |
134 (error (save-excursion | |
135 (set-buffer rmailbuf) | |
136 (substitute-command-keys | |
137 "File %s is an RMAIL file; use the \\[rmail-output-to-rmail-file] command")) | |
138 file-name)) | |
139 (erase-buffer))) | |
140 (insert-buffer-substring rmailbuf) | |
141 (insert "\n") | |
142 (goto-char (point-min)) | |
143 (insert "From " | |
144 (mail-strip-quoted-names (or (mail-fetch-field "from") | |
145 (mail-fetch-field "really-from") | |
146 (mail-fetch-field "sender") | |
147 "unknown")) | |
148 " " (current-time-string) "\n") | |
149 ;; ``Quote'' "\nFrom " as "\n>From " | |
150 ;; (note that this isn't really quoting, as there is no requirement | |
151 ;; that "\n[>]+From " be quoted in the same transparent way.) | |
152 (while (search-forward "\nFrom " nil t) | |
153 (forward-char -5) | |
154 (insert ?>)) | |
155 (append-to-file (point-min) (point-max) file-name)) | |
156 (kill-buffer tembuf)) | |
157 (if (equal major-mode 'rmail-mode) | |
158 (rmail-set-attribute "filed" t)) | |
159 (setq count (1- count)) | |
160 (if rmail-delete-after-output | |
161 (rmail-delete-forward) | |
162 (if (> count 0) | |
163 (rmail-next-undeleted-message 1))))) |