Mercurial > hg > xemacs-beta
diff lisp/vm/vm-save.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 05472e90ae02 |
children | 0d2f883870bc |
line wrap: on
line diff
--- a/lisp/vm/vm-save.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 09:02:59 2007 +0200 @@ -35,8 +35,7 @@ (let (header alist tuple-list) (setq alist auto-folder-alist) (while alist - (setq header (vm-get-header-contents (car mp) (car (car alist)) - ", ")) + (setq header (vm-get-header-contents (car mp) (car (car alist)))) (if (null header) () (setq tuple-list (cdr (car alist))) @@ -98,7 +97,7 @@ (vm-select-folder-buffer) (vm-check-for-killed-summary) (vm-error-if-folder-empty) - (message "Archiving...") + (vm-unsaved-message "Archiving...") (let ((auto-folder) (archived 0)) (unwind-protect @@ -132,16 +131,18 @@ (vm-number-of (car vm-message-pointer)) auto-folder))) (let ((vm-delete-after-saving vm-delete-after-archiving)) - (vm-save-message auto-folder) + (if (not (string-equal auto-folder "/dev/null")) + (vm-save-message auto-folder)) (vm-increment archived) - (message "%d archived, still working..." archived))) + (vm-unsaved-message "%d archived, still working..." + archived))) (setq done (eq vm-message-pointer stop-point) vm-message-pointer (cdr vm-message-pointer)))) ;; fix mode line (intern (buffer-name) vm-buffers-needing-display-update) (vm-update-summary-and-mode-line)) (if (zerop archived) - (message "No messages were archived") + (message "No messages archived") (message "%d message%s archived" archived (if (= 1 archived) "" "s"))))) @@ -432,9 +433,8 @@ (setq vm-last-written-file file))) (defun vm-pipe-message-to-command (command prefix-arg) - "Runs a shell command with some or all of the contents of the -current message as input. -By default, the entire message is used. + "Run shell command with the some or all of the current message as input. +By default the entire message is used. With one \\[universal-argument] the text portion of the message is used. With two \\[universal-argument]'s the header portion of the message is used. With three \\[universal-argument]'s the visible header portion of the message @@ -486,7 +486,7 @@ (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))) (call-process-region (point-min) (point-max) (or shell-file-name "sh") - nil buffer nil shell-command-switch command))) + nil buffer nil "-c" command))) (setq mlist (cdr mlist))) (set-buffer buffer) (if (not (zerop (buffer-size))) @@ -495,74 +495,12 @@ (vm-display nil nil '(vm-pipe-message-to-command) '(vm-pipe-message-to-command))))) -(defun vm-print-message (&optional count) - "Print the current message -Prefix arg N means print the current message and the next N - 1 messages. -Prefix arg -N means print the current message and the previous N - 1 messages. - -The variable `vm-print-command' controls what command is run to -print the message, and `vm-print-command-switches' is a list of switches -to pass to the command. - -When invoked on marked messages (via vm-next-command-uses-marks), -each marked message is printed, one message per vm-print-command invocation. +(defun vm-print-message () + "Print the current message." + (interactive) + (vm-pipe-message-to-command + (mapconcat (function identity) + (nconc (list vm-print-command) vm-print-command-switches) + " ") + '(64))) -Output, if any, is displayed. The message is not altered." - (interactive "p") - (vm-follow-summary-cursor) - (vm-select-folder-buffer) - (vm-check-for-killed-summary) - (vm-error-if-folder-empty) - (or count (setq count 1)) - (let ((buffer (get-buffer-create "*Shell Command Output*")) - (command (mapconcat (function identity) - (nconc (list vm-print-command) - vm-print-command-switches) - " ")) - (m nil) - (pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))) - (mlist (vm-select-marked-or-prefixed-messages count))) - (set-buffer buffer) - (erase-buffer) - (while mlist - (setq m (vm-real-message-of (car mlist))) - (set-buffer (vm-buffer-of m)) - (if (and vm-display-using-mime (vectorp (vm-mm-layout m))) - (let ((work-buffer nil)) - (unwind-protect - (progn - (setq work-buffer (generate-new-buffer "*vm-work*")) - (set-buffer work-buffer) - (vm-insert-region-from-buffer - (vm-buffer-of m) (vm-vheaders-of m) (vm-text-of m)) - (vm-decode-mime-encoded-words) - (goto-char (point-max)) - (let ((vm-auto-displayed-mime-content-types - '("text" "multipart")) - (vm-mime-internal-content-types - '("text" "multipart")) - (vm-mime-external-content-types-alist nil)) - (vm-decode-mime-layout (vm-mm-layout m))) - (let ((pop-up-windows (and pop-up-windows - (eq vm-mutable-windows t)))) - (call-process-region (point-min) (point-max) - (or shell-file-name "sh") - nil buffer nil - shell-command-switch command))) - (and work-buffer (kill-buffer work-buffer)))) - (save-restriction - (widen) - (narrow-to-region (vm-vheaders-of m) (vm-text-end-of m)) - (let ((pop-up-windows (and pop-up-windows - (eq vm-mutable-windows t)))) - (call-process-region (point-min) (point-max) - (or shell-file-name "sh") - nil buffer nil - shell-command-switch command)))) - (setq mlist (cdr mlist))) - (set-buffer buffer) - (if (not (zerop (buffer-size))) - (vm-display buffer t '(vm-pipe-message-to-command) - '(vm-pipe-message-to-command)) - (vm-display nil nil '(vm-pipe-message-to-command) - '(vm-pipe-message-to-command)))))