|
0
|
1 ;;; Saving and piping messages under VM
|
|
|
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-save)
|
|
|
19
|
|
|
20 ;; (match-data) returns the match data as MARKERS, often corrupting
|
|
|
21 ;; it in the process due to buffer narrowing, and the fact that buffers are
|
|
|
22 ;; indexed from 1 while strings are indexed from 0. :-(
|
|
|
23 (defun vm-match-data ()
|
|
|
24 (let ((index '(9 8 7 6 5 4 3 2 1 0))
|
|
|
25 (list))
|
|
|
26 (while index
|
|
|
27 (setq list (cons (match-beginning (car index))
|
|
|
28 (cons (match-end (car index)) list))
|
|
|
29 index (cdr index)))
|
|
|
30 list ))
|
|
|
31
|
|
|
32 (defun vm-auto-select-folder (mp auto-folder-alist)
|
|
|
33 (condition-case error-data
|
|
|
34 (catch 'match
|
|
|
35 (let (header alist tuple-list)
|
|
|
36 (setq alist auto-folder-alist)
|
|
|
37 (while alist
|
|
|
38 (setq header (vm-get-header-contents (car mp) (car (car alist))))
|
|
|
39 (if (null header)
|
|
|
40 ()
|
|
|
41 (setq tuple-list (cdr (car alist)))
|
|
|
42 (while tuple-list
|
|
|
43 (if (let ((case-fold-search vm-auto-folder-case-fold-search))
|
|
|
44 (string-match (car (car tuple-list)) header))
|
|
|
45 ;; Don't waste time eval'ing an atom.
|
|
|
46 (if (atom (cdr (car tuple-list)))
|
|
|
47 (throw 'match (cdr (car tuple-list)))
|
|
|
48 (let* ((match-data (vm-match-data))
|
|
|
49 ;; allow this buffer to live forever
|
|
|
50 (buf (get-buffer-create " *vm-auto-folder*"))
|
|
|
51 (result))
|
|
|
52 ;; Set up a buffer that matches our cached
|
|
|
53 ;; match data.
|
|
|
54 (save-excursion
|
|
|
55 (set-buffer buf)
|
|
|
56 (widen)
|
|
|
57 (erase-buffer)
|
|
|
58 (insert header)
|
|
|
59 ;; It appears that get-buffer-create clobbers the
|
|
|
60 ;; match-data.
|
|
|
61 ;;
|
|
|
62 ;; The match data is off by one because we matched
|
|
|
63 ;; a string and Emacs indexes strings from 0 and
|
|
|
64 ;; buffers from 1.
|
|
|
65 ;;
|
|
|
66 ;; Also store-match-data only accepts MARKERS!!
|
|
|
67 ;; AUGHGHGH!!
|
|
|
68 (store-match-data
|
|
|
69 (mapcar
|
|
|
70 (function (lambda (n) (and n (vm-marker n))))
|
|
|
71 (mapcar
|
|
|
72 (function (lambda (n) (and n (1+ n))))
|
|
|
73 match-data)))
|
|
|
74 (setq result (eval (cdr (car tuple-list))))
|
|
|
75 (while (consp result)
|
|
|
76 (setq result (vm-auto-select-folder mp result)))
|
|
|
77 (if result
|
|
|
78 (throw 'match result))))))
|
|
|
79 (setq tuple-list (cdr tuple-list))))
|
|
|
80 (setq alist (cdr alist)))
|
|
|
81 nil ))
|
|
|
82 (error (error "error processing vm-auto-folder-alist: %s"
|
|
|
83 (prin1-to-string error-data)))))
|
|
|
84
|
|
|
85 (defun vm-auto-archive-messages (&optional arg)
|
|
|
86 "Save all unfiled messages that auto-match a folder via
|
|
|
87 vm-auto-folder-alist to their appropriate folders. Messages that
|
|
|
88 are flagged for deletion are not saved.
|
|
|
89
|
|
|
90 Prefix arg means to ask user for confirmation before saving each message.
|
|
|
91
|
|
|
92 When invoked on marked messages (via vm-next-command-uses-marks),
|
|
|
93 only marked messages are checked against vm-auto-folder-alist.
|
|
|
94
|
|
|
95 The saved messages are flagged as `filed'."
|
|
|
96 (interactive "P")
|
|
|
97 (vm-select-folder-buffer)
|
|
|
98 (vm-check-for-killed-summary)
|
|
|
99 (vm-error-if-folder-empty)
|
|
|
100 (vm-unsaved-message "Archiving...")
|
|
|
101 (let ((auto-folder)
|
|
|
102 (archived 0))
|
|
|
103 (unwind-protect
|
|
|
104 ;; Need separate (let ...) so vm-message-pointer can
|
|
|
105 ;; revert back in time for
|
|
|
106 ;; (vm-update-summary-and-mode-line).
|
|
|
107 ;; vm-last-save-folder is tucked away here since archives
|
|
|
108 ;; shouldn't affect its value.
|
|
|
109 (let ((vm-message-pointer
|
|
|
110 (if (eq last-command 'vm-next-command-uses-marks)
|
|
|
111 (vm-select-marked-or-prefixed-messages 0)
|
|
|
112 vm-message-list))
|
|
|
113 (done nil)
|
|
|
114 stop-point
|
|
|
115 (vm-last-save-folder vm-last-save-folder)
|
|
|
116 (vm-move-after-deleting nil))
|
|
|
117 ;; mark the place where we should stop. otherwise if any
|
|
|
118 ;; messages in this folder are archived to this folder
|
|
|
119 ;; we would file messages into this folder forever.
|
|
|
120 (setq stop-point (vm-last vm-message-pointer))
|
|
|
121 (while (not done)
|
|
|
122 (and (not (vm-filed-flag (car vm-message-pointer)))
|
|
|
123 ;; don't archive deleted messages
|
|
|
124 (not (vm-deleted-flag (car vm-message-pointer)))
|
|
|
125 (setq auto-folder (vm-auto-select-folder
|
|
|
126 vm-message-pointer
|
|
|
127 vm-auto-folder-alist))
|
|
|
128 (or (null arg)
|
|
|
129 (y-or-n-p
|
|
|
130 (format "Save message %s in folder %s? "
|
|
|
131 (vm-number-of (car vm-message-pointer))
|
|
|
132 auto-folder)))
|
|
|
133 (let ((vm-delete-after-saving vm-delete-after-archiving))
|
|
|
134 (if (not (string-equal auto-folder "/dev/null"))
|
|
|
135 (vm-save-message auto-folder))
|
|
|
136 (vm-increment archived)
|
|
|
137 (vm-unsaved-message "%d archived, still working..."
|
|
|
138 archived)))
|
|
|
139 (setq done (eq vm-message-pointer stop-point)
|
|
|
140 vm-message-pointer (cdr vm-message-pointer))))
|
|
|
141 ;; fix mode line
|
|
|
142 (intern (buffer-name) vm-buffers-needing-display-update)
|
|
|
143 (vm-update-summary-and-mode-line))
|
|
|
144 (if (zerop archived)
|
|
|
145 (message "No messages archived")
|
|
|
146 (message "%d message%s archived"
|
|
|
147 archived (if (= 1 archived) "" "s")))))
|
|
|
148
|
|
|
149 (defun vm-save-message (folder &optional count)
|
|
|
150 "Save the current message to a mail folder.
|
|
|
151 If the folder already exists, the message will be appended to it.
|
|
|
152
|
|
|
153 Prefix arg COUNT means save this message and the next COUNT-1
|
|
|
154 messages. A negative COUNT means save this message and the
|
|
|
155 previous COUNT-1 messages.
|
|
|
156
|
|
|
157 When invoked on marked messages (via vm-next-command-uses-marks),
|
|
|
158 all marked messages in the current folder are saved; other messages are
|
|
|
159 ignored.
|
|
|
160
|
|
|
161 The saved messages are flagged as `filed'."
|
|
|
162 (interactive
|
|
|
163 (list
|
|
|
164 ;; protect value of last-command
|
|
|
165 (let ((last-command last-command)
|
|
|
166 (this-command this-command))
|
|
|
167 (vm-follow-summary-cursor)
|
|
|
168 (let ((default (save-excursion
|
|
|
169 (vm-select-folder-buffer)
|
|
|
170 (vm-check-for-killed-summary)
|
|
|
171 (vm-error-if-folder-empty)
|
|
|
172 (or (vm-auto-select-folder vm-message-pointer
|
|
|
173 vm-auto-folder-alist)
|
|
|
174 vm-last-save-folder)))
|
|
|
175 (dir (or vm-folder-directory default-directory)))
|
|
|
176 (cond ((and default
|
|
|
177 (let ((default-directory dir))
|
|
|
178 (file-directory-p default)))
|
|
|
179 (vm-read-file-name "Save in folder: " dir nil nil default))
|
|
|
180 (default
|
|
|
181 (vm-read-file-name
|
|
|
182 (format "Save in folder: (default %s) " default)
|
|
|
183 dir default))
|
|
|
184 (t
|
|
|
185 (vm-read-file-name "Save in folder: " dir nil)))))
|
|
|
186 (prefix-numeric-value current-prefix-arg)))
|
|
|
187 (let (unexpanded-folder)
|
|
|
188 (setq unexpanded-folder folder)
|
|
|
189 (vm-select-folder-buffer)
|
|
|
190 (vm-check-for-killed-summary)
|
|
|
191 (vm-error-if-folder-empty)
|
|
|
192 (vm-display nil nil '(vm-save-message) '(vm-save-message))
|
|
|
193 (or count (setq count 1))
|
|
|
194 ;; Expand the filename, forcing relative paths to resolve
|
|
|
195 ;; into the folder directory.
|
|
|
196 (let ((default-directory
|
|
|
197 (expand-file-name (or vm-folder-directory default-directory))))
|
|
|
198 (setq folder (expand-file-name folder)))
|
|
|
199 ;; Confirm new folders, if the user requested this.
|
|
|
200 (if (and vm-confirm-new-folders (interactive-p)
|
|
|
201 (not (file-exists-p folder))
|
|
|
202 (or (not vm-visit-when-saving) (not (vm-get-file-buffer folder)))
|
|
|
203 (not (y-or-n-p (format "%s does not exist, save there anyway? "
|
|
|
204 folder))))
|
|
|
205 (error "Save aborted"))
|
|
|
206 ;; Check and see if we are currently visiting the folder
|
|
|
207 ;; that the user wants to save to.
|
|
|
208 (if (and (not vm-visit-when-saving) (vm-get-file-buffer folder))
|
|
|
209 (error "Folder %s is being visited, cannot save." folder))
|
|
|
210 (let ((mlist (vm-select-marked-or-prefixed-messages count))
|
|
|
211 (m nil) (count 0) folder-buffer target-type)
|
|
|
212 (cond ((and mlist (eq vm-visit-when-saving t))
|
|
|
213 (setq folder-buffer (or (vm-get-file-buffer folder)
|
|
|
214 ;; avoid letter bombs
|
|
|
215 (let ((inhibit-local-variables t)
|
|
|
216 (enable-local-variables nil))
|
|
|
217 (find-file-noselect folder)))))
|
|
|
218 ((and mlist vm-visit-when-saving)
|
|
|
219 (setq folder-buffer (vm-get-file-buffer folder))))
|
|
|
220 (if (and mlist vm-check-folder-types)
|
|
|
221 (progn
|
|
|
222 (setq target-type (or (vm-get-folder-type folder)
|
|
|
223 vm-default-folder-type
|
|
|
224 (and mlist
|
|
|
225 (vm-message-type-of (car mlist)))))
|
|
|
226 (if (eq target-type 'unknown)
|
|
|
227 (error "Folder %s's type is unrecognized" folder))))
|
|
|
228 ;; if target folder is empty or nonexistent we need to
|
|
|
229 ;; write out the folder header first.
|
|
|
230 (if mlist
|
|
|
231 (let ((attrs (file-attributes folder)))
|
|
|
232 (if (or (null attrs) (= 0 (nth 7 attrs)))
|
|
|
233 (if (null folder-buffer)
|
|
|
234 (vm-write-string folder (vm-folder-header target-type))
|
|
|
235 (vm-write-string folder-buffer
|
|
|
236 (vm-folder-header target-type))))))
|
|
|
237 (save-excursion
|
|
|
238 (while mlist
|
|
|
239 (setq m (vm-real-message-of (car mlist)))
|
|
|
240 (set-buffer (vm-buffer-of m))
|
|
|
241 (vm-save-restriction
|
|
|
242 (widen)
|
|
|
243 ;; have to stuff the attributes in all cases because
|
|
|
244 ;; the deleted attribute may have been stuffed
|
|
|
245 ;; previously and we don't want to save that attribute.
|
|
|
246 ;; also we don't want to save out the cached summary entry.
|
|
|
247 (vm-stuff-attributes m t)
|
|
|
248 (if (null folder-buffer)
|
|
|
249 (if (or (null vm-check-folder-types)
|
|
|
250 (eq target-type (vm-message-type-of m)))
|
|
|
251 (write-region (vm-start-of m)
|
|
|
252 (vm-end-of m)
|
|
|
253 folder t 'quiet)
|
|
|
254 (if (null vm-convert-folder-types)
|
|
|
255 (if (not (vm-virtual-message-p (car mlist)))
|
|
|
256 (error "Folder type mismatch: %s, %s"
|
|
|
257 (vm-message-type-of m) target-type)
|
|
|
258 (error "Message %s type mismatches folder %s"
|
|
|
259 (vm-number-of (car mlist))
|
|
|
260 folder
|
|
|
261 (vm-message-type-of m)
|
|
|
262 target-type))
|
|
|
263 (vm-write-string
|
|
|
264 folder
|
|
|
265 (vm-leading-message-separator target-type m t))
|
|
|
266 (if (eq target-type 'From_-with-Content-Length)
|
|
|
267 (vm-write-string
|
|
|
268 folder
|
|
|
269 (concat vm-content-length-header " "
|
|
|
270 (vm-su-byte-count m) "\n")))
|
|
|
271 (write-region (vm-headers-of m)
|
|
|
272 (vm-text-end-of m)
|
|
|
273 folder t 'quiet)
|
|
|
274 (vm-write-string
|
|
|
275 folder
|
|
|
276 (vm-trailing-message-separator target-type))))
|
|
|
277 (save-excursion
|
|
|
278 (set-buffer folder-buffer)
|
|
|
279 ;; if the buffer is a live VM folder
|
|
|
280 ;; honor vm-folder-read-only.
|
|
|
281 (if vm-folder-read-only
|
|
|
282 (signal 'folder-read-only (list (current-buffer))))
|
|
|
283 (let ((buffer-read-only nil))
|
|
|
284 (vm-save-restriction
|
|
|
285 (widen)
|
|
|
286 (save-excursion
|
|
|
287 (goto-char (point-max))
|
|
|
288 (if (or (null vm-check-folder-types)
|
|
|
289 (eq target-type (vm-message-type-of m)))
|
|
|
290 (insert-buffer-substring
|
|
|
291 (vm-buffer-of m)
|
|
|
292 (vm-start-of m) (vm-end-of m))
|
|
|
293 (if (null vm-convert-folder-types)
|
|
|
294 (if (not (vm-virtual-message-p (car mlist)))
|
|
|
295 (error "Folder type mismatch: %s, %s"
|
|
|
296 (vm-message-type-of m) target-type)
|
|
|
297 (error "Message %s type mismatches folder %s"
|
|
|
298 (vm-number-of (car mlist))
|
|
|
299 folder
|
|
|
300 (vm-message-type-of m)
|
|
|
301 target-type))
|
|
|
302 (vm-write-string
|
|
|
303 (current-buffer)
|
|
|
304 (vm-leading-message-separator target-type m t))
|
|
|
305 (if (eq target-type 'From_-with-Content-Length)
|
|
|
306 (vm-write-string
|
|
|
307 (current-buffer)
|
|
|
308 (concat vm-content-length-header " "
|
|
|
309 (vm-su-byte-count m) "\n")))
|
|
|
310 (insert-buffer-substring (vm-buffer-of m)
|
|
|
311 (vm-headers-of m)
|
|
|
312 (vm-text-end-of m))
|
|
|
313 (vm-write-string
|
|
|
314 (current-buffer)
|
|
|
315 (vm-trailing-message-separator target-type)))))
|
|
|
316 ;; vars should exist and be local
|
|
|
317 ;; but they may have strange values,
|
|
|
318 ;; so check the major-mode.
|
|
|
319 (cond ((eq major-mode 'vm-mode)
|
|
|
320 (vm-increment vm-messages-not-on-disk)
|
|
|
321 (vm-clear-modification-flag-undos)))))))
|
|
|
322 (if (null (vm-filed-flag m))
|
|
|
323 (vm-set-filed-flag m t))
|
|
|
324 (vm-increment count)
|
|
|
325 (vm-update-summary-and-mode-line)
|
|
|
326 (setq mlist (cdr mlist)))))
|
|
|
327 (if m
|
|
|
328 (if folder-buffer
|
|
|
329 (progn
|
|
|
330 (save-excursion
|
|
|
331 (set-buffer folder-buffer)
|
|
|
332 (if (eq major-mode 'vm-mode)
|
|
|
333 (progn
|
|
|
334 (vm-check-for-killed-summary)
|
|
|
335 (vm-assimilate-new-messages)
|
|
|
336 (if (null vm-message-pointer)
|
|
|
337 (progn (setq vm-message-pointer vm-message-list
|
|
|
338 vm-need-summary-pointer-update t)
|
|
|
339 (intern (buffer-name)
|
|
|
340 vm-buffers-needing-display-update)
|
|
|
341 (vm-preview-current-message))
|
|
|
342 (vm-update-summary-and-mode-line)))))
|
|
|
343 (if (interactive-p)
|
|
|
344 (message "%d message%s saved to buffer %s"
|
|
|
345 count
|
|
|
346 (if (/= 1 count) "s" "")
|
|
|
347 (buffer-name folder-buffer))))
|
|
|
348 (if (interactive-p)
|
|
|
349 (message "%d message%s saved to %s"
|
|
|
350 count (if (/= 1 count) "s" "") folder)))))
|
|
|
351 (setq vm-last-save-folder unexpanded-folder)
|
|
|
352 (if vm-delete-after-saving
|
|
|
353 (vm-delete-message count))))
|
|
|
354
|
|
|
355 (defun vm-save-message-sans-headers (file &optional count)
|
|
|
356 "Save the current message to a file, without its header section.
|
|
|
357 If the file already exists, the message will be appended to it.
|
|
|
358 Prefix arg COUNT means save the next COUNT messages. A negative COUNT means
|
|
|
359 save the previous COUNT.
|
|
|
360
|
|
|
361 When invoked on marked messages (via vm-next-command-uses-marks),
|
|
|
362 all marked messages in the current folder are saved; other messages are
|
|
|
363 ignored.
|
|
|
364
|
|
|
365 The saved messages are flagged as `written'.
|
|
|
366
|
|
|
367 This command should NOT be used to save message to mail folders; use
|
|
|
368 vm-save-message instead (normally bound to `s')."
|
|
|
369 (interactive
|
|
|
370 ;; protect value of last-command
|
|
|
371 (let ((last-command last-command)
|
|
|
372 (this-command this-command))
|
|
|
373 (vm-follow-summary-cursor)
|
|
|
374 (vm-select-folder-buffer)
|
|
|
375 (list
|
|
|
376 (vm-read-file-name
|
|
|
377 (if vm-last-written-file
|
|
|
378 (format "Write text to file: (default %s) "
|
|
|
379 vm-last-written-file)
|
|
|
380 "Write text to file: ")
|
|
|
381 nil vm-last-written-file nil)
|
|
|
382 (prefix-numeric-value current-prefix-arg))))
|
|
|
383 (vm-select-folder-buffer)
|
|
|
384 (vm-check-for-killed-summary)
|
|
|
385 (vm-error-if-folder-empty)
|
|
|
386 (vm-display nil nil '(vm-save-message-sans-headers)
|
|
|
387 '(vm-save-message-sans-headers))
|
|
|
388 (or count (setq count 1))
|
|
|
389 (setq file (expand-file-name file))
|
|
|
390 ;; Check and see if we are currently visiting the file
|
|
|
391 ;; that the user wants to save to.
|
|
|
392 (if (and (not vm-visit-when-saving) (vm-get-file-buffer file))
|
|
|
393 (error "File %s is being visited, cannot save." file))
|
|
|
394 (let ((mlist (vm-select-marked-or-prefixed-messages count))
|
|
|
395 (m nil) file-buffer)
|
|
|
396 (cond ((and mlist (eq vm-visit-when-saving t))
|
|
|
397 (setq file-buffer (or (vm-get-file-buffer file)
|
|
|
398 (find-file-noselect file))))
|
|
|
399 ((and mlist vm-visit-when-saving)
|
|
|
400 (setq file-buffer (vm-get-file-buffer file))))
|
|
|
401 (save-excursion
|
|
|
402 (while mlist
|
|
|
403 (setq m (vm-real-message-of (car mlist)))
|
|
|
404 (set-buffer (vm-buffer-of m))
|
|
|
405 (vm-save-restriction
|
|
|
406 (widen)
|
|
|
407 (if (null file-buffer)
|
|
|
408 (write-region (vm-text-of m)
|
|
|
409 (vm-text-end-of m)
|
|
|
410 file t 'quiet)
|
|
|
411 (let ((start (vm-text-of m))
|
|
|
412 (end (vm-text-end-of m)))
|
|
|
413 (save-excursion
|
|
|
414 (set-buffer file-buffer)
|
|
|
415 (save-excursion
|
|
|
416 (let (buffer-read-only)
|
|
|
417 (vm-save-restriction
|
|
|
418 (widen)
|
|
|
419 (save-excursion
|
|
|
420 (goto-char (point-max))
|
|
|
421 (insert-buffer-substring
|
|
|
422 (vm-buffer-of m)
|
|
|
423 start end))))))))
|
|
|
424 (if (null (vm-written-flag m))
|
|
|
425 (vm-set-written-flag m t))
|
|
|
426 (vm-update-summary-and-mode-line)
|
|
|
427 (setq mlist (cdr mlist)))))
|
|
|
428 (if m
|
|
|
429 (if file-buffer
|
|
|
430 (message "Message%s written to buffer %s" (if (/= 1 count) "s" "")
|
|
|
431 (buffer-name file-buffer))
|
|
|
432 (message "Message%s written to %s" (if (/= 1 count) "s" "") file)))
|
|
|
433 (setq vm-last-written-file file)))
|
|
|
434
|
|
|
435 (defun vm-pipe-message-to-command (command prefix-arg)
|
|
|
436 "Run shell command with the some or all of the current message as input.
|
|
|
437 By default the entire message is used.
|
|
|
438 With one \\[universal-argument] the text portion of the message is used.
|
|
|
439 With two \\[universal-argument]'s the header portion of the message is used.
|
|
|
440 With three \\[universal-argument]'s the visible header portion of the message
|
|
|
441 plus the text portion is used.
|
|
|
442
|
|
|
443 When invoked on marked messages (via vm-next-command-uses-marks),
|
|
|
444 each marked message is successively piped to the shell command,
|
|
|
445 one message per command invocation.
|
|
|
446
|
|
|
447 Output, if any, is displayed. The message is not altered."
|
|
|
448 (interactive
|
|
|
449 ;; protect value of last-command
|
|
|
450 (let ((last-command last-command)
|
|
|
451 (this-command this-command))
|
|
|
452 (vm-follow-summary-cursor)
|
|
|
453 (vm-select-folder-buffer)
|
|
|
454 (list (read-string "Pipe to command: " vm-last-pipe-command)
|
|
|
455 current-prefix-arg)))
|
|
|
456 (vm-select-folder-buffer)
|
|
|
457 (vm-check-for-killed-summary)
|
|
|
458 (vm-error-if-folder-empty)
|
|
|
459 (setq vm-last-pipe-command command)
|
|
|
460 (let ((buffer (get-buffer-create "*Shell Command Output*"))
|
|
|
461 m
|
|
|
462 (pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))
|
|
|
463 ;; prefix arg doesn't have "normal" meaning here, so only call
|
|
|
464 ;; vm-select-marked-or-prefixed-messages if we're using marks.
|
|
|
465 (mlist (if (eq last-command 'vm-next-command-uses-marks)
|
|
|
466 (vm-select-marked-or-prefixed-messages 0)
|
|
|
467 (list (car vm-message-pointer)))))
|
|
|
468 (set-buffer buffer)
|
|
|
469 (erase-buffer)
|
|
|
470 (while mlist
|
|
|
471 (setq m (vm-real-message-of (car mlist)))
|
|
|
472 (set-buffer (vm-buffer-of m))
|
|
|
473 (save-restriction
|
|
|
474 (widen)
|
|
|
475 (goto-char (vm-headers-of m))
|
|
|
476 (cond ((equal prefix-arg nil)
|
|
|
477 (narrow-to-region (point) (vm-text-end-of m)))
|
|
|
478 ((equal prefix-arg '(4))
|
|
|
479 (narrow-to-region (vm-text-of m)
|
|
|
480 (vm-text-end-of m)))
|
|
|
481 ((equal prefix-arg '(16))
|
|
|
482 (narrow-to-region (point) (vm-text-of m)))
|
|
|
483 ((equal prefix-arg '(64))
|
|
|
484 (narrow-to-region (vm-vheaders-of m) (vm-text-end-of m)))
|
|
|
485 (t (narrow-to-region (point) (vm-text-end-of m))))
|
|
|
486 (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))))
|
|
|
487 (call-process-region (point-min) (point-max)
|
|
|
488 (or shell-file-name "sh")
|
|
|
489 nil buffer nil "-c" command)))
|
|
|
490 (setq mlist (cdr mlist)))
|
|
|
491 (set-buffer buffer)
|
|
|
492 (if (not (zerop (buffer-size)))
|
|
|
493 (vm-display buffer t '(vm-pipe-message-to-command)
|
|
|
494 '(vm-pipe-message-to-command))
|
|
|
495 (vm-display nil nil '(vm-pipe-message-to-command)
|
|
|
496 '(vm-pipe-message-to-command)))))
|
|
|
497
|
|
|
498 (defun vm-print-message ()
|
|
|
499 "Print the current message."
|
|
|
500 (interactive)
|
|
|
501 (vm-pipe-message-to-command
|
|
|
502 (mapconcat (function identity)
|
|
|
503 (nconc (list vm-print-command) vm-print-command-switches)
|
|
|
504 " ")
|
|
|
505 '(64)))
|
|
|
506
|
