From:	CRDGW2::CRDGW2::MRGATE::"SMTP::PREP.AI.MIT.EDU::INFO-GNU-EMACS-REQUEST" 13-JUL-1989 11:43
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VM 4.37 (part 1 of 4)

Received: by life.ai.mit.edu (4.1/AI-4.10) id AA02072; Wed, 12 Jul 89 18:12:14 EDT
Return-Path: <talos!kjones@uunet.uu.net>
Received: from uunet.uu.net by life.ai.mit.edu (4.1/AI-4.10) id AA01690; Wed, 12 Jul 89 17:55:37 EDT
Received: from talos.UUCP by uunet.uu.net (5.61/1.14) with UUCP 
	id AA03242; Wed, 12 Jul 89 17:55:22 -0400
Date: Wed, 12 Jul 89 17:28:59 EDT
From: talos!kjones@uunet.uu.net (Kyle Jones)
Message-Id: <8907122128.AA02101@talos.uucp>
To: info-gnu-emacs@prep.ai.mit.edu
Reply-To: kyle@cs.odu.edu
Subject: VM 4.37 (part 1 of 4)

This is the first of four messages containing the Emacs-Lisp source and
documentation for the VM (View Mail) mail reader, version 4.37.  There
are a number of improvements, nearly all of which were sparked by your
suggestions.  There are no new commands.  Here are the new variables:

	vm-circular-folders
	vm-confirm-new-folders
	vm-delete-after-saving
	vm-delete-empty-folders
	vm-follow-summary-cursor
	vm-forwarding-subject-format
	vm-in-reply-to-format
	vm-move-after-deleting
	vm-mutable-windows
	vm-preview-read-messages
	vm-strip-reply-headers

`M-x vm' starts VM.  Type a ? for help.  There's an Info document if you
care to go that route, but the help text should be enough for most.  The
manual can also be processed and printed with TeX.

MMDF users should (setq vm-folder-type 'mmdf) in their .emacs files.

Mouseketeers will be interested in the variable `vm-follow-summary-cursor'.

If you don't like VM changing your window configuration, `vm-mutable-windows'
will interest you.

Users who want compressed mail folders should (require 'crypt) and
(setq vm-visit-when-saving t) in their .emacs files.  If you don't have
crypt.el, you can get it from me.  N.B.: your primary inbox cannot be
compressed.

If you use Emacs' etc/fakemail, then make sure `vm-strip-reply-headers'
is set non-nil, otherwise your replies to messages may disappear without
a trace.

Users with multiple spool files, or spool files in strange locations
should set the variable `vm-spool-files'.

There are many other variables; all are listed in the on-line help and
in the manual.

VM requires GNU Emacs version 18.51 or beyond.

Scream at the peacocks.
-----------------------------
#!/bin/sh
# shar:	Shell Archiver  (v1.22)
#
# This is part 1 of a multipart archive                                    
# do not concatenate these parts, unpack them in order with /bin/sh        
#
#	Run the following text with /bin/sh to create:
#	  vm-delete.el
#	  vm-digest.el
#	  vm-group.el
#	  vm-license.el
#	  vm-reply.el
#	  vm-save.el
#	  vm-search.el
#	  vm-summary.el
#	  vm-undo.el
#	  vm.el
#	  vm.texinfo
#	  COPYING
#	  README
#
if test -r s2_seq_.tmp
then echo "Must unpack archives in sequence!"
     next=`cat s2_seq_.tmp`; echo "Please unpack part $next next"
     exit 1; fi
echo "x - extracting vm-delete.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > vm-delete.el &&
X;;; Delete and expunge commands for 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;;; Send bug reports to kyle@cs.odu.edu.
X
X(require 'vm)
X
X(defun vm-delete-message (count)
X  "Mark the current message for deletion.
XWith a prefix arg mark the next COUNT messages for deletion.  A negative
Xarg means the previous COUNT messages are marked."
X  (interactive "p")
X  (if (interactive-p)
X      (vm-follow-summary-cursor))
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (if (not (eq vm-circular-folders t))
X      (vm-check-count count))
X  (let ((direction (if (< count 0) 'backward 'forward))
X	(count (vm-abs count))
X	(oldmp vm-message-pointer)
X	(vm-message-pointer vm-message-pointer))
X    (while (not (zerop count))
X      (if (not (vm-deleted-flag (car vm-message-pointer)))
X	  (vm-set-deleted-flag (car vm-message-pointer) t))
X      (vm-decrement count)
X      (if (not (zerop count))
X	  (vm-move-message-pointer direction))))
X  (vm-update-summary-and-mode-line)
X  (if vm-move-after-deleting
X      (vm-next-message count)))
X
X(defun vm-undelete-message (count)
X  "Remove the deletion mark from the current message.
XWith a prefix arg unmark the next COUNT messages.  A negative arg means
Xthe previous COUNT messages are unmarked."
X  (interactive "p")
X  (if (interactive-p)
X      (vm-follow-summary-cursor))
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (if (not (eq vm-circular-folders t))
X      (vm-check-count count))
X  (let ((direction (if (< count 0) 'backward 'forward))
X	(count (vm-abs count))
X	(oldmp vm-message-pointer)
X	(vm-message-pointer vm-message-pointer))
X    (while (not (zerop count))
X      (if (vm-deleted-flag (car vm-message-pointer))
X	  (vm-set-deleted-flag (car vm-message-pointer) nil))
X      (vm-decrement count)
X      (if (not (zerop count))
X	  (vm-move-message-pointer direction))))
X  (vm-update-summary-and-mode-line))
X
X(defun vm-kill-subject ()
X  "Mark all mesages with the same subject as the current message
X\(ignoring re:'s) for deletion."
X  (interactive)
X  (vm-follow-summary-cursor)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (let ((subject (vm-subject-of (car vm-message-pointer)))
X	(mp vm-message-list))
X    (if (string-match "^\\(re: *\\)+" subject)
X	(setq subject (substring subject (match-end 0))))
X    (setq subject (concat "^\\(re: *\\)*" (regexp-quote subject) " *$"))
X    (while mp
X      (if (and (not (vm-deleted-flag (car mp)))
X	       (string-match subject (vm-subject-of (car mp))))
X	  (vm-set-deleted-flag (car mp) t))
X      (setq mp (cdr mp))))
X  (vm-update-summary-and-mode-line))
X
X(defun vm-expunge-folder (&optional quitting shaddap)
X  "Expunge deleted messages, but don't save folder to disk or exit VM."
X  (interactive)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (let ((inhibit-quit t))
X    (if (vm-gobble-deleted-messages)
X	(if (not quitting)
X	    (progn
X	      (if (not shaddap)
X		  (message "Deleted messages expunged."))
X	      (vm-number-messages)
X	      (if vm-summary-buffer
X		  (vm-do-summary))
X	      (if (and vm-message-pointer vm-summary-buffer)
X		  (vm-set-summary-pointer (car vm-message-pointer)))
X	      (if (null vm-message-pointer)
X		  (vm-next-message)
X		(if (null vm-system-state)
X		    (vm-preview-current-message)
X		  (vm-update-summary-and-mode-line)))))
X      (error "No messages are marked for deletion."))))
SHAR_EOF
chmod 0664 vm-delete.el || echo "restore of vm-delete.el fails"
echo "x - extracting vm-digest.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > vm-digest.el &&
X;;; Support code for RFC934 digests
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-rfc934-char-stuff-region (start end)
X  (setq end (vm-marker end))
X  (save-excursion
X    (goto-char start)
X    (while (and (< (point) end) (re-search-forward "^-" end t))
X      (replace-match "- -" t t)))
X  (set-marker end nil))
X
X(defun vm-rfc934-char-unstuff-region (start end)
X  (setq end (vm-marker end))
X  (save-excursion
X    (goto-char start)
X    (while (and (< (point) end) (re-search-forward "^- "  end t))
X      (replace-match "" t t)
X      (forward-char)))
X  (set-marker end nil))
X
X(defun vm-digestify-region (start end)
X  (setq end (vm-marker end))
X  (let ((separator-regexp (if (eq vm-folder-type 'mmdf)
X			      "\n+\001\001\001\001\n\001\001\001\001"
X			    "\n+\nFrom .*")))
X    (save-excursion
X      (vm-rfc934-char-stuff-region start end)
X      (goto-char start)
X      (insert-before-markers "------- Start of digest -------\n")
X      (delete-region (point) (progn (forward-line) (point)))
X      (while (re-search-forward separator-regexp end t)
X	(replace-match "\n\n------------------------------\n" t nil))
X      (goto-char end)
X      (if (eq vm-folder-type 'mmdf)
X	  (delete-region (point) (progn (forward-line -1) (point))))
X      (insert-before-markers "------- End of digest -------\n")))
X  (set-marker end nil))
X
X(defun vm-burst-digest ()
X  "Burst the current message (a digest) into its individual messages.
XThe digest's messages are assimilated into the folder as new mail would be,
Xe.g. message grouping takes place and if you're not reading a message
Xyou will be moved to the first new or unread message."
X  (interactive)
X  (vm-follow-summary-cursor)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (let ((inhibit-quit t) start end reg-start leader trailer
X	(reg-end (vm-marker nil))
X	(text-start (vm-marker nil))
X	(buffer-read-only)
X	(old-buffer-modified-p (buffer-modified-p))
X	(m (car vm-message-pointer)))
X    (save-excursion
X      (vm-save-restriction
X       (condition-case ()
X	   (progn
X	     (widen)
X	     (goto-char (point-max))
X	     (setq start (point))
X	     (insert-buffer-substring (current-buffer)
X				      (vm-text-of (car vm-message-pointer))
X				      (vm-text-end-of
X				       (car vm-message-pointer)))
X	     (if (not
X		  (re-search-backward "\\(^-[^ ].*\n+\\|^-\n+\\)+" start t))
X		 (error "final EB not found")
X	       (setq end (point-marker))
X	       ;; Reverse searchs are odd.  The above expression simply
X	       ;; will not match  more than one message separator despite
X	       ;; the "1 or more" directive at the end.
X	       ;; This will have to suffice.
X	       (while
X		   (and
X		    (save-excursion
X		      (re-search-backward "\\(^-[^ ].*\n+\\|^-\n+\\)+" start t)
X		      (= end (match-end 0))))
X		 (set-marker end (match-beginning 0))
X		 (goto-char end))
X	       (skip-chars-backward "\n")
X	       (set-marker end (point))
X	       (delete-region end (point-max)))
X	     (goto-char start)
X	     (if (not (re-search-forward "^-[^ ]" end t))
X		 (error "start EB not found")
X	       (delete-region start (match-beginning 0)))
X	     ;; Concoct suitable separator strings for the future messages.
X	     (if (eq vm-folder-type 'mmdf)
X		 (setq leader "\001\001\001\001\n"
X		       trailer "\n\001\001\001\001\n")
X	       (setq leader (concat "From " (vm-from-of m) " "
X				    (current-time-string) "\n")
X		     trailer "\n\n"))
X	     (goto-char start)
X	     (while (re-search-forward
X		     "\\(\\(\n+\\)\\|\\(^\\)\\)\\(-[^ ].*\n+\\|-\n+\\)+"
X		     end 0)
X	       ;; delete EB
X	       (replace-match "" t t)
X	       ;; stuff separator
X	       (if (match-beginning 2)
X		   (insert trailer))
X	       (insert leader)
X	       ;; Delete attribute headers so message will appear
X	       ;; brand new to the user
X	       (setq reg-start (point))
X	       (save-excursion
X		 (search-forward "\n\n" nil 0)
X		 (set-marker text-start (point)))
X	       (if (re-search-forward vm-attributes-header-regexp text-start t)
X		   (delete-region (match-beginning 0) (match-end 0)))
X	       (if vm-berkeley-mail-compatibility
X		   (progn
X		     (goto-char reg-start)
X		     (if (re-search-forward vm-berkeley-mail-status-header-regexp
X					    text-start t)
X			 (delete-region (match-beginning 0) (match-end 0)))))
X	       ;; find end of message separator and unstuff the message
X	       (goto-char reg-start)
X	       (set-marker reg-end (if (re-search-forward "\n+-[^ ]" end 0)
X				       (match-beginning 0)
X				     (point)))
X	       (vm-rfc934-char-unstuff-region reg-start reg-end)
X	       (goto-char reg-end))
X	     (goto-char end)
X	     (insert trailer)
X	     (set-marker end nil)
X	     (set-marker reg-end nil)
X	     (vm-clear-modification-flag-undos))
X	 (error (and start (delete-region start (point-max)))
X		(set-buffer-modified-p old-buffer-modified-p)
X		(error "Malformed digest")))))
X    (if (vm-assimilate-new-messages)
X	(progn
X	  (vm-emit-totals-blurb)
X	  ;; If there's a current grouping, then the summary has already
X	  ;; been redone in vm-group-messages.
X	  (if (and vm-summary-buffer (not vm-current-grouping))
X	      (progn
X		(vm-do-summary)
X		(vm-emit-totals-blurb)))
X	  (vm-thoughtfully-select-message)
X	  (if vm-summary-buffer
X	      (vm-set-summary-pointer (car vm-message-pointer)))))))
SHAR_EOF
chmod 0664 vm-digest.el || echo "restore of vm-digest.el fails"
echo "x - extracting vm-group.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > vm-group.el &&
X;;; Commands to rearrange (group) message presentation
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-group-by (group-function)
X  (let (start end end-prev mp mp-prev)
X    (setq start vm-message-list)
X    (while start
X      (setq end (cdr start)
X	    end-prev start
X	    mp end
X	    mp-prev start)
X      (while mp
X	(if (funcall group-function (car start) (car mp))
X	    (if (eq end mp)
X		(setq end-prev end end (cdr end)
X		      mp-prev mp mp (cdr mp))
X	      (setcdr mp-prev (cdr mp))
X	      (setcdr end-prev mp)
X	      (setcdr mp end)
X	      (setq end-prev (cdr end-prev)
X		    mp (cdr mp)))
X	  (setq mp-prev mp mp (cdr mp))))
X      (setq start end))))
X
X(defconst vm-group-by-subject-closure (cons t t))
X
X(defun vm-group-by-subject (m1 m2)
X  (let ((subject (vm-su-subject m1)))
X    (if (eq subject (car vm-group-by-subject-closure))
X	(setq subject (cdr vm-group-by-subject-closure))
X      (setcar vm-group-by-subject-closure subject)
X      (if (string-match "^\\(re: *\\)+" subject)
X	  (setq subject (substring subject (match-end 0))))
X      (setq subject (concat "^\\(re: *\\)*"
X			    (regexp-quote subject)
X			    " *$"))
X      (setcdr vm-group-by-subject-closure subject))
X    (string-match subject (vm-su-subject m2))))
X
X(defun vm-group-by-author (m1 m2)
X  (string= (vm-full-name-of m1) (vm-full-name-of m2)))
X
X(defun vm-group-by-date-sent (m1 m2)
X  (and (string= (vm-monthday-of m1) (vm-monthday-of m2))
X       (string= (vm-month-of m1) (vm-month-of m2))
X       (string= (vm-year-of m1) (vm-year-of m2))))
X
X(defun vm-revert-to-arrival-time-grouping ()
X  (let ((curr (car vm-message-pointer))
X	(last (car vm-last-message-pointer)))
X    (setq vm-message-list
X	  (sort vm-message-list
X		(function
X		 (lambda (p q) (< (vm-start-of p) (vm-start-of q))))))
X    (cond (curr
X	   (setq vm-message-pointer vm-message-list)
X	   (while (not (eq (car vm-message-pointer) curr))
X	     (setq vm-message-pointer (cdr vm-message-pointer)))))
X    (cond (last
X	   (setq vm-last-message-pointer vm-message-list)
X	   (while (not (eq (car vm-last-message-pointer) last))
X	     (setq vm-last-message-pointer (cdr vm-last-message-pointer)))))))
X
X(defun vm-group-messages (grouping)
X  "Group messages by the argument GROUPING.
XInteractively this argument is prompted for in the minibuffer,
Xwith completion."
X  (interactive
X   (list 
X    (completing-read
X     (format "Group messages by (default %s): "
X	     (or vm-group-by "arrival-time"))
X     vm-supported-groupings-alist 'identity t)))
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (if (equal grouping "")
X      (setq grouping vm-group-by))
X  (cond ((and grouping (not (stringp grouping)))
X	 (error "Unsupported grouping: %s" grouping))
X	((equal grouping "arrival-time")
X	 (setq grouping nil)))
X  (if grouping
X      (let ((group-function (intern (concat "vm-group-by-" grouping))))
X	(if (not (fboundp group-function))
X	    (error "Unsupported grouping: %s" grouping))
X	(vm-revert-to-arrival-time-grouping)
X	(message "Grouping messages by %s..." grouping)
X	(vm-group-by group-function)
X	(message "Grouping messages by %s... done" grouping)
X	(setq vm-current-grouping grouping)
X	(vm-number-messages))
X    (vm-revert-to-arrival-time-grouping)
X    (setq vm-current-grouping grouping)
X    (vm-number-messages)
X    (if (interactive-p)
X	(message "Reverted to arrival time grouping")))
X  (if vm-summary-buffer
X      (vm-do-summary))
X  (if vm-message-pointer
X      (progn
X	(vm-update-summary-and-mode-line)
X	(vm-set-summary-pointer (car vm-message-pointer)))))
SHAR_EOF
chmod 0664 vm-group.el || echo "restore of vm-group.el fails"
echo "x - extracting vm-license.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > vm-license.el &&
X;;; Code to show VM's warranty and copying restrictions
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(defconst vm-license-buffer-name "*GNU General Public License*")
X
X(defconst vm-license-string
X"		    GNU GENERAL PUBLIC LICENSE
X		     Version 1, February 1989
X
X Copyright (C) 1989 Free Software Foundation, Inc.
X                    675 Mass Ave, Cambridge, MA 02139, USA
X Everyone is permitted to copy and distribute verbatim copies
X of this license document, but changing it is not allowed.
X
X			    Preamble
X
X  The license agreements of most software companies try to keep users
Xat the mercy of those companies.  By contrast, our General Public
XLicense is intended to guarantee your freedom to share and change free
Xsoftware--to make sure the software is free for all its users.  The
XGeneral Public License applies to the Free Software Foundation's
Xsoftware and to any other program whose authors commit to using it.
XYou can use it for your programs, too.
X
X  When we speak of free software, we are referring to freedom, not
Xprice.  Specifically, the General Public License is designed to make
Xsure that you have the freedom to give away or sell copies of free
Xsoftware, that you receive source code or can get it if you want it,
Xthat you can change the software or use pieces of it in new free
Xprograms; and that you know you can do these things.
X
X  To protect your rights, we need to make restrictions that forbid
Xanyone to deny you these rights or to ask you to surrender the rights.
XThese restrictions translate to certain responsibilities for you if you
Xdistribute copies of the software, or if you modify it.
X
X  For example, if you distribute copies of a such a program, whether
Xgratis or for a fee, you must give the recipients all the rights that
Xyou have.  You must make sure that they, too, receive or can get the
Xsource code.  And you must tell them their rights.
X
X  We protect your rights with two steps: (1) copyright the software, and
X(2) offer you this license which gives you legal permission to copy,
Xdistribute and/or modify the software.
X
X  Also, for each author's protection and ours, we want to make certain
Xthat everyone understands that there is no warranty for this free
Xsoftware.  If the software is modified by someone else and passed on, we
Xwant its recipients to know that what they have is not the original, so
Xthat any problems introduced by others will not reflect on the original
Xauthors' reputations.
X
X  The precise terms and conditions for copying, distribution and
Xmodification follow.
X
X		    GNU GENERAL PUBLIC LICENSE
X   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
X
X  0. This License Agreement applies to any program or other work which
Xcontains a notice placed by the copyright holder saying it may be
Xdistributed under the terms of this General Public License.  The
X\"Program\", below, refers to any such program or work, and a \"work based
Xon the Program\" means either the Program or any work containing the
XProgram or a portion of it, either verbatim or with modifications.  Each
Xlicensee is addressed as \"you\".
X
X  1. You may copy and distribute verbatim copies of the Program's source
Xcode as you receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy an appropriate copyright notice and
Xdisclaimer of warranty; keep intact all the notices that refer to this
XGeneral Public License and to the absence of any warranty; and give any
Xother recipients of the Program a copy of this General Public License
Xalong with the Program.  You may charge a fee for the physical act of
Xtransferring a copy.
X
X  2. You may modify your copy or copies of the Program or any portion of
Xit, and copy and distribute such modifications under the terms of Paragraph
X1 above, provided that you also do the following:
X
X    a) cause the modified files to carry prominent notices stating that
X    you changed the files and the date of any change; and
X
X    b) cause the whole of any work that you distribute or publish, that
X    in whole or in part contains the Program or any part thereof, either
X    with or without modifications, to be licensed at no charge to all
X    third parties under the terms of this General Public License (except
X    that you may choose to grant warranty protection to some or all
X    third parties, at your option).
X
X    c) If the modified program normally reads commands interactively when
X    run, you must cause it, when started running for such interactive use
X    in the simplest and most usual way, to print or display an
X    announcement including an appropriate copyright notice and a notice
X    that there is no warranty (or else, saying that you provide a
X    warranty) and that users may redistribute the program under these
X    conditions, and telling the user how to view a copy of this General
X    Public License.
X
X    d) You may charge a fee for the physical act of transferring a
X    copy, and you may at your option offer warranty protection in
X    exchange for a fee.
X
XMere aggregation of another independent work with the Program (or its
Xderivative) on a volume of a storage or distribution medium does not bring
Xthe other work under the scope of these terms.
X
X  3. You may copy and distribute the Program (or a portion or derivative of
Xit, under Paragraph 2) in object code or executable form under the terms of
XParagraphs 1 and 2 above provided that you also do one of the following:
X
X    a) accompany it with the complete corresponding machine-readable
X    source code, which must be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    b) accompany it with a written offer, valid for at least three
X    years, to give any third party free (except for a nominal charge
X    for the cost of distribution) a complete machine-readable copy of the
X    corresponding source code, to be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    c) accompany it with the information you received as to where the
X    corresponding source code may be obtained.  (This alternative is
X    allowed only for noncommercial distribution and only if you
X    received the program in object code or executable form alone.)
X
XSource code for a work means the preferred form of the work for making
Xmodifications to it.  For an executable file, complete source code means
Xall the source code for all modules it contains; but, as a special
Xexception, it need not include source code for modules which are standard
Xlibraries that accompany the operating system on which the executable
Xfile runs, or for standard header files or definitions files that
Xaccompany that operating system.
X
X  4. You may not copy, modify, sublicense, distribute or transfer the
XProgram except as expressly provided under this General Public License.
XAny attempt otherwise to copy, modify, sublicense, distribute or transfer
Xthe Program is void, and will automatically terminate your rights to use
Xthe Program under this License.  However, parties who have received
Xcopies, or rights to use copies, from you under this General Public
XLicense will not have their licenses terminated so long as such parties
Xremain in full compliance.
X
X  5. By copying, distributing or modifying the Program (or any work based
Xon the Program) you indicate your acceptance of this license to do so,
Xand all its terms and conditions.
X
X  6. Each time you redistribute the Program (or any work based on the
XProgram), the recipient automatically receives a license from the original
Xlicensor to copy, distribute or modify the Program subject to these
Xterms and conditions.  You may not impose any further restrictions on the
Xrecipients' exercise of the rights granted herein.
X
X  7. The Free Software Foundation may publish revised and/or new versions
Xof the General Public License from time to time.  Such new versions will
Xbe similar in spirit to the present version, but may differ in detail to
Xaddress new problems or concerns.
X
XEach version is given a distinguishing version number.  If the Program
Xspecifies a version number of the license which applies to it and \"any
Xlater version\", you have the option of following the terms and conditions
Xeither of that version or of any later version published by the Free
XSoftware Foundation.  If the Program does not specify a version number of
Xthe license, you may choose any version ever published by the Free Software
XFoundation.
X
X  8. If you wish to incorporate parts of the Program into other free
Xprograms whose distribution conditions are different, write to the author
Xto ask for permission.  For software which is copyrighted by the Free
XSoftware Foundation, write to the Free Software Foundation; we sometimes
Xmake exceptions for this.  Our decision will be guided by the two goals
Xof preserving the free status of all derivatives of our free software and
Xof promoting the sharing and reuse of software generally.
X
X			    NO WARRANTY
X
X  9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
XFOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
XOTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
XPROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
XOR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
XMERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
XTO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
XPROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
XREPAIR OR CORRECTION.
X
X  10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
XWILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
XREDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
XINCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
XOUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
XTO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
XYOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
XPROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
XPOSSIBILITY OF SUCH DAMAGES.
X
X		     END OF TERMS AND CONDITIONS
X")
X
X(defun vm-show-copying-restrictions (&optional warranty)
X  "Display the GNU General Public License."
X  (interactive)
X  (if (get-buffer vm-license-buffer-name)
X      (progn
X	(if (get-buffer-window (get-buffer vm-license-buffer-name))
X	    (select-window (get-buffer-window
X			    (get-buffer vm-license-buffer-name)))
X	  (switch-to-buffer vm-license-buffer-name t))
X	(goto-char (point-min))
X	(if warranty
X	    (progn
X	      (search-forward "NO WARRANTY\n" nil t)
X	      (forward-line -1)
X	      (set-window-start (selected-window) (point)))))
X    (save-excursion
X      (switch-to-buffer (get-buffer-create vm-license-buffer-name) t)
X      (insert vm-license-string)
X      (goto-char (point-min))
X      (if warranty
X	  (progn
X	    (search-forward "NO WARRANTY\n" nil t)
X	    (forward-line -1)
X	    (set-window-start (selected-window) (point))))
X      (set-buffer-modified-p nil))
X    ;; This goes into a recursive edit!
X    (view-buffer vm-license-buffer-name)
X    (condition-case () (kill-buffer vm-license-buffer-name) (error nil))))
X
X(defun vm-show-no-warranty ()
X  "Display \"NO WARRANTY\" section of the GNU General Public License."
X  (interactive)
X  (vm-show-copying-restrictions t))
SHAR_EOF
chmod 0664 vm-license.el || echo "restore of vm-license.el fails"
echo "x - extracting vm-reply.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > vm-reply.el &&
X;;; Mailing, forwarding, and replying commands for 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-do-reply (to-all include-text)
X  (vm-follow-summary-cursor)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (save-restriction
X    (widen)
X    (let ((mail-buffer (current-buffer))
X	  (text-start (vm-text-of (car vm-message-pointer)))
X	  (text-end (vm-text-end-of (car vm-message-pointer)))
X	  (mp vm-message-pointer)
X	  to cc subject message-id tmp)
X      (cond ((setq to (vm-get-header-contents (car mp) "Reply-To")))
X	    ((setq to (vm-get-header-contents (car mp) "From")))
X	    ((setq to (vm-grok-From_-author (car mp))))
X	    (t (error "Cannot find a From: or Reply-To: header in message")))
X      (setq subject (vm-get-header-contents (car mp) "Subject")
X	    message-id (and vm-in-reply-to-format
X			    (vm-sprintf 'vm-in-reply-to-format (car mp))))
X      (if to-all
X	  (progn
X	    (setq cc (vm-get-header-contents (car mp) "To"))
X	    (setq tmp (vm-get-header-contents (car mp) "Cc"))
X	    (if tmp
X		(if cc
X		    (setq cc (concat cc ",\n\t" tmp))
X		  (setq cc tmp)))))
X      (if vm-strip-reply-headers
X	  (let ((mail-use-rfc822 t))
X	    (require 'mail-utils)
X	    (and to (setq to (mail-strip-quoted-names to)))
X	    (and cc (setq to (mail-strip-quoted-names cc)))))
X      (if (mail nil to subject message-id cc)
X	  (progn
X	    (use-local-map (copy-keymap (current-local-map)))
X	    (local-set-key "\C-c\C-y" 'vm-yank-message)
X	    (local-set-key "\C-c\C-s" 'vm-mail-send)
X	    (local-set-key "\C-c\C-c" 'vm-mail-send-and-exit)
X	    (local-set-key "\C-c\C-v" vm-mode-map)
X	    (setq vm-mail-buffer mail-buffer
X		  vm-message-pointer mp)
X	    (cond (include-text
X		   (goto-char (point-max))
X		   (insert-buffer-substring mail-buffer text-start text-end)
X		   (goto-char (- (point) (- text-end text-start)))
X		   (save-excursion
X		     (if vm-included-text-attribution-format
X			 (insert (vm-sprintf
X				  'vm-included-text-attribution-format
X				  (car mp))))
X		     (while (and (re-search-forward "^" nil t) (not (eobp)))
X		       (replace-match vm-included-text-prefix t t))))))))))
X
X(defun vm-yank-message (n prefix)
X  "Yank message number N into the current buffer at point.
X
XThis command is meant to be used in VM created *mail* buffers; the
Xyanked message comes from the mail buffer containing the message you
Xare replying to, forwarding, or invoked VM's mail command from.
X
XAll message headers are yanked along with the text.  Point is left
Xbefore the inserted text, the mark after.  Any hook functions bound to
Xmail-yank-hooks are run, aftert inserting the text and setting point
Xand mark.
X
XPrefix arg means to ignore mail-yank-hooks, don't set the mark, prepend the
Xvalue of vm-included-text-prefix to every yanked line, and don't yank any
Xheaders other than those specified in vm-visible-headers."
X  (interactive
X   (list
X    (let (default (result 0) prompt)
X      (save-excursion
X	(if (and vm-mail-buffer (buffer-name vm-mail-buffer))
X	    (set-buffer vm-mail-buffer))
X	(setq default (and vm-message-pointer
X			   (vm-number-of (car vm-message-pointer)))
X	      prompt (if default
X			 (format "Yank message number: (default %s) "
X				 default)
X		       "Yank message number: "))
X	(while (zerop result)
X	  (setq result (read-string prompt))
X	  (and (string= result "") default (setq result default))
X	  (setq result (string-to-int result))))
X      result )
X    current-prefix-arg ))
X  (if (not (bufferp vm-mail-buffer))
X      (error "This is not a VM *mail* buffer."))
X  (if (null (buffer-name vm-mail-buffer))
X      (error "The mail buffer containing message %d has been killed." n))
X  (let ((b (current-buffer)) (start (point)) mp end)
X    (save-restriction
X      (widen)
X      (save-excursion
X	(set-buffer vm-mail-buffer)
X	(setq mp (nthcdr (1- n) vm-message-list))
X	(if (null mp)
X	    (error "No such message."))
X	(save-restriction
X	  (widen)
X	  (append-to-buffer b (if prefix
X				  (vm-vheaders-of (car mp))
X				(vm-start-of (car mp)))
X			    (vm-text-end-of (car mp)))
X	  (setq end (vm-marker (+ start (- (vm-text-end-of (car mp))
X					   (if prefix
X					       (vm-vheaders-of (car mp))
X					     (vm-start-of (car mp))))) b))))
X      (if prefix
X	  (save-excursion
X	    (while (and (< (point) end) (re-search-forward "^" end t))
X	      (replace-match vm-included-text-prefix t t)
X	      (forward-line)))
X	;; Delete UNIX From or MMDF ^A^A^A^A line
X	(delete-region (point) (progn (forward-line) (point)))
X	(push-mark end)
X	(run-hooks 'mail-yank-hooks)))))
X
X(defun vm-mail-send-and-exit (arg)
X  "Just like mail-send-and-exit except that VM marks the appropriate message
Xas having been replied to, if appropriate."
X  (interactive "P")
X  (let ((reply-buf (current-buffer)))
X    (mail-send-and-exit arg)
X    (save-excursion
X      (set-buffer reply-buf)
X      (vm-mark-replied))))
X
X(defun vm-mail-send ()
X  "Just like mail-send except that VM marks the appropriate message
Xas having been replied to, if appropriate."
X  (interactive)
X  (mail-send)
X  (vm-mark-replied))
X
X(defun vm-mark-replied ()
X  (if (and (bufferp vm-mail-buffer) (buffer-name vm-mail-buffer))
X      (save-excursion
X	(let ((mp vm-message-pointer))
X	  (set-buffer vm-mail-buffer)
X	  (cond ((and (memq (car mp) vm-message-list)
X		      (null (vm-replied-flag (car mp))))
X		 (vm-set-replied-flag (car mp) t)
X		 (vm-update-summary-and-mode-line)))))))
X
X(defun vm-reply ()
X  "Reply to the sender of the current message.
XYou will be deposited into a standard Emacs *mail* buffer to compose and
Xsend your message.  See the documentation for the function `mail' for
Xmore info.
X
XNote that the normal binding of C-c C-y in the *mail* buffer is
Xautomatically changed to vm-yank-message during a reply.  This allows
Xyou to yank any message from the current folder into a reply.
X
XNormal VM commands may be accessed in the reply buffer by prefixing them
Xwith C-c C-v."
X  (interactive)
X  (vm-do-reply nil nil))
X
X(defun vm-reply-include-text ()
X  "Reply to the sender (only) of the current message and include text
Xfrom the message.  See the documentation for function vm-reply for details."
X  (interactive)
X  (vm-do-reply nil t))
X
X(defun vm-followup ()
X  "Reply to all recipients of the current message.
XSee the documentation for the function vm-reply for details."
X  (interactive)
X  (vm-do-reply t nil))
X
X(defun vm-followup-include-text ()
X  "Reply to all recipients of the current message and include text from
Xthe message.  See the documentation for the function vm-reply for details."
X  (interactive)
X  (vm-do-reply t t))
X
X(defun vm-forward-message ()
X  "Forward the current message to one or more third parties.
XYou will be placed in a *mail* buffer as is usual with replies, but you
Xmust fill in the To: and Subject: headers manually." 
X  (interactive)
X  (vm-follow-summary-cursor)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (let ((b (current-buffer))
X	(m (car vm-message-pointer))
X	(start))
X    (save-restriction
X      (widen)
X      (cond ((mail nil nil (and vm-forwarding-subject-format
X				(vm-sprintf 'vm-forwarding-subject-format m)))
X	     (use-local-map (copy-keymap (current-local-map)))
X	     (local-set-key "\C-c\C-y" 'vm-yank-message)
X	     (local-set-key "\C-c\C-v" vm-mode-map)
X	     (setq vm-mail-buffer b)
X	     (goto-char (point-max))
X	     (insert "------- Start of forwarded message -------\n")
X	     (setq start (point))
X	     (insert-buffer-substring b
X				      (save-excursion
X					(set-buffer b)
X					(goto-char (vm-start-of m))
X					(forward-line 1)
X					(point))
X				      (vm-text-end-of m))
X	     (if vm-rfc934-forwarding
X		 (vm-rfc934-char-stuff-region start (point)))
X	     (insert "------- End of forwarded message -------\n")
X	     (goto-char (point-min))
X	     (end-of-line))))))
X
X(defun vm-mail ()
X  "Send a mail message from within VM."
X  (interactive)
X  (vm-follow-summary-cursor)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (let ((mail-buffer (current-buffer)))
X    (cond ((mail)
X	   (use-local-map (copy-keymap (current-local-map)))
X	   (local-set-key "\C-c\C-y" 'vm-yank-message)
X	   (local-set-key "\C-c\C-v" vm-mode-map)
X	   (setq vm-mail-buffer mail-buffer)))))
X
X(defun vm-send-digest ()
X  "Send a digest of all messages in the current folder to recipients.
XYou will be placed in a *mail* buffer as is usual with replies, but you
Xmust fill in the To: and Subject: headers manually." 
X  (interactive)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (let ((b (current-buffer))
X	(start))
X    (save-restriction
X      (widen)
X      (cond
X       ((mail)
X	(use-local-map (copy-keymap (current-local-map)))
X	(local-set-key "\C-c\C-y" 'vm-yank-message)
X	(local-set-key "\C-c\C-v" vm-mode-map)
X	(setq vm-mail-buffer b)
X	(goto-char (point-max))
X	(setq start (point))
X	(insert-buffer-substring b)
X	(vm-digestify-region start (point))
X	(goto-char (point-min))
X	(end-of-line))))))
SHAR_EOF
chmod 0664 vm-reply.el || echo "restore of vm-reply.el fails"
echo "x - extracting vm-save.el (Text)"
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;; (match-data) returns the match data as MARKERS, often corrupting
X;; it in the process due to buffer narrowing, and the fact that buffers are
X;; indexed from 1 while strings are indexed from 0. :-(
X(defun vm-match-data ()
X  (delq nil
X	(apply 'nconc
X	       (mapcar (function
X			(lambda (n) (list (match-beginning n) (match-end n))))
X		       '(0 1 2 3 4 5 6 7 8 9)))))
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		    (let* ((match-data (vm-match-data))
X			   (buf (get-buffer-create " *VM scratch*")))
X		      ;; Set up a buffer that matches our cached
X		      ;; match data.
X		      (save-excursion
X			(set-buffer buf)
X			(widen)
X			(erase-buffer)
X			(insert header)
X			;; It appears that get-buffer-create clobbers the
X			;; match-data.
X			;;
X			;; The match data is off by one because we matched
X			;; a string and Emacs indexes strings from 0 and
X			;; buffers from 1.
X			;;
X			;; Also store-match-data only accepts MARKERS!!
X			;; AUGHGHGH!!
X			(store-match-data
X			 (mapcar (function (lambda (n) (vm-marker n)))
X				 (mapcar '1+ match-data)))
X			(throw 'match (eval (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-folder-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    ;; vm-last-save-folder is tucked away here since archives shouldn't affect
X    ;; its value.
X    (let ((vm-message-pointer vm-message-list)
X	  (vm-last-save-folder vm-last-save-folder)
X	  (vm-move-after-deleting))
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)
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;; unexpanded-folder is an old fashioned local variable.
X(defun vm-save-message (folder &optional count unexpanded-folder)
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    (progn
X      (vm-follow-summary-cursor)
X      (let ((default (save-excursion
X		       (if vm-mail-buffer
X			   (set-buffer vm-mail-buffer))
X		       (or (vm-auto-select-folder vm-message-pointer)
X			   vm-last-save-folder)))
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  (setq unexpanded-folder folder)
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (or count (setq count 1))
X  (if (not (eq vm-circular-folders t))
X      (vm-check-count count))
X  ;; Expand the filename forcing relative paths to resolve
X  ;; into the folder directory.
X  (let ((default-directory (or vm-folder-directory default-directory)))
X    (setq folder (expand-file-name folder)))
X  ;; Confirm new folders, if the user requested this.
X  (if (and vm-confirm-new-folders (interactive-p) (not (file-exists-p folder))
X	   (not (y-or-n-p (format "%s does not exist, save there anyway? "
X				  folder))))
X      (error "Save aborted"))
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	(counter)
X	(count (vm-abs count)))
X    (setq counter 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 counter))
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		 (vm-increment vm-messages-not-on-disk)
X		 (vm-clear-modification-flag-undos))))))
X	(if (null (vm-filed-flag (car vm-message-pointer)))
X	    (vm-set-filed-flag (car vm-message-pointer) t))
X	(vm-decrement counter)
X	(if (not (zerop counter))
X	    (vm-move-message-pointer direction))))
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 there's a current grouping, then the summary
X		    ;; has already been redone in vm-group-messages.
X		    (if (and vm-summary-buffer (not vm-current-grouping))
X			(progn
X			  (vm-do-summary)
X			  (if (get-buffer-window vm-summary-buffer)
X			      (vm-set-summary-pointer
X			       (car vm-message-pointer)))))))))
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  (setq vm-last-save-folder unexpanded-folder)
X  (if vm-delete-after-saving
X      (vm-delete-message count))
X  (vm-update-summary-and-mode-line))
X
X(defun vm-save-message-sans-headers (file &optional count)
X  "Save the current message to a file minus its header section.
XPrefix arg COUNT means save the next COUNT messages.  A negative COUNT means
Xsave the previous COUNT.  If the file 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   (progn
X     (vm-follow-summary-cursor)
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-folder-empty)
X  (or count (setq count 1))
X  (if (not (eq vm-circular-folders t))
X      (vm-check-count count))
X  (setq file (expand-file-name file))
X  (if (not vm-visit-when-saving)
X      ;; Check and see if we are currently visiting the file
X      ;; that the user wants to save to.
X      (let ((blist (buffer-list)))
X	(while blist
X	  (if (equal (buffer-file-name (car blist)) file)
X	      (error "File %s is being visited, cannot save." file))
X	  (setq blist (cdr blist)))))
X  (let ((vm-message-pointer vm-message-pointer)
X	(direction (if (> count 0) 'forward 'backward))
X	(file-buffer)
X	(mail-buffer (current-buffer))
X	(counter)
X	(count (vm-abs count)))
X    (setq counter count)
X    (if vm-visit-when-saving
X	(progn
X	  (setq file-buffer (find-file-noselect file))
X	  (if (eq file-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 counter))
X	(if (not vm-visit-when-saving)
X	    (write-region (vm-text-of (car vm-message-pointer))
X			  (vm-text-end-of (car vm-message-pointer))
X			  file t 'quiet)
X	  (let ((start (vm-text-of (car vm-message-pointer)))
X		(end (vm-text-end-of (car vm-message-pointer))))
X	    (save-excursion
X	      (set-buffer file-buffer)
X	      (save-excursion
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-decrement counter)
X	(if (not (zerop counter))
X	    (vm-move-message-pointer direction))))
X    (if vm-visit-when-saving
X	(message "Message%s written to buffer %s" (if (/= 1 count) "s" "")
X		 (buffer-name file-buffer))
X      (message "Message%s written to %s" (if (/= 1 count) "s" "") file)))
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
X   (progn
X     (vm-follow-summary-cursor)
X     (list (read-string "Pipe message to command: " vm-last-pipe-command)
X	   current-prefix-arg)))
X  (if vm-mail-buffer
X      (set-buffer vm-mail-buffer))
X  (vm-error-if-folder-empty)
X  (setq vm-last-pipe-command command)
X  (let ((buffer (get-buffer-create "*Shell Command Output*"))
X	(pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))))
X    (save-excursion (set-buffer buffer) (erase-buffer))
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-text-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      (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))))
X	(call-process-region (point-min) (point-max)
X			     (or shell-file-name "sh")
X			     nil buffer nil "-c" command)))
X    (set-buffer buffer)
X    (if (not (zerop (buffer-size)))
X	(display-buffer buffer))))
SHAR_EOF
chmod 0664 vm-save.el || echo "restore of vm-save.el fails"
echo "x - extracting vm-search.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > vm-search.el &&
X;; Incremental search through a mail folder
X;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X
X;; Adapted for the VM mail reader, Kyle Jones, May 1989
X
X
X(require 'vm)
X
X;; This function does all the work of incremental search.
X;; The functions attached to ^R and ^S are trivial,
X;; merely calling this one, but they are always loaded by default
X;; whereas this file can optionally be autoloadable.
X;; This is the only entry point in this file.
X
X(defun vm-isearch (forward &optional regexp)
X  (let ((search-string "")
X	(search-message "")
X	(cmds nil)
X	(success t)
X	(wrapped nil)
X	(barrier (point))
X	adjusted
X	(invalid-regexp nil)
X	(slow-terminal-mode (and (<= (baud-rate) search-slow-speed)
X				 (> (window-height)
X				    (* 4 search-slow-window-lines))))
X	(other-end nil)    ;Start of last match if fwd, end if backwd.
X	(small-window nil)		;if t, using a small window
X	(found-point nil)		;to restore point from a small window
X	;; This is the window-start value found by the search.
X	(found-start nil)
X	(opoint (point))
X	(vm-ml-attributes-string vm-ml-attributes-string)
X	(vm-ml-message-number vm-ml-message-number)
X	(vm-message-pointer vm-message-pointer)
X	(inhibit-quit t))  ;Prevent ^G from quitting immediately.
X    (vm-isearch-push-state)
X    (save-window-excursion
X     (catch 'search-done
X       (while t
X	 (or (>= unread-command-char 0)
X	     (progn
X	       (or (input-pending-p)
X		   (vm-isearch-message))
X	       (if (and slow-terminal-mode
X			(not (or small-window (pos-visible-in-window-p))))
X		   (progn
X		     (setq small-window t)
X		     (setq found-point (point))
X		     (move-to-window-line 0)
X		     (let ((window-min-height 1))
X		       (split-window nil (if (< search-slow-window-lines 0)
X					     (1+ (- search-slow-window-lines))
X					   (- (window-height)
X					      (1+ search-slow-window-lines)))))
X		     (if (< search-slow-window-lines 0)
X			 (progn (vertical-motion (- 1 search-slow-window-lines))
X				(set-window-start (next-window) (point))
X				(set-window-hscroll (next-window)
X						    (window-hscroll))
X				(set-window-hscroll (selected-window) 0))
X		       (other-window 1))
X		     (goto-char found-point)))))
X	 (let ((char (if quit-flag
X			 ?\C-g
X		       (read-char))))
X	   (setq quit-flag nil adjusted nil)
X	   ;; Meta character means exit search.
X	   (cond ((and (>= char 128)
X		       search-exit-option)
X		  (setq unread-command-char char)
X		  (throw 'search-done t))
X		 ((eq char search-exit-char)
X		  ;; Esc means exit search normally.
X		  ;; Except, if first thing typed, it means do nonincremental
X		  (if (= 0 (length search-string))
X		      (vm-nonincremental-search forward regexp))
X		  (throw 'search-done t))
X		 ((= char ?\C-g)
X		  ;; ^G means the user tried to quit.
X		  (ding)
X		  (discard-input)
X		  (if success
X		      ;; If search is successful, move back to starting point
X		      ;; and really do quit.
X		      (progn (goto-char opoint)
X			     (signal 'quit nil))
X		    ;; If search is failing, rub out until it is once more
X		    ;;  successful.
X		    (while (not success) (vm-isearch-pop))))
X		 ((or (eq char search-repeat-char)
X		      (eq char search-reverse-char))
X		  (if (eq forward (eq char search-repeat-char))
X		      ;; C-s in forward or C-r in reverse.
X		      (if (equal search-string "")
X			  ;; If search string is empty, use last one.
X			  (setq search-string
X				(if regexp
X				    search-last-regexp search-last-string)
X				search-message
X				(mapconcat 'text-char-description
X					   search-string ""))
X			;; If already have what to search for, repeat it.
X			(or success
X			    (progn (goto-char (if forward (point-min) (point-max)))
X				   (setq wrapped t))))
X		    ;; C-s in reverse or C-r in forward, change direction.
X		    (setq forward (not forward)))
SHAR_EOF
echo "End of part 1"
echo "File vm-search.el is continued in part 2"
echo "2" > s2_seq_.tmp
exit 0