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