kjones@talos.UUCP (Kyle Jones) (05/25/89)
William G. Bunton writes: > I've installed vm, and so far it looks good, except for one problem. > All of the routines to save a message to a folder seem be in a file > 'vm-save.el', which isn't in any of the three parts posted. Oops. Here it is. -------------------- #!/bin/sh # shar: Shell Archiver (v1.22) # # Run the following text with /bin/sh to create: # vm-save.el # sed 's/^X//' << 'SHAR_EOF' > vm-save.el && X;;; Saving and piping messages under VM X;;; Copyright (C) 1989 Kyle E. Jones X;;; X;;; This program is free software; you can redistribute it and/or modify X;;; it under the terms of the GNU General Public License as published by X;;; the Free Software Foundation; either version 1, or (at your option) X;;; any later version. X;;; X;;; This program is distributed in the hope that it will be useful, X;;; but WITHOUT ANY WARRANTY; without even the implied warranty of X;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the X;;; GNU General Public License for more details. X;;; X;;; You should have received a copy of the GNU General Public License X;;; along with this program; if not, write to the Free Software X;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. X X(require 'vm) X X(defun vm-auto-select-folder (mp) X (condition-case () X (catch 'match X (let (header alist tuple-list) X (setq alist vm-auto-folder-alist) X (while alist X (setq header (vm-get-header-contents (car mp) (car (car alist)))) X (if (null header) X () X (setq tuple-list (cdr (car alist))) X (while tuple-list X (if (let (case-fold-search) X (string-match (car (car tuple-list)) header)) X (throw 'match (cdr (car tuple-list)))) X (setq tuple-list (cdr tuple-list)))) X (setq alist (cdr alist))) X nil )) X (error nil))) X X(defun vm-auto-archive-messages () X "Save all unfiled messages that auto-match a folder via vm-auto-folder-alist Xto their appropriate folders." X (interactive) X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (vm-error-if-mailbox-empty) X (let ((auto-folder) X (archived 0)) X ;; Need separate (let ...) so vm-message-pointer can revert back X ;; in time for (vm-update-summary-and-mode-line). X (let ((vm-message-pointer vm-message-list)) X (while vm-message-pointer X (and (not (vm-filed-flag (car vm-message-pointer))) X (setq auto-folder (vm-auto-select-folder vm-message-pointer)) X (progn (vm-save-message auto-folder 1) X (vm-increment archived))) X (setq vm-message-pointer (cdr vm-message-pointer)))) X (if (zerop archived) X (message "No messages archived") X (message "%d message%s archived" archived (if (= 1 archived) "" "s")) X (vm-update-summary-and-mode-line)))) X X(defun vm-save-message (folder count) X "Save the current message to a mail folder. XPrefix arg COUNT means save the next COUNT messages. A negative COUNT means Xsave the previous COUNT. If the folder already exists, the message Xwill be appended to it. The saved messages are marked as being filed." X (interactive X (list X (let ((default (vm-auto-select-folder X (save-excursion X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X vm-message-pointer))) X (dir (or vm-folder-directory default-directory))) X (if default X (read-file-name (format "Save in folder: (default %s) " X default) X dir default nil ) X (read-file-name "Save in folder: " dir nil nil))) X (prefix-numeric-value current-prefix-arg))) X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (vm-error-if-mailbox-empty) X ;; Expand the filename forcing relative paths to resolve X ;; into the folder directory. X (let ((default-directory (or vm-folder-directory defautl-directory))) X (setq folder (expand-file-name folder))) X (if (not vm-visit-when-saving) X ;; Check and see if we are currently visiting the folder X ;; that the user wants to save to. X (let ((blist (buffer-list))) X (while blist X (if (equal (buffer-file-name (car blist)) folder) X (error "Folder %s is being visited, cannot save." folder)) X (setq blist (cdr blist))))) X (let ((vm-message-pointer vm-message-pointer) X (direction (if (> count 0) 'forward 'backward)) X (folder-buffer) X (mail-buffer (current-buffer)) X (count (vm-abs count))) X (if vm-visit-when-saving X (progn X (setq folder-buffer (find-file-noselect folder)) X (if (eq folder-buffer mail-buffer) X (error "This IS folder %s, you must save messages elsewhere." X buffer-file-name)))) X (save-restriction X (widen) X (while (not (zerop count)) X (if (not vm-visit-when-saving) X (write-region (vm-start-of (car vm-message-pointer)) X (vm-end-of (car vm-message-pointer)) X folder t 'quiet) X (let ((start (vm-start-of (car vm-message-pointer))) X (end (vm-end-of (car vm-message-pointer)))) X (save-excursion X (set-buffer folder-buffer) X (let (buffer-read-only) X (vm-save-restriction X (widen) X (goto-char (point-max)) X (insert-buffer-substring mail-buffer start end)))))) X (if (null (vm-filed-flag (car vm-message-pointer))) X (vm-set-filed-flag (car vm-message-pointer) t)) X (vm-move-message-pointer direction) X (vm-decrement count))) X (if vm-visit-when-saving X (progn X (save-excursion X (set-buffer folder-buffer) X (let (buffer-read-only) X (if (eq major-mode 'vm-mode) X (progn X (vm-assimilate-new-messages) X (if vm-summary-buffer X (vm-do-summary)))))) X (message "Message%s saved to buffer %s" (if (/= 1 count) "s" "") X (buffer-name folder-buffer))) X (message "Message%s saved to %s" (if (/= 1 count) "s" "") folder))) X (vm-update-summary-and-mode-line)) X X(defun vm-save-message-sans-headers (folder count) X "Save the current message to a mail folder minus its header section. XPrefix arg COUNT means save the next COUNT messages. A negative COUNT means Xsave the previous COUNT. If the folder already exists, the message Xwill be appended to it. The saved messages are NOT marked as being filed, Xbecause the filed attributes is meant to denote saving to mail folders and Xthis command should NOT be used to do that Use vm-save-message instead X(normally bound to `s'." X (interactive X (list X (read-file-name "Write text to file: " nil nil nil) X (prefix-numeric-value current-prefix-arg))) X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (vm-error-if-mailbox-empty) X ;; Expand the filename forcing relative paths to resolve X ;; into the folder directory. X (let ((default-directory (or vm-folder-directory defautl-directory))) X (setq folder (expand-file-name folder))) X (if (not vm-visit-when-saving) X ;; Check and see if we are currently visiting the folder X ;; that the user wants to save to. X (let ((blist (buffer-list))) X (while blist X (if (equal (buffer-file-name (car blist)) folder) X (error "File %s is being visited, cannot save." folder)) X (setq blist (cdr blist))))) X (let ((vm-message-pointer vm-message-pointer) X (direction (if (> count 0) 'forward 'backward)) X (folder-buffer) X (mail-buffer (current-buffer)) X (count (vm-abs count))) X (if vm-visit-when-saving X (progn X (setq folder-buffer (find-file-noselect folder)) X (if (eq folder-buffer mail-buffer) X (error "This IS file %s, you must write messages elsewhere." X buffer-file-name)))) X (save-restriction X (widen) X (while (not (zerop count)) X (if (not vm-visit-when-saving) X (write-region (vm-text-of (car vm-message-pointer)) X (vm-end-of (car vm-message-pointer)) X folder t 'quiet) X (let ((start (vm-text-of (car vm-message-pointer))) X (end (vm-end-of (car vm-message-pointer)))) X (save-excursion X (set-buffer folder-buffer) X (let (buffer-read-only) X (vm-save-restriction X (widen) X (goto-char (point-max)) X (insert-buffer-substring mail-buffer start end)))))) X (vm-move-message-pointer direction) X (vm-decrement count))) X (if vm-visit-when-saving X (message "Message%s written to buffer %s" (if (/= 1 count) "s" "") X (buffer-name folder-buffer)) X (message "Message%s written to %s" (if (/= 1 count) "s" "") folder))) X (vm-update-summary-and-mode-line)) X X(defun vm-pipe-message-to-command (command prefix-arg) X "Run shell command with the some or all of the current message as input. XBy default the entire message is used. XWith one \\[universal-argument] the text portion of the message is used. XWith two \\[universal-argument]'s the header portion of the message is used. X XOutput is discarded. The message is not altered." X (interactive "sPipe message to command: \nP") X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (vm-error-if-mailbox-empty) X (save-restriction X (widen) X (cond ((equal prefix-arg nil) X (narrow-to-region (vm-start-of (car vm-message-pointer)) X (vm-end-of (car vm-message-pointer)))) X ((equal prefix-arg '(4)) X (narrow-to-region (vm-text-of (car vm-message-pointer)) X (vm-end-of (car vm-message-pointer)))) X ((equal prefix-arg '(16)) X (narrow-to-region (vm-start-of (car vm-message-pointer)) X (vm-text-of (car vm-message-pointer)))) X (t (narrow-to-region (vm-start-of (car vm-message-pointer)) X (vm-end-of (car vm-message-pointer))))) X (call-process-region (point-min) (point-max) X "sh" nil nil nil "-c" command))) SHAR_EOF chmod 0664 vm-save.el || echo "restore of vm-save.el fails" exit 0