Mercurial > emacs

comparison lisp/mail/rmailout.el @ 4056:419e92a78e6f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(rmail-output): If file is an Rmail file, use rmail-output-to-rmail-file. (rmail-output-to-rmail-file): If file exists and is not an Rmail file, use rmail-output. If we find an element in rmail-output-file-alist, eval it. (rmail-file-p): New function. (rmail-output-file-alist): Now contains expressions to eval.
author Richard M. Stallman <rms@gnu.org>
date Fri, 09 Jul 1993 20:46:42 +0000
parents ea6739f778a5
children af785cbe489a
comparison
equal deleted inserted replaced
4055:e5d455b14d82 4056:419e92a78e6f
1 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. 1 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
2 2
3 ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc.
4 4
5 ;; Maintainer: FSF 5 ;; Maintainer: FSF
6 ;; Keywords: mail 6 ;; Keywords: mail
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
27 (defvar rmail-delete-after-output nil 27 (defvar rmail-delete-after-output nil
28 "*Non-nil means automatically delete a message that is copied to a file.") 28 "*Non-nil means automatically delete a message that is copied to a file.")
29 29
30 (defvar rmail-output-file-alist nil 30 (defvar rmail-output-file-alist nil
31 "*Alist matching regexps to suggested output Rmail files. 31 "*Alist matching regexps to suggested output Rmail files.
32 This is a list of elements of the form (REGEXP . FILENAME).") 32 This is a list of elements of the form (REGEXP . NAME-EXP).
33 NAME-EXP may be a string constant giving the file name to use,
34 or more generally it may be any kind of expression that returns
35 a file name as a string.")
33 36
34 ;;; There are functions elsewhere in Emacs that use this function; check 37 ;;; There are functions elsewhere in Emacs that use this function; check
35 ;;; them out before you change the calling method. 38 ;;; them out before you change the calling method.
36 (defun rmail-output-to-rmail-file (file-name &optional count) 39 (defun rmail-output-to-rmail-file (file-name &optional count)
37 "Append the current message to an Rmail file named FILE-NAME. 40 "Append the current message to an Rmail file named FILE-NAME.
38 If the file does not exist, ask if it should be created. 41 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 42 If file is being visited, the message is appended to the Emacs
40 buffer visiting that file. 43 buffer visiting that file.
44 If the file exists and is not an Rmail file,
45 the message is appended in inbox format.
46
41 A prefix argument N says to output N consecutive messages 47 A prefix argument N says to output N consecutive messages
42 starting with the current one. Deleted messages are skipped and don't count." 48 starting with the current one. Deleted messages are skipped and don't count."
43 (interactive 49 (interactive
44 (let ((default-file 50 (let ((default-file
45 (let (answer tail) 51 (let (answer tail)
47 ;; Suggest a file based on a pattern match. 53 ;; Suggest a file based on a pattern match.
48 (while (and tail (not answer)) 54 (while (and tail (not answer))
49 (save-excursion 55 (save-excursion
50 (goto-char (point-min)) 56 (goto-char (point-min))
51 (if (re-search-forward (car (car tail)) nil t) 57 (if (re-search-forward (car (car tail)) nil t)
52 (setq answer (cdr (car tail)))) 58 (setq answer (eval (cdr (car tail)))))
53 (setq tail (cdr tail)))) 59 (setq tail (cdr tail))))
54 ;; If not suggestions, use same file as last time. 60 ;; If not suggestions, use same file as last time.
55 (or answer rmail-last-rmail-file)))) 61 (or answer rmail-last-rmail-file))))
56 (list (read-file-name 62 (list (read-file-name
57 (concat "Output message to Rmail file: (default " 63 (concat "Output message to Rmail file: (default "
62 (prefix-numeric-value current-prefix-arg)))) 68 (prefix-numeric-value current-prefix-arg))))
63 (or count (setq count 1)) 69 (or count (setq count 1))
64 (setq file-name 70 (setq file-name
65 (expand-file-name file-name 71 (expand-file-name file-name
66 (file-name-directory rmail-last-rmail-file))) 72 (file-name-directory rmail-last-rmail-file)))
67 (setq rmail-last-rmail-file file-name) 73 (if (and (file-readable-p file-name) (not (rmail-file-p file-name)))
68 (rmail-maybe-set-message-counters) 74 (rmail-output file-name count)
69 (setq file-name (abbreviate-file-name file-name)) 75 (setq rmail-last-rmail-file file-name)
70 (or (get-file-buffer file-name) 76 (rmail-maybe-set-message-counters)
71 (file-exists-p file-name) 77 (setq file-name (abbreviate-file-name file-name))
72 (if (yes-or-no-p 78 (or (get-file-buffer file-name)
73 (concat "\"" file-name "\" does not exist, create it? ")) 79 (file-exists-p file-name)
74 (let ((file-buffer (create-file-buffer file-name))) 80 (if (yes-or-no-p
75 (save-excursion 81 (concat "\"" file-name "\" does not exist, create it? "))
76 (set-buffer file-buffer) 82 (let ((file-buffer (create-file-buffer file-name)))
77 (rmail-insert-rmail-file-header)
78 (let ((require-final-newline nil))
79 (write-region (point-min) (point-max) file-name t 1)))
80 (kill-buffer file-buffer))
81 (error "Output file does not exist")))
82 (while (> count 0)
83 (let (redelete)
84 (unwind-protect
85 (progn
86 (save-restriction
87 (widen)
88 (if (rmail-message-deleted-p rmail-current-message)
89 (progn (setq redelete t)
90 (rmail-set-attribute "deleted" nil)))
91 ;; Decide whether to append to a file or to an Emacs buffer.
92 (save-excursion 83 (save-excursion
93 (let ((buf (get-file-buffer file-name)) 84 (set-buffer file-buffer)
94 (cur (current-buffer)) 85 (rmail-insert-rmail-file-header)
95 (beg (1+ (rmail-msgbeg rmail-current-message))) 86 (let ((require-final-newline nil))
96 (end (1+ (rmail-msgend rmail-current-message)))) 87 (write-region (point-min) (point-max) file-name t 1)))
97 (if (not buf) 88 (kill-buffer file-buffer))
98 (append-to-file beg end file-name) 89 (error "Output file does not exist")))
99 (if (eq buf (current-buffer)) 90 (while (> count 0)
100 (error "Can't output message to same file it's already in")) 91 (let (redelete)
101 ;; File has been visited, in buffer BUF. 92 (unwind-protect
102 (set-buffer buf) 93 (progn
103 (let ((buffer-read-only nil) 94 (save-restriction
104 (msg (and (boundp 'rmail-current-message) 95 (widen)
105 rmail-current-message))) 96 (if (rmail-message-deleted-p rmail-current-message)
106 ;; If MSG is non-nil, buffer is in RMAIL mode. 97 (progn (setq redelete t)
107 (if msg 98 (rmail-set-attribute "deleted" nil)))
108 (progn 99 ;; Decide whether to append to a file or to an Emacs buffer.
109 (rmail-maybe-set-message-counters) 100 (save-excursion
110 (widen) 101 (let ((buf (get-file-buffer file-name))
111 (narrow-to-region (point-max) (point-max)) 102 (cur (current-buffer))
112 (insert-buffer-substring cur beg end) 103 (beg (1+ (rmail-msgbeg rmail-current-message)))
113 (goto-char (point-min)) 104 (end (1+ (rmail-msgend rmail-current-message))))
114 (widen) 105 (if (not buf)
115 (search-backward "\n\^_") 106 (append-to-file beg end file-name)
116 (narrow-to-region (point) (point-max)) 107 (if (eq buf (current-buffer))
117 (rmail-count-new-messages t) 108 (error "Can't output message to same file it's already in"))
118 (rmail-show-message msg)) 109 ;; File has been visited, in buffer BUF.
119 ;; Output file not in rmail mode => just insert at the end. 110 (set-buffer buf)
120 (narrow-to-region (point-min) (1+ (buffer-size))) 111 (let ((buffer-read-only nil)
121 (goto-char (point-max)) 112 (msg (and (boundp 'rmail-current-message)
122 (insert-buffer-substring cur beg end))))))) 113 rmail-current-message)))
123 (rmail-set-attribute "filed" t)) 114 ;; If MSG is non-nil, buffer is in RMAIL mode.
124 (if redelete (rmail-set-attribute "deleted" t)))) 115 (if msg
125 (setq count (1- count)) 116 (progn
126 (if rmail-delete-after-output 117 (rmail-maybe-set-message-counters)
127 (rmail-delete-forward) 118 (widen)
128 (if (> count 0) 119 (narrow-to-region (point-max) (point-max))
129 (rmail-next-undeleted-message 1))))) 120 (insert-buffer-substring cur beg end)
121 (goto-char (point-min))
122 (widen)
123 (search-backward "\n\^_")
124 (narrow-to-region (point) (point-max))
125 (rmail-count-new-messages t)
126 (rmail-show-message msg))
127 ;; Output file not in rmail mode => just insert at the end.
128 (narrow-to-region (point-min) (1+ (buffer-size)))
129 (goto-char (point-max))
130 (insert-buffer-substring cur beg end)))))))
131 (rmail-set-attribute "filed" t))
132 (if redelete (rmail-set-attribute "deleted" t))))
133 (setq count (1- count))
134 (if rmail-delete-after-output
135 (rmail-delete-forward)
136 (if (> count 0)
137 (rmail-next-undeleted-message 1))))))
138
139 ;; Returns t if file FILE is an Rmail file.
140 (defun rmail-file-p (file)
141 (let ((buf (generate-new-buffer " *rmail-file-p*")))
142 (unwind-protect
143 (save-excursion
144 (set-buffer buf)
145 (insert-file-contents file nil 0 100)
146 (looking-at "BABYL OPTIONS:"))
147 (kill-buffer buf))))
130 148
131 ;;; There are functions elsewhere in Emacs that use this function; check 149 ;;; There are functions elsewhere in Emacs that use this function; check
132 ;;; them out before you change the calling method. 150 ;;; them out before you change the calling method.
133 (defun rmail-output (file-name &optional count) 151 (defun rmail-output (file-name &optional count)
134 "Append this message to Unix mail file named FILE-NAME. 152 "Append this message to Unix mail file named FILE-NAME.
149 (or count (setq count 1)) 167 (or count (setq count 1))
150 (setq file-name 168 (setq file-name
151 (expand-file-name file-name 169 (expand-file-name file-name
152 (and rmail-last-file 170 (and rmail-last-file
153 (file-name-directory rmail-last-file)))) 171 (file-name-directory rmail-last-file))))
154 (setq rmail-last-file file-name) 172 (if (and (file-readable-p file) (rmail-file-p file-name))
155 (while (> count 0) 173 (rmail-output-to-rmail-file file-name count)
156 (let ((rmailbuf (current-buffer)) 174 (setq rmail-last-file file-name)
157 (tembuf (get-buffer-create " rmail-output")) 175 (while (> count 0)
158 (case-fold-search t)) 176 (let ((rmailbuf (current-buffer))
159 (save-excursion 177 (tembuf (get-buffer-create " rmail-output"))
160 (set-buffer tembuf) 178 (case-fold-search t))
161 (erase-buffer) 179 (save-excursion
162 ;; If we can do it, read a little of the file 180 (set-buffer tembuf)
163 ;; to check whether it is an RMAIL file. 181 (erase-buffer)
164 ;; If it is, don't mess it up. 182 (insert-buffer-substring rmailbuf)
165 (and (file-readable-p file-name) 183 (insert "\n")
166 (progn (insert-file-contents file-name nil 0 20) 184 (goto-char (point-min))
167 (looking-at "BABYL OPTIONS:\n")) 185 (insert "From "
168 (error (save-excursion 186 (mail-strip-quoted-names (or (mail-fetch-field "from")
169 (set-buffer rmailbuf) 187 (mail-fetch-field "really-from")
170 (substitute-command-keys 188 (mail-fetch-field "sender")
171 "Use \\[rmail-output-to-rmail-file] to output to Rmail file `%s'")) 189 "unknown"))
172 (file-name-nondirectory file-name))) 190 " " (current-time-string) "\n")
173 (erase-buffer) 191 ;; ``Quote'' "\nFrom " as "\n>From "
174 (insert-buffer-substring rmailbuf) 192 ;; (note that this isn't really quoting, as there is no requirement
175 (insert "\n") 193 ;; that "\n[>]+From " be quoted in the same transparent way.)
176 (goto-char (point-min)) 194 (while (search-forward "\nFrom " nil t)
177 (insert "From " 195 (forward-char -5)
178 (mail-strip-quoted-names (or (mail-fetch-field "from") 196 (insert ?>))
179 (mail-fetch-field "really-from") 197 (append-to-file (point-min) (point-max) file-name))
180 (mail-fetch-field "sender") 198 (kill-buffer tembuf))
181 "unknown")) 199 (if (equal major-mode 'rmail-mode)
182 " " (current-time-string) "\n") 200 (rmail-set-attribute "filed" t))
183 ;; ``Quote'' "\nFrom " as "\n>From " 201 (setq count (1- count))
184 ;; (note that this isn't really quoting, as there is no requirement 202 (if rmail-delete-after-output
185 ;; that "\n[>]+From " be quoted in the same transparent way.) 203 (rmail-delete-forward)
186 (while (search-forward "\nFrom " nil t) 204 (if (> count 0)
187 (forward-char -5) 205 (rmail-next-undeleted-message 1)))))
188 (insert ?>))
189 (append-to-file (point-min) (point-max) file-name))
190 (kill-buffer tembuf))
191 (if (equal major-mode 'rmail-mode)
192 (rmail-set-attribute "filed" t))
193 (setq count (1- count))
194 (if rmail-delete-after-output
195 (rmail-delete-forward)
196 (if (> count 0)
197 (rmail-next-undeleted-message 1)))))
198 206
199 ;;; rmailout.el ends here 207 ;;; rmailout.el ends here