|
0
|
1 ;;; Message encapsulation
|
|
|
2 ;;; Copyright (C) 1989, 1990, 1993, 1994 Kyle E. Jones
|
|
|
3 ;;;
|
|
|
4 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
5 ;;; it under the terms of the GNU General Public License as published by
|
|
|
6 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
7 ;;; any later version.
|
|
|
8 ;;;
|
|
|
9 ;;; This program is distributed in the hope that it will be useful,
|
|
|
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
12 ;;; GNU General Public License for more details.
|
|
|
13 ;;;
|
|
|
14 ;;; You should have received a copy of the GNU General Public License
|
|
|
15 ;;; along with this program; if not, write to the Free Software
|
|
|
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
17
|
|
|
18 (provide 'vm-digest)
|
|
|
19
|
|
|
20 (defun vm-no-frills-encapsulate-message (m keep-list discard-regexp)
|
|
|
21 "Encapsulate a message M for forwarding, simply.
|
|
|
22 No message encapsulation standard is used. The message is
|
|
|
23 inserted at point in the current buffer, surrounded by two dashed
|
|
|
24 start/end separator lines. Point is not moved.
|
|
|
25
|
|
|
26 M should be a message struct for a real message, not a virtual message.
|
|
|
27 This is the message that will be encapsulated.
|
|
|
28 KEEP-LIST should be a list of regexps matching headers to keep.
|
|
|
29 DISCARD-REGEXP should be a regexp that matches headers to be discarded.
|
|
|
30 KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers
|
|
|
31 to be forwarded. See the docs for vm-reorder-message-headers
|
|
|
32 to find out how KEEP-LIST and DISCARD-REGEXP are used."
|
|
|
33 (let ((target-buffer (current-buffer))
|
|
|
34 source-buffer)
|
|
|
35 (save-restriction
|
|
|
36 ;; narrow to a zero length region to avoid interacting
|
|
|
37 ;; with anything that might have already been inserted
|
|
|
38 ;; into the buffer.
|
|
|
39 (narrow-to-region (point) (point))
|
|
|
40 (insert "------- start of forwarded message -------\n")
|
|
|
41 (setq source-buffer (vm-buffer-of m))
|
|
|
42 (save-excursion
|
|
|
43 (set-buffer source-buffer)
|
|
|
44 (save-restriction
|
|
|
45 (widen)
|
|
|
46 (save-excursion
|
|
|
47 (set-buffer target-buffer)
|
|
|
48 (let ((beg (point)))
|
|
|
49 (insert-buffer-substring source-buffer (vm-headers-of m)
|
|
|
50 (vm-text-end-of m))
|
|
|
51 (goto-char beg)
|
|
|
52 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)")
|
|
|
53 (vm-reorder-message-headers nil keep-list discard-regexp)))))
|
|
|
54 (goto-char (point-max))
|
|
|
55 (insert "------- end of forwarded message -------\n"))))
|
|
|
56
|
|
|
57 (defun vm-rfc934-char-stuff-region (start end)
|
|
|
58 "Quote RFC 934 message separators between START and END.
|
|
|
59 START and END are buffer positions in the current buffer.
|
|
|
60 Lines beginning with `-' in the region have `- ' prepended to them."
|
|
|
61 (setq end (vm-marker end))
|
|
|
62 (save-excursion
|
|
|
63 (goto-char start)
|
|
|
64 (while (and (< (point) end) (re-search-forward "^-" end t))
|
|
|
65 (replace-match "- -" t t)))
|
|
|
66 (set-marker end nil))
|
|
|
67
|
|
|
68 (defun vm-rfc934-char-unstuff-region (start end)
|
|
|
69 "Unquote lines in between START and END as per RFC 934.
|
|
|
70 START and END are buffer positions in the current buffer.
|
|
|
71 Lines beginning with `- ' in the region have that string stripped
|
|
|
72 from them."
|
|
|
73 (setq end (vm-marker end))
|
|
|
74 (save-excursion
|
|
|
75 (goto-char start)
|
|
|
76 (while (and (< (point) end) (re-search-forward "^- " end t))
|
|
|
77 (replace-match "" t t)
|
|
|
78 (forward-char)))
|
|
|
79 (set-marker end nil))
|
|
|
80
|
|
|
81 (defun vm-rfc934-encapsulate-messages (message-list keep-list discard-regexp)
|
|
|
82 "Encapsulate the messages in MESSAGE-LIST as per RFC 934.
|
|
|
83 The resulting digest is inserted at point in the current buffer.
|
|
|
84 Point is not moved.
|
|
|
85
|
|
|
86 MESSAGE-LIST should be a list of message structs (real or virtual).
|
|
|
87 These are the messages that will be encapsulated.
|
|
|
88 KEEP-LIST should be a list of regexps matching headers to keep.
|
|
|
89 DISCARD-REGEXP should be a regexp that matches headers to be discarded.
|
|
|
90 KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers
|
|
|
91 to be forwarded. See the docs for vm-reorder-message-headers
|
|
|
92 to find out how KEEP-LIST and DISCARD-REGEXP are used."
|
|
|
93 (if message-list
|
|
|
94 (let ((target-buffer (current-buffer))
|
|
|
95 (mlist message-list)
|
|
|
96 source-buffer m start n)
|
|
|
97 (save-restriction
|
|
|
98 ;; narrow to a zero length region to avoid interacting
|
|
|
99 ;; with anything that might have already been inserted
|
|
|
100 ;; into the buffer.
|
|
|
101 (narrow-to-region (point) (point))
|
|
|
102 (setq start (point))
|
|
|
103 (while mlist
|
|
|
104 (insert "---------------\n")
|
|
|
105 (setq m (vm-real-message-of (car mlist))
|
|
|
106 source-buffer (vm-buffer-of m))
|
|
|
107 (save-excursion
|
|
|
108 (set-buffer source-buffer)
|
|
|
109 (save-restriction
|
|
|
110 (widen)
|
|
|
111 (save-excursion
|
|
|
112 (set-buffer target-buffer)
|
|
|
113 (let ((beg (point)))
|
|
|
114 (insert-buffer-substring source-buffer (vm-headers-of m)
|
|
|
115 (vm-text-end-of m))
|
|
|
116 (goto-char beg)
|
|
|
117 (vm-reorder-message-headers nil nil
|
|
|
118 "\\(X-VM-\\|Status:\\)")
|
|
|
119 (vm-reorder-message-headers nil keep-list discard-regexp)
|
|
|
120 (vm-rfc934-char-stuff-region beg (point-max))))))
|
|
|
121 (goto-char (point-max))
|
|
|
122 (insert "---------------")
|
|
|
123 (setq mlist (cdr mlist)))
|
|
|
124 (delete-region (point) (progn (beginning-of-line) (point)))
|
|
|
125 (insert "------- end -------\n")
|
|
|
126 (goto-char start)
|
|
|
127 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
128 (setq n (length message-list))
|
|
|
129 (insert (format "------- start of %s%s(RFC 934 encapsulation) -------\n"
|
|
|
130 (if (cdr message-list)
|
|
|
131 "digest "
|
|
|
132 "forwarded message ")
|
|
|
133 (if (cdr message-list)
|
|
|
134 (format "(%d messages) " n)
|
|
|
135 "")))
|
|
|
136 (goto-char start)))))
|
|
|
137
|
|
|
138 (defun vm-rfc1153-char-stuff-region (start end)
|
|
|
139 "Quote RFC 1153 message separators between START and END.
|
|
|
140 START and END are buffer positions in the current buffer.
|
|
|
141 Lines consisting only of 30 hyphens have the first hyphen
|
|
|
142 converted to a space."
|
|
|
143 (setq end (vm-marker end))
|
|
|
144 (save-excursion
|
|
|
145 (goto-char start)
|
|
|
146 (while (and (< (point) end)
|
|
|
147 (re-search-forward "^------------------------------$" end t))
|
|
|
148 (replace-match " -----------------------------" t t)))
|
|
|
149 (set-marker end nil))
|
|
|
150
|
|
|
151 (defun vm-rfc1153-char-unstuff-region (start end)
|
|
|
152 "Unquote lines in between START and END as per RFC 1153.
|
|
|
153 START and END are buffer positions in the current buffer.
|
|
|
154 Lines consisting only of a space following by 29 hyphens have the space
|
|
|
155 converted to a hyphen."
|
|
|
156 (setq end (vm-marker end))
|
|
|
157 (save-excursion
|
|
|
158 (goto-char start)
|
|
|
159 (while (and (< (point) end)
|
|
|
160 (re-search-forward "^ -----------------------------$" end t))
|
|
|
161 (replace-match "------------------------------" t t)))
|
|
|
162 (set-marker end nil))
|
|
|
163
|
|
|
164 (defun vm-rfc1153-encapsulate-messages (message-list keep-list discard-regexp)
|
|
|
165 "Encapsulate the messages in MESSAGE-LIST as per RFC 1153.
|
|
|
166 The resulting digest is inserted at point in the current buffer.
|
|
|
167 Point is not moved.
|
|
|
168
|
|
|
169 MESSAGE-LIST should be a list of message structs (real or virtual).
|
|
|
170 These are the messages that will be encapsulated.
|
|
|
171 KEEP-LIST should be a list of regexps matching headers to keep.
|
|
|
172 DISCARD-REGEXP should be a regexp that matches headers to be discarded.
|
|
|
173 KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers
|
|
|
174 to be forwarded. See the docs for vm-reorder-message-headers
|
|
|
175 to find out how KEEP-LIST and DISCARD-REGEXP are used."
|
|
|
176 (if message-list
|
|
|
177 (let ((target-buffer (current-buffer))
|
|
|
178 (mlist message-list)
|
|
|
179 source-buffer m start)
|
|
|
180 (save-restriction
|
|
|
181 ;; narrow to a zero length region to avoid interacting
|
|
|
182 ;; with anything that might have already been inserted
|
|
|
183 ;; into the buffer.
|
|
|
184 (narrow-to-region (point) (point))
|
|
|
185 (setq start (point))
|
|
|
186 (while mlist
|
|
|
187 (insert "---------------\n\n")
|
|
|
188 (setq m (vm-real-message-of (car mlist))
|
|
|
189 source-buffer (vm-buffer-of m))
|
|
|
190 (save-excursion
|
|
|
191 (set-buffer source-buffer)
|
|
|
192 (save-restriction
|
|
|
193 (widen)
|
|
|
194 (save-excursion
|
|
|
195 (set-buffer target-buffer)
|
|
|
196 (let ((beg (point)))
|
|
|
197 (insert-buffer-substring source-buffer (vm-headers-of m)
|
|
|
198 (vm-text-end-of m))
|
|
|
199 (goto-char beg)
|
|
|
200 (vm-reorder-message-headers nil nil
|
|
|
201 "\\(X-VM-\\|Status:\\)")
|
|
|
202 (vm-reorder-message-headers nil keep-list discard-regexp)
|
|
|
203 (vm-rfc1153-char-stuff-region beg (point-max))))))
|
|
|
204 (goto-char (point-max))
|
|
|
205 (insert "\n---------------")
|
|
|
206 (setq mlist (cdr mlist)))
|
|
|
207 (insert "---------------\n\nEnd of this Digest\n******************\n")
|
|
|
208 (goto-char start)
|
|
|
209 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
210 (insert (format "This is an RFC 1153 digest.\n(%d message%s)\n----------------------------------------------------------------------\n" (length message-list) (if (cdr message-list) "s" "")))
|
|
|
211 (goto-char start)))))
|
|
|
212
|
|
2
|
213 (defun vm-rfc1521-encapsulate-messages (message-list keep-list discard-regexp)
|
|
|
214 "Encapsulate the messages in MESSAGE-LIST as per RFC 1521 (MIME).
|
|
|
215 The resulting digest is inserted at point in the current buffer.
|
|
|
216 MIME headers at point-max are added/updated.
|
|
|
217 Point is not moved.
|
|
|
218
|
|
|
219 MESSAGE-LIST should be a list of message structs (real or virtual).
|
|
|
220 These are the messages that will be encapsulated.
|
|
|
221 KEEP-LIST should be a list of regexps matching headers to keep.
|
|
|
222 DISCARD-REGEXP should be a regexp that matches headers to be discarded.
|
|
|
223 KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers
|
|
|
224 to be forwarded. See the docs for vm-reorder-message-headers
|
|
|
225 to find out how KEEP-LIST and DISCARD-REGEXP are used."
|
|
|
226 (if message-list
|
|
|
227 (let ((target-buffer (current-buffer))
|
|
|
228 (mlist message-list)
|
|
|
229 (boundary (format "-----%07X%07X" (abs (random)) (abs (random))))
|
|
|
230 ; insertion-point
|
|
|
231 source-buffer m start)
|
|
|
232 (save-restriction
|
|
|
233 ;; narrow to a zero length region to avoid interacting
|
|
|
234 ;; with anything that might have already been inserted
|
|
|
235 ;; into the buffer.
|
|
|
236 (narrow-to-region (point) (point))
|
|
|
237 (setq start (point))
|
|
|
238 (while mlist
|
|
|
239 (insert "--" boundary "\nContent-Type: message/rfc822\n\n")
|
|
|
240 (setq m (vm-real-message-of (car mlist))
|
|
|
241 source-buffer (vm-buffer-of m))
|
|
|
242 (save-excursion
|
|
|
243 (set-buffer source-buffer)
|
|
|
244 (save-restriction
|
|
|
245 (widen)
|
|
|
246 (save-excursion
|
|
|
247 (set-buffer target-buffer)
|
|
|
248 (let ((beg (point)))
|
|
|
249 (insert-buffer-substring source-buffer (vm-headers-of m)
|
|
|
250 (vm-text-end-of m))
|
|
|
251 (goto-char beg)
|
|
|
252 (vm-reorder-message-headers nil nil
|
|
|
253 "\\(X-VM-\\|Status:\\)")
|
|
|
254 (vm-reorder-message-headers nil keep-list discard-regexp)
|
|
|
255 ))))
|
|
|
256 (goto-char (point-max))
|
|
|
257 (insert "\n")
|
|
|
258 (setq mlist (cdr mlist)))
|
|
|
259 (insert "--" boundary "--\n")
|
|
|
260
|
|
|
261 (goto-char start)
|
|
|
262 (insert "--" boundary "\nContent-Type: text/plain\n\n")
|
|
|
263 (insert (format
|
|
|
264 "This is an RFC 1521 (MIME) digest; %d message%s.\n\n\n\n\n"
|
|
|
265 (length message-list)
|
|
|
266 (if (cdr message-list) "s" "")))
|
|
|
267 ; (setq insertion-point (point-marker))
|
|
|
268 (goto-char start))
|
|
|
269
|
|
|
270 ;; outside of the save-restriction
|
|
|
271 (save-excursion
|
|
|
272 (let (end)
|
|
|
273 (goto-char (point-min))
|
|
|
274 (re-search-forward
|
|
|
275 (concat "^" (regexp-quote mail-header-separator) "$")
|
|
|
276 nil t)
|
|
|
277 (setq end (point))
|
|
|
278 (goto-char (point-min))
|
|
|
279 (cond
|
|
|
280 ((re-search-forward "^content-type:" end t)
|
|
|
281 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
282 (while (looking-at " \t")
|
|
|
283 (delete-region (point) (progn (forward-line 1) (point))))))
|
|
|
284 (goto-char end)
|
|
|
285 (insert "MIME-Version: 1.0\n"
|
|
|
286 "Content-Type: multipart/digest; boundary=\""
|
|
|
287 boundary "\"\n")
|
|
|
288 ))
|
|
|
289
|
|
|
290 ; (goto-char insertion-point)
|
|
|
291 ; (set-marker insertion-point nil)
|
|
|
292 )))
|
|
|
293
|
|
|
294
|
|
0
|
295 (defun vm-rfc1153-or-rfc934-burst-message (m rfc1153)
|
|
|
296 "Burst messages from the digest message M.
|
|
|
297 M should be a message struct for a real message.
|
|
|
298 If RFC1153 is non-nil, assume the digest is of the form specified by
|
|
|
299 RFC 1153. Otherwise assume RFC 934 digests."
|
|
|
300 (let ((work-buffer nil)
|
|
|
301 (match t)
|
|
|
302 (prev-sep nil)
|
|
|
303 (ident-header nil)
|
|
|
304 after-prev-sep prologue-separator-regexp separator-regexp
|
|
|
305 (folder-type vm-folder-type))
|
|
|
306 (if vm-digest-identifier-header-format
|
|
|
307 (setq ident-header (vm-sprintf 'vm-digest-identifier-header-format m)))
|
|
|
308 (if rfc1153
|
|
|
309 (setq prologue-separator-regexp "^----------------------------------------------------------------------\n"
|
|
|
310 separator-regexp "^------------------------------\n")
|
|
|
311 (setq prologue-separator-regexp "^-[^ ].*\n"
|
|
|
312 separator-regexp "^-[^ ].*\n"))
|
|
|
313 (save-excursion
|
|
|
314 (vm-save-restriction
|
|
|
315 (widen)
|
|
|
316 (unwind-protect
|
|
|
317 (catch 'done
|
|
|
318 (setq work-buffer (generate-new-buffer "*vm-work*"))
|
|
|
319 (set-buffer work-buffer)
|
|
|
320 (insert-buffer-substring (vm-buffer-of m)
|
|
|
321 (vm-text-of m)
|
|
|
322 (vm-text-end-of m))
|
|
|
323 (goto-char (point-min))
|
|
|
324 (if (not (re-search-forward prologue-separator-regexp nil t))
|
|
|
325 (throw 'done nil))
|
|
|
326 ;; think of this as a do-while loop.
|
|
|
327 (while match
|
|
|
328 (cond ((null prev-sep)
|
|
|
329 ;; from (point-min) to end of match
|
|
|
330 ;; is the digest prologue, devour it and
|
|
|
331 ;; carry on.
|
|
|
332 (delete-region (point-min) (match-end 0)))
|
|
|
333 (t
|
|
|
334 ;; munge previous messages message separators
|
|
|
335 (let ((md (match-data)))
|
|
|
336 (unwind-protect
|
|
|
337 (vm-munge-message-separators
|
|
|
338 folder-type
|
|
|
339 after-prev-sep
|
|
|
340 (match-beginning 0))
|
|
|
341 (store-match-data md)))
|
|
|
342 ;; eat preceding newlines
|
|
|
343 (while (= (preceding-char) ?\n)
|
|
|
344 (delete-char -1))
|
|
|
345 ;; put one back
|
|
|
346 (insert ?\n)))
|
|
|
347 ;; insert a trailing message separator
|
|
|
348 ;; delete the digest separator
|
|
|
349 ;; insert the leading separator
|
|
|
350 (if prev-sep
|
|
|
351 (progn
|
|
|
352 (delete-region (match-beginning 0) (match-end 0))
|
|
|
353 (insert (vm-trailing-message-separator folder-type))))
|
|
|
354 (setq prev-sep (point))
|
|
|
355 (insert (vm-leading-message-separator folder-type))
|
|
|
356 (setq after-prev-sep (point))
|
|
|
357 ;; eat trailing newlines
|
|
|
358 (while (= (following-char) ?\n)
|
|
|
359 (delete-char 1))
|
|
|
360 (insert ident-header)
|
|
|
361 ;; try to match message separator and repeat.
|
|
|
362 (setq match (re-search-forward separator-regexp nil t)))
|
|
|
363 ;; from the last separator to eof is the digest epilogue.
|
|
|
364 ;; discard it.
|
|
|
365 (delete-region (or prev-sep (point-min)) (point-max))
|
|
|
366 ;; Undo the quoting of the embedded message
|
|
|
367 ;; separators. This must be done before header
|
|
|
368 ;; conversions, else the Content-Length offsets might be
|
|
|
369 ;; rendered invalid by buffer size changes.
|
|
|
370 (if rfc1153
|
|
|
371 (vm-rfc1153-char-unstuff-region (point-min) (point-max))
|
|
|
372 (vm-rfc934-char-unstuff-region (point-min) (point-max)))
|
|
|
373 ;; do header conversions.
|
|
|
374 (let ((vm-folder-type folder-type))
|
|
|
375 (goto-char (point-min))
|
|
|
376 (while (vm-find-leading-message-separator)
|
|
|
377 (vm-skip-past-leading-message-separator)
|
|
|
378 (vm-convert-folder-type-headers folder-type folder-type)
|
|
|
379 (vm-find-trailing-message-separator)
|
|
|
380 (vm-skip-past-trailing-message-separator)))
|
|
|
381 ;; now insert the messages into the folder buffer
|
|
|
382 (cond ((not (zerop (buffer-size)))
|
|
|
383 (set-buffer (vm-buffer-of m))
|
|
|
384 (let ((old-buffer-modified-p (buffer-modified-p))
|
|
|
385 (buffer-read-only nil)
|
|
|
386 (inhibit-quit t))
|
|
|
387 (goto-char (point-max))
|
|
|
388 (insert-buffer-substring work-buffer)
|
|
|
389 (set-buffer-modified-p old-buffer-modified-p)
|
|
|
390 ;; return non-nil so caller knows we found some messages
|
|
|
391 t ))
|
|
|
392 ;; return nil so the caller knows we didn't find anything
|
|
|
393 (t nil)))
|
|
|
394 (and work-buffer (kill-buffer work-buffer)))))))
|
|
|
395
|
|
|
396 (defun vm-rfc934-burst-message (m)
|
|
|
397 "Burst messages from the RFC 934 digest message M.
|
|
|
398 M should be a message struct for a real message."
|
|
|
399 (vm-rfc1153-or-rfc934-burst-message m nil))
|
|
|
400
|
|
|
401 (defun vm-rfc1153-burst-message (m)
|
|
|
402 "Burst messages from the RFC 1153 digest message M.
|
|
|
403 M should be a message struct for a real message."
|
|
|
404 (vm-rfc1153-or-rfc934-burst-message m t))
|
|
|
405
|
|
|
406 (defun vm-burst-digest (&optional digest-type)
|
|
|
407 "Burst the current message (a digest) into its individual messages.
|
|
|
408 The digest's messages are assimilated into the folder as new mail
|
|
|
409 would be.
|
|
|
410
|
|
|
411 Optional argument DIGEST-TYPE is a string that tells VM what kind
|
|
|
412 of digest the current message is. If it is not given the value
|
|
|
413 defaults to the value of vm-digest-burst-type. When called
|
|
|
414 interactively DIGEST-TYPE will be read from the minibuffer.
|
|
|
415
|
|
|
416 If invoked on marked messages (via vm-next-command-uses-marks),
|
|
|
417 all marked messages will be burst."
|
|
|
418 (interactive
|
|
|
419 (list
|
|
|
420 (let ((type nil)
|
|
|
421 (this-command this-command)
|
|
|
422 (last-command last-command))
|
|
|
423 (setq type (completing-read (format "Digest type: (default %s) "
|
|
|
424 vm-digest-burst-type)
|
|
|
425 (append vm-digest-type-alist
|
|
|
426 (list '("guess")))
|
|
|
427 'identity nil))
|
|
|
428 (if (string= type "")
|
|
|
429 vm-digest-burst-type
|
|
|
430 type ))))
|
|
|
431 (or digest-type (setq digest-type vm-digest-burst-type))
|
|
|
432 (vm-follow-summary-cursor)
|
|
|
433 (vm-select-folder-buffer)
|
|
|
434 (vm-check-for-killed-summary)
|
|
|
435 (vm-error-if-folder-empty)
|
|
|
436 (let ((start-buffer (current-buffer)) m totals-blurb
|
|
|
437 (mlist (vm-select-marked-or-prefixed-messages 1)))
|
|
|
438 (while mlist
|
|
|
439 (if (vm-virtual-message-p (car mlist))
|
|
|
440 (progn
|
|
|
441 (setq m (vm-real-message-of (car mlist)))
|
|
|
442 (set-buffer (vm-buffer-of m)))
|
|
|
443 (setq m (car mlist)))
|
|
|
444 (vm-error-if-folder-read-only)
|
|
|
445 (if (equal digest-type "guess")
|
|
|
446 (progn
|
|
|
447 (setq digest-type (vm-guess-digest-type m))
|
|
|
448 (if (null digest-type)
|
|
|
449 (error "Couldn't guess digest type."))))
|
|
|
450 (vm-unsaved-message "Bursting %s digest..." digest-type)
|
|
|
451 (cond
|
|
|
452 ((cond ((equal digest-type "rfc934")
|
|
|
453 (vm-rfc934-burst-message m))
|
|
|
454 ((equal digest-type "rfc1153")
|
|
|
455 (vm-rfc1153-burst-message m))
|
|
2
|
456 ((equal digest-type "rfc1521")
|
|
|
457 (error "Don't yet know how to burst MIME digests."))
|
|
0
|
458 (t (error "Unknown digest type: %s" digest-type)))
|
|
|
459 (message "Bursting %s digest... done" digest-type)
|
|
|
460 (vm-clear-modification-flag-undos)
|
|
|
461 (vm-set-buffer-modified-p t)
|
|
|
462 (vm-increment vm-modification-counter)
|
|
|
463 (and vm-delete-after-bursting
|
|
|
464 ;; if start folder was virtual, we're now in the wrong
|
|
|
465 ;; buffer. switch back.
|
|
|
466 (save-excursion
|
|
|
467 (set-buffer start-buffer)
|
|
|
468 (vm-delete-message 1)))
|
|
|
469 (vm-assimilate-new-messages t)
|
|
|
470 ;; do this now so if we error later in another iteration
|
|
|
471 ;; of the loop the summary and mode line will be correct.
|
|
|
472 (vm-update-summary-and-mode-line)))
|
|
|
473 (setq mlist (cdr mlist)))
|
|
|
474 ;; collect this data NOW, before the non-previewers read a
|
|
|
475 ;; message, alter the new message count and confuse
|
|
|
476 ;; themselves.
|
|
|
477 (setq totals-blurb (vm-emit-totals-blurb))
|
|
|
478 (vm-display nil nil '(vm-burst-digest
|
|
|
479 vm-burst-rfc934-digest
|
|
2
|
480 vm-burst-rfc1153-digest
|
|
|
481 vm-burst-rfc1521-digest)
|
|
0
|
482 (list this-command))
|
|
|
483 (if (vm-thoughtfully-select-message)
|
|
|
484 (vm-preview-current-message)
|
|
|
485 (vm-update-summary-and-mode-line))
|
|
|
486 (message totals-blurb)))
|
|
|
487
|
|
|
488 (defun vm-burst-rfc934-digest ()
|
|
|
489 "Burst an RFC 934 style digest"
|
|
|
490 (interactive)
|
|
|
491 (vm-burst-digest "rfc934"))
|
|
|
492
|
|
|
493 (defun vm-burst-rfc1153-digest ()
|
|
|
494 "Burst an RFC 1153 style digest"
|
|
|
495 (interactive)
|
|
|
496 (vm-burst-digest "rfc1153"))
|
|
|
497
|
|
2
|
498 (defun vm-burst-rfc1521-digest ()
|
|
|
499 "Burst an RFC 1521 (MIME) style digest"
|
|
|
500 (interactive)
|
|
|
501 (vm-burst-digest "rfc1521"))
|
|
|
502
|
|
0
|
503 (defun vm-guess-digest-type (m)
|
|
|
504 "Guess the digest type of the message M.
|
|
|
505 M should be the message struct of a real message.
|
|
2
|
506 Returns either \"rfc934\", \"rfc1153\", or \"rfc1521\"."
|
|
0
|
507 (save-excursion
|
|
|
508 (set-buffer (vm-buffer-of m))
|
|
|
509 (save-excursion
|
|
|
510 (save-restriction
|
|
|
511 (widen)
|
|
2
|
512 (goto-char (vm-headers-of m))
|
|
|
513 (if (let ((case-fold-search t))
|
|
|
514 (re-search-forward "^MIME-Version:" nil t))
|
|
|
515 "rfc1521"
|
|
|
516 (goto-char (vm-text-of m))
|
|
|
517 (if (search-forward "\n----------------------------------------------------------------------\n" nil t)
|
|
|
518 "rfc1153"
|
|
|
519 "rfc934"))))))
|
