Commits

cvs2hg  committed 1efbee7

fixup commit for tag 'sumo-current'

  • Participants
  • Parent commits caf0a6f
  • Tags sumo-current

Comments (0)

Files changed (132)

+# All versions of Emacs prior to 19.34 for Emacs and
+# prior to 19.14 for XEmacs are unsupported.
+
+# what emacs is called on your system
+EMACS = emacs
+
+# top of the installation
+prefix = /usr/local
+
+# where the Info file should go
+INFODIR = ${prefix}/lib/emacs/info
+
+# where the vm.elc, tapestry.elc, etc. files should go
+LISPDIR = ${prefix}/lib/emacs/site-lisp
+
+# where the toolbar pixmaps should go.
+# vm-toolbar-pixmap-directory must point to the same place.
+# vm-image-directory must point to the same place.
+PIXMAPDIR = ${prefix}/lib/emacs/etc/vm
+
+# where the binaries should be go.
+BINDIR = ${prefix}/bin
+
+############## no user servicable parts beyond this point ###################
+
+# no csh please
+SHELL = /bin/sh
+
+# byte compiler options
+BYTEOPTS = ./vm-byteopts.el
+
+# have to preload the files that contain macro definitions or the
+# byte compiler will compile everything that references them
+# incorrectly.  also preload a file that sets byte compiler options.
+PRELOADS = -l $(BYTEOPTS) -l ./vm-version.el -l ./vm-message.el -l ./vm-macro.el -l ./vm-vars.el  
+
+# compile with noninteractive and relatively clean environment
+BATCHFLAGS = -batch -q -no-site-file
+
+# files that contain key macro definitions.  almost everything
+# depends on them because the byte-compiler inlines macro
+# expansions.  everything also depends on the byte compiler
+# options file since this might do odd things like turn off
+# certain compiler optimizations.
+CORE = vm-message.el vm-macro.el vm-byteopts.el
+
+# vm-version.elc needs to be first in this list, because load time
+# code needs the Emacs/XEmacs MULE/no-MULE feature stuff.
+OBJECTS = \
+    vm-version.elc \
+    vm-crypto.elc \
+    vm-delete.elc vm-digest.elc vm-easymenu.elc vm-edit.elc vm-folder.elc \
+    vm-imap.elc vm-license.elc vm-macro.elc vm-mark.elc vm-menu.elc \
+    vm-message.elc \
+    vm-mime.elc vm-minibuf.elc vm-misc.elc vm-motion.elc \
+    vm-mouse.elc vm-page.elc vm-pop.elc vm-reply.elc \
+    vm-save.elc \
+    vm-search.elc vm-sort.elc vm-summary.elc vm-startup.elc vm-thread.elc \
+    vm-toolbar.elc vm-undo.elc \
+    vm-user.elc vm-vars.elc vm-virtual.elc vm-window.elc
+
+SOURCES = \
+    vm-version.el \
+    vm-crypto.el \
+    vm-delete.el vm-digest.el vm-easymenu.el vm-edit.el vm-folder.el \
+    vm-imap.el vm-license.el vm-macro.el vm-mark.el vm-menu.el vm-message.el \
+    vm-mime.el vm-minibuf.el vm-misc.el vm-motion.el \
+    vm-mouse.el vm-page.el vm-pop.el vm-reply.el vm-save.el \
+    vm-search.el vm-sort.el vm-startup.el vm-summary.el vm-thread.el \
+    vm-toolbar.el vm-undo.el \
+    vm-user.el vm-vars.el vm-virtual.el vm-window.el
+
+UTILS = qp-decode qp-encode base64-decode base64-encode
+
+vm:	vm.elc
+
+vm.elc:	autoload
+
+noautoload:	$(OBJECTS) tapestry.elc
+	@echo "building vm.elc (with all modules included)..."
+	@cat $(OBJECTS) tapestry.elc > vm.elc
+
+autoload:	vm-autoload.elc $(OBJECTS) tapestry.elc
+	@echo "building vm.elc (with all modules set to autoload)..."
+	@echo "(defun vm-its-such-a-cruel-world ()" > vm.el
+	@echo "   (require 'vm-version)" >> vm.el
+	@echo "   (require 'vm-startup)" >> vm.el
+	@echo "   (require 'vm-vars)" >> vm.el
+	@echo "   (require 'vm-autoload))" >> vm.el
+	@echo "(vm-its-such-a-cruel-world)" >> vm.el
+	@echo "(fmakunbound 'vm-its-such-a-cruel-world)" >> vm.el
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm.el
+
+all:	vm.info vm utils
+
+debug:	$(SOURCES) tapestry.el
+	@echo "building vm.elc (uncompiled, no autoloads)..."
+	@cat $(SOURCES) tapestry.el > vm.elc
+
+utils: $(UTILS)
+
+qp-decode: qp-decode.c
+	$(CC) $(CFLAGS) -o qp-decode qp-decode.c
+
+qp-encode: qp-encode.c
+	$(CC) $(CFLAGS) -o qp-encode qp-encode.c
+
+base64-decode: base64-decode.c
+	$(CC) $(CFLAGS) -o base64-decode base64-decode.c
+
+base64-encode: base64-encode.c
+	$(CC) $(CFLAGS) -o base64-encode base64-encode.c
+
+install: all install-info install-el install-vm install-pixmaps install-utils
+
+install-info: vm.info
+	test -d $(INFODIR) || mkdir -p $(INFODIR)
+	cp vm.info vm.info-* $(INFODIR)
+
+install-vm: vm.elc
+	test -d $(LISPDIR) || mkdir -p $(LISPDIR)
+	cp *.elc $(LISPDIR)
+
+install-el:
+	test -d $(LISPDIR) || mkdir -p $(LISPDIR)
+	cp *.el $(LISPDIR)
+
+install-pixmaps:
+	test -d $(PIXMAPDIR) || mkdir -p $(PIXMAPDIR)
+	cp pixmaps/*.x[pb]m $(PIXMAPDIR)
+
+install-utils: $(UTILS)
+	test -d $(BINDIR) || mkdir -p $(BINDIR)
+	cp $(UTILS) $(BINDIR)
+
+clean:
+	rm -f $(UTILS) vm.info vm.info-* vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc
+
+vm.info:	vm.texinfo
+	@echo "making vm.info..."
+	@$(EMACS) $(BATCHFLAGS) -insert vm.texinfo -l texinfmt -f texinfo-format-buffer -f save-buffer
+
+# We use tr -d because Emacs under Cygwin apparently outputs CRLF
+# under Windows.  We remove the CRs.
+# Solaris 8's tr -d '\r' removes r's so we use '\015' instead.
+# the echo command can also emit CRs.
+vm-autoload.elc:	$(SOURCES)
+	@echo scanning sources to build autoload definitions...
+	@$(EMACS) $(BATCHFLAGS) -l ./make-autoloads -f print-autoloads $(SOURCES) | tr -d '\015' > vm-autoload.el
+	@echo "(provide 'vm-autoload)" | tr -d '\015' >> vm-autoload.el
+	@echo compiling vm-autoload.el...
+	@$(EMACS) $(BATCHFLAGS) -l $(BYTEOPTS) -f batch-byte-compile vm-autoload.el
+
+vm-crypto.elc:	vm-crypto.el $(CORE)
+	@echo compiling vm-crypto.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-crypto.el
+
+vm-delete.elc:	vm-delete.el $(CORE)
+	@echo compiling vm-delete.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-delete.el
+
+vm-digest.elc:	vm-digest.el $(CORE)
+	@echo compiling vm-digest.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-digest.el
+
+vm-edit.elc:	vm-edit.el $(CORE)
+	@echo compiling vm-edit.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-edit.el
+
+vm-folder.elc:	vm-folder.el $(CORE)
+	@echo compiling vm-folder.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-folder.el
+
+vm-imap.elc:	vm-imap.el $(CORE)
+	@echo compiling vm-imap.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-imap.el
+
+vm-license.elc:	vm-license.el $(CORE)
+	@echo compiling vm-license.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-license.el
+
+vm-macro.elc:	vm-macro.el $(CORE)
+	@echo compiling vm-macro.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-macro.el
+
+vm-mark.elc:	vm-mark.el $(CORE)
+	@echo compiling vm-mark.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-mark.el
+
+vm-menu.elc:	vm-menu.el vm-easymenu.el $(CORE)
+	@echo compiling vm-menu.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -l ./vm-easymenu.el -f batch-byte-compile vm-menu.el
+
+vm-message.elc:	vm-message.el $(CORE)
+	@echo compiling vm-message.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-message.el
+
+vm-minibuf.elc:	vm-minibuf.el $(CORE)
+	@echo compiling vm-minibuf.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-minibuf.el
+
+vm-mime.elc:	vm-mime.el $(CORE)
+	@echo compiling vm-mime.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-mime.el
+
+vm-misc.elc:	vm-misc.el $(CORE)
+	@echo compiling vm-misc.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-misc.el
+
+vm-mouse.elc:	vm-mouse.el $(CORE)
+	@echo compiling vm-mouse.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-mouse.el
+
+vm-motion.elc:	vm-motion.el $(CORE)
+	@echo compiling vm-motion.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-motion.el
+
+vm-page.elc:	vm-page.el $(CORE)
+	@echo compiling vm-page.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-page.el
+
+vm-pop.elc:	vm-pop.el $(CORE)
+	@echo compiling vm-pop.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-pop.el
+
+vm-reply.elc:	vm-reply.el $(CORE)
+	@echo compiling vm-reply.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-reply.el
+
+vm-save.elc:	vm-save.el $(CORE)
+	@echo compiling vm-save.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-save.el
+
+vm-search.elc:	vm-search.el $(CORE)
+	@echo compiling vm-search.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-search.el
+
+vm-sort.elc:	vm-sort.el $(CORE)
+	@echo compiling vm-sort.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-sort.el
+
+vm-startup.elc:	vm-startup.el $(CORE)
+	@echo compiling vm-startup.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-startup.el
+
+vm-summary.elc:	vm-summary.el $(CORE)
+	@echo compiling vm-summary.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-summary.el
+
+vm-thread.elc:	vm-thread.el $(CORE)
+	@echo compiling vm-thread.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-thread.el
+
+vm-toolbar.elc:	vm-toolbar.el $(CORE)
+	@echo compiling vm-toolbar.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-toolbar.el
+
+vm-undo.elc:	vm-undo.el $(CORE)
+	@echo compiling vm-undo.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-undo.el
+
+vm-user.elc:	vm-user.el $(CORE)
+	@echo compiling vm-user.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-user.el
+
+vm-vars.elc:	vm-vars.el $(CORE)
+	@echo compiling vm-vars.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-vars.el
+
+vm-version.elc:	vm-version.el $(CORE)
+	@echo compiling vm-version.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-version.el
+
+vm-virtual.elc:	vm-virtual.el $(CORE)
+	@echo compiling vm-virtual.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-virtual.el
+
+vm-window.elc:	vm-window.el $(CORE)
+	@echo compiling vm-window.el...
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-window.el
+
+tapestry.elc:	tapestry.el
+	@echo compiling tapestry.el...
+	@$(EMACS) $(BATCHFLAGS) -l $(BYTEOPTS) -f batch-byte-compile tapestry.el
+
+vm-easymenu.elc:	vm-easymenu.el
+	@echo compiling vm-easymenu.el...
+	@$(EMACS) $(BATCHFLAGS) -l $(BYTEOPTS) -f batch-byte-compile vm-easymenu.el

File README.bytecompile

+Kyle sez:
+
+    Rebuild VM with make, always, or there will be trouble.  The
+    compiler has to know about every macro used in a Lisp source
+    file so that they can be expanded.  If the bytecode interpreter
+    encounters a macro at runtime, it will testily bark the exception
+
+    Invalid function: (macro . #<compiled-function (pos &optional buffer) "...(9)" [set-marker (make-marker) pos buffer] 4>)
+
+So, if you must edit and rebuild VM from the installed package, edit
+Makefile-kj and use `make -f Makefile-kj ...'.

File etc/audio_stamp-colorful.xpm

Added
New image

File etc/audio_stamp-simple.xpm

Added
New image

File etc/autofile-dn.xbm

Added
New image

File etc/autofile-dn.xpm

Added
New image

File etc/autofile-up.xbm

Added
New image

File etc/autofile-up.xpm

Added
New image

File etc/autofile-xx.xbm

Added
New image

File etc/compose-dn.xbm

Added
New image

File etc/compose-dn.xpm

Added
New image

File etc/compose-up.xbm

Added
New image

File etc/compose-up.xpm

Added
New image

File etc/compose-xx.xbm

Added
New image

File etc/delete-dn.xbm

Added
New image

File etc/delete-dn.xpm

Added
New image

File etc/delete-up.xbm

Added
New image

File etc/delete-up.xpm

Added
New image

File etc/delete-xx.xbm

Added
New image

File etc/document-colorful.xpm

Added
New image

File etc/document-simple.xpm

Added
New image

File etc/file-dn.xbm

Added
New image

File etc/file-dn.xpm

Added
New image

File etc/file-up.xbm

Added
New image

File etc/file-up.xpm

Added
New image

File etc/file-xx.xbm

Added
New image

File etc/film-colorful.xpm

Added
New image

File etc/film-simple.xpm

Added
New image

File etc/gear-colorful.xpm

Added
New image

File etc/gear-simple.xpm

Added
New image

File etc/getmail-dn.xbm

Added
New image

File etc/getmail-dn.xpm

Added
New image

File etc/getmail-up.xbm

Added
New image

File etc/getmail-up.xpm

Added
New image

File etc/getmail-xx.xbm

Added
New image

File etc/help-dn.xbm

Added
New image

File etc/help-dn.xpm

Added
New image

File etc/help-up.xbm

Added
New image

File etc/help-up.xpm

Added
New image

File etc/help-xx.xbm

Added
New image

File etc/message-colorful.xpm

Added
New image

File etc/message-simple.xpm

Added
New image

File etc/mime-colorful-dn.xpm

Added
New image

File etc/mime-colorful-up.xpm

Added
New image

File etc/mime-colorful-xx.xpm

Added
New image

File etc/mime-dn.xbm

Added
New image

File etc/mime-simple-dn.xpm

Added
New image

File etc/mime-simple-up.xpm

Added
New image

File etc/mime-simple-xx.xpm

Added
New image

File etc/mime-up.xbm

Added
New image

File etc/mime-xx.xbm

Added
New image

File etc/mona_stamp-colorful.xpm

Added
New image

File etc/mona_stamp-simple.xpm

Added
New image

File etc/next-dn.xbm

Added
New image

File etc/next-dn.xpm

Added
New image

File etc/next-up.xbm

Added
New image

File etc/next-up.xpm

Added
New image

File etc/next-xx.xbm

Added
New image

File etc/previous-dn.xbm

Added
New image

File etc/previous-dn.xpm

Added
New image

File etc/previous-up.xbm

Added
New image

File etc/previous-up.xpm

Added
New image

File etc/previous-xx.xbm

Added
New image

File etc/print-dn.xbm

Added
New image

File etc/print-dn.xpm

Added
New image

File etc/print-up.xbm

Added
New image

File etc/print-up.xpm

Added
New image

File etc/print-xx.xbm

Added
New image

File etc/quit-dn.xbm

Added
New image

File etc/quit-dn.xpm

Added
New image

File etc/quit-up.xbm

Added
New image

File etc/quit-up.xpm

Added
New image

File etc/quit-xx.xbm

Added
New image

File etc/recover-dn.xbm

Added
New image

File etc/recover-dn.xpm

Added
New image

File etc/recover-up.xbm

Added
New image

File etc/recover-up.xpm

Added
New image

File etc/recover-xx.xbm

Added
New image

File etc/reply-dn.xbm

Added
New image

File etc/reply-dn.xpm

Added
New image

File etc/reply-up.xbm

Added
New image

File etc/reply-up.xpm

Added
New image

File etc/reply-xx.xbm

Added
New image

File etc/stuffed_box-colorful.xpm

Added
New image

File etc/stuffed_box-simple.xpm

Added
New image

File etc/undelete-dn.xbm

Added
New image

File etc/undelete-dn.xpm

Added
New image

File etc/undelete-up.xbm

Added
New image

File etc/undelete-up.xpm

Added
New image

File etc/undelete-xx.xbm

Added
New image

File etc/visit-dn.xbm

Added
New image

File etc/visit-dn.xpm

Added
New image

File etc/visit-up.xbm

Added
New image

File etc/visit-up.xpm

Added
New image

File etc/visit-xx.xbm

Added
New image

File make-autoloads

+(defun member (e list)
+  (while (and list (not (equal e (car list))))
+    (setq list (cdr list)))
+  list )
+
+(defun print-autoloads ()
+  (let ((files (cdr (member "print-autoloads" command-line-args)))
+	;; kludge for broken v19 emacs.  it's supposed to accept
+	;; t in autoloads to mean 'macro but it doesn't.  this
+	;; kludge will screw people who try to byte-compile VM
+	;; with emacs18 for emacs19.
+	(macro-flag (if (string-match "^19" emacs-version) ''macro t))
+	sexp function doc interactive macro)
+    (setq expanded-files (mapcar (function expand-file-name) files))
+    (while files
+      (set-buffer (find-file-noselect (car expanded-files)))
+      (goto-char (point-min))
+      (condition-case nil
+	  (while t
+	    (setq sexp (read (current-buffer)))
+	    (if (and (consp sexp) (cdr sexp)
+		     (memq (car sexp) '(defun defmacro defsubst fset)))
+		(progn
+		  (if (memq (car sexp) '(defmacro defsubst))
+		      (setq macro macro-flag)
+		    (setq macro nil))
+		  (if (eq (car sexp) 'fset)
+		      (setq sexp (cdr sexp)
+			    function (eval (car sexp))
+			    interactive nil
+			    doc nil)
+		    (setq sexp (cdr sexp)
+			  function (car sexp)
+			  sexp (cdr (cdr sexp)))
+		    (if (stringp (car sexp))
+			(setq doc (car sexp)
+			      sexp (cdr sexp))
+		      (setq doc nil))
+		    (if (and (consp (car sexp))
+			     (eq (car (car sexp)) 'interactive))
+			(setq interactive t)
+		      (setq interactive nil)))
+		  (if (string-match "\\.el$" (car files))
+		      (setq file (substring (car files) 0 -3))
+		    (setq file (car files)))
+		  (print (list 'autoload (list 'quote function) file
+			       doc interactive macro)))))
+	(end-of-file nil))
+      (kill-buffer (current-buffer))
+      (setq files (cdr files)
+	    expanded-files (cdr expanded-files))))
+  (kill-emacs))
+;;; Tools to configure your GNU Emacs windows
+;;; Copyright (C) 1991, 1993, 1994, 1995, 1997 Kyle E. Jones 
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;;; 02139, USA.
+;;;
+;;; Send bug reports to kyle@uunet.uu.net.
+
+;;(provide 'tapestry)
+
+(defvar tapestry-version "1.09")
+
+;; Pass state information between the tapestry-set-window-map
+;; and tapestry-set-buffer-map stages.  UGH.  The reason for this
+;; is explained in tapestry-set-buffer-map.
+(defvar tapestry-windows-changed nil)
+
+(defun tapestry (&optional frame-list)
+  "Returns a list containing complete information about the current
+configuration of Emacs frames, windows, buffers and cursor
+positions.  Call the function set-tapestry with the list that this function
+returns to restore the configuration.
+
+Optional first arg FRAME-LIST should be a list of frames; only
+configuration information about these frames will be returned.
+
+The configuration information is returned in a form that can be saved and
+restored across multiple Emacs sessions."
+  (let ((frames (or frame-list (tapestry-frame-list)))
+	(frame-map (tapestry-frame-map))
+	(sf (tapestry-selected-frame))
+	(other-maps nil))
+    (unwind-protect
+	(while frames
+	  (tapestry-select-frame (car frames))
+	  (setq other-maps (cons (list (tapestry-window-map)
+				       (tapestry-buffer-map)
+				       (tapestry-position-map))
+				 other-maps)
+		frames (cdr frames)))
+      (tapestry-select-frame sf))
+    (list frame-map other-maps)))
+
+(defun set-tapestry (map &optional n root-window-edges)
+  "Restore the frame/window/buffer configuration described by MAP,
+which should be a list previously returned by a call to
+tapestry.
+
+Optional second arg N causes frame reconfiguration to be skipped
+and the windows of the current frame will configured according to
+the window map of the Nth frame in MAP.
+
+Optional third arg ROOT-WINDOW-EDGES non-nil should be a list
+containing the edges of a window in the current frame.  This list
+should be in the same form as returned by the `window-edges'
+function.  The window configuration from MAP will be restored in
+this window.  If no window with these exact edges exists, a
+window that lies entirely within the edge coordinates will be
+expanded until the edge coordinates match or the window bounded by
+ROOT-WINDOW-EDGES is entirely contained within the expanded
+window.  If no window entirely within the ROOT-WINDOW-EDGES edge
+coordinates can be found, the window with the greatest overlap of
+ROOT-WINDOW-EDGES will be used."
+  (let ((sf (tapestry-selected-frame))
+	(tapestry-windows-changed nil)
+	frame-list frame-map other-maps other-map)
+    (setq frame-map (nth 0 map)
+	  other-maps (nth 1 map))
+    (if (and root-window-edges (null n))
+	(setq n 1))
+    (if n
+	(let (first-window)
+	  (setq other-map (nth (1- n) other-maps))
+	  (if (null other-map)
+	      (error "No such map, %d" n))
+	  (setq first-window
+		(tapestry-set-window-map (nth 0 other-map) root-window-edges))
+	  (tapestry-set-buffer-map (nth 1 other-map) first-window)
+	  (tapestry-set-position-map (nth 2 other-map) first-window))
+      (tapestry-set-frame-map frame-map)
+      ;; frame list is reversed relative to the map order because
+      ;; created frames are added to the head of the list instead
+      ;; of the tail.
+      (setq frame-list (nreverse (tapestry-frame-list)))
+      (unwind-protect
+	  (while other-maps
+	    (tapestry-select-frame (car frame-list))
+	    (tapestry-set-window-map (nth 0 (car other-maps)))
+	    (tapestry-set-buffer-map (nth 1 (car other-maps)))
+	    (tapestry-set-position-map (nth 2 (car other-maps)))
+	    (setq other-maps (cdr other-maps)
+		  frame-list (cdr frame-list)))
+	(and (tapestry-frame-live-p sf) (tapestry-select-frame sf))))))
+
+(defun tapestry-frame-map ()
+  (let ((map (mapcar 'tapestry-frame-parameters (tapestry-frame-list)))
+	list cell frame-list)
+    (setq list map
+	  frame-list (tapestry-frame-list))
+    (while list
+      (setq cell (assq 'minibuffer (car list)))
+      (if (and cell (windowp (cdr cell)))
+	  (if (eq (tapestry-window-frame (cdr cell)) (car frame-list))
+	      (setcdr cell t)
+	    (setcdr cell 'none)))
+      (setq list (cdr list)
+	    frame-list (cdr frame-list)))
+    map ))
+
+(defun tapestry-set-frame-map (map)
+  ;; some parameters can only be set only at frame creation time.
+  ;; so all existing frames must die.
+  (let ((doomed-frames (tapestry-frame-list)))
+    (while map
+      (tapestry-make-frame (car map))
+      (setq map (cdr map)))
+    (while doomed-frames
+      (tapestry-delete-frame (car doomed-frames))
+      (setq doomed-frames (cdr doomed-frames)))))
+
+(defun tapestry-window-map ()
+  (let (maps map0 map1 map0-edges map1-edges x-unchanged y-unchanged)
+    (setq maps (mapcar 'tapestry-window-edges (tapestry-window-list)))
+    (while (cdr maps)
+      (setq map0 maps)
+      (while (cdr map0)
+	(setq map1 (cdr map0)
+	      map0-edges (tapestry-find-window-map-edges (car map0))
+	      map1-edges (tapestry-find-window-map-edges (car map1))
+	      x-unchanged (and (= (car map0-edges) (car map1-edges))
+			       (= (nth 2 map0-edges) (nth 2 map1-edges)))
+	      y-unchanged (and (= (nth 1 map0-edges) (nth 1 map1-edges))
+			       (= (nth 3 map0-edges) (nth 3 map1-edges))))
+	(cond ((and (not x-unchanged) (not y-unchanged))
+	       (setq map0 (cdr map0)))
+	      ((or (and x-unchanged (eq (car (car map0)) '-))
+		   (and y-unchanged (eq (car (car map0)) '|)))
+	       (nconc (car map0) (list (car map1)))
+	       (setcdr map0 (cdr map1)))
+	      (t
+	       (setcar map0 (list (if x-unchanged '- '|)
+				  (car map0)
+				  (car map1)))
+	       (setcdr map0 (cdr map1))))))
+    (car maps)))
+
+(defun tapestry-set-window-map (map &optional root-window-edges)
+  (let ((map-width (tapestry-compute-map-width map))
+	(map-height (tapestry-compute-map-height map))
+	(root-window nil))
+    (if root-window-edges
+	(let (w-list w-edges w-area
+	      exact-w inside-w overlap-w max-overlap overlap)
+	  (while (null root-window)
+	    (setq exact-w nil
+		  inside-w nil
+		  overlap-w nil
+		  max-overlap -1
+		  w-list (tapestry-window-list))
+	    (while w-list
+	      (setq w-edges (tapestry-window-edges (car w-list))
+		    w-area (tapestry-window-area w-edges))
+	      (if (equal w-edges root-window-edges)
+		  (setq exact-w (car w-list)
+			w-list nil)
+		(setq overlap (tapestry-window-overlap w-edges
+						       root-window-edges)
+		      overlap (if overlap (tapestry-window-area overlap) 0)
+		      w-area (tapestry-window-area w-edges))
+		(if (< max-overlap overlap)
+		    (setq max-overlap overlap
+			  overlap-w (car w-list)))
+		;; set inside-w each time we find a window inside
+		;; the root window edges.  FSF Emacs gives space
+		;; to the window above or to the left if there is
+		;; such a window.  therefore we want to find the
+		;; inside window that is bottom-most or right-most so that
+		;; when we delete it, its space will be given to
+		;; what will be the root window.
+		(if (= w-area overlap)
+		    (setq inside-w (car w-list)))
+		(setq w-list (cdr w-list))))
+	    (cond (exact-w (setq root-window exact-w))
+		  (inside-w
+		   ;; how could a window be inside the root window
+		   ;; edges and there only be one window?  a
+		   ;; multi-line minibuffer, that's how!
+		   (if (not (one-window-p t))
+		       (delete-window inside-w)))
+		  (t (setq root-window overlap-w))))
+	  (tapestry-apply-window-map map map-width map-height root-window)
+	  (setq tapestry-windows-changed t)
+	  root-window )
+      (if (tapestry-windows-match-map map map-width map-height)
+	  (tapestry-first-window)
+	(delete-other-windows)
+	(setq root-window (selected-window))
+	(tapestry-apply-window-map map map-width map-height root-window)
+	(setq tapestry-windows-changed t)
+	root-window ))))
+
+(defun tapestry-buffer-map ()
+  (let ((w-list (tapestry-window-list))
+	b list)
+    (while w-list
+      (setq b (window-buffer (car w-list))
+	    list (cons (list (buffer-file-name b)
+			     (buffer-name b))
+		       list)
+	    w-list (cdr w-list)))
+    (nreverse list)))
+
+;; This version of tapestry-set-buffer-map unconditionally set
+;; the window buffer.  This confused XEmacs 19.14's scroll-up
+;; function when scrolling VM presentation buffers.
+;; end-of-buffer was never signaled after a scroll.  You can
+;; duplicate this by creating a buffer that can be displayed
+;; fully in the current window and then run
+;;
+;;    (progn
+;;      (set-window-buffer (selected-window) (current-buffer))
+;;      (scroll-up nil))
+;;;;;;;;;;;
+;;(defun tapestry-set-buffer-map (buffer-map &optional first-window)
+;;  (let ((w-list (tapestry-window-list first-window)) wb)
+;;    (while (and w-list buffer-map)
+;;      (setq wb (car buffer-map))
+;;      (set-window-buffer
+;;       (car w-list)
+;;       (if (car wb)
+;;	   (or (get-file-buffer (car wb))
+;;	       (find-file-noselect (car wb)))
+;;	 (get-buffer-create (nth 1 wb))))
+;;      (setq w-list (cdr w-list)
+;;	    buffer-map (cdr buffer-map)))))
+
+(defun tapestry-set-buffer-map (buffer-map &optional first-window)
+  (let ((w-list (tapestry-window-list first-window))
+	current-wb proposed-wb cell)
+    (while (and w-list buffer-map)
+      (setq cell (car buffer-map)
+	    proposed-wb (if (car cell)
+			    (or (get-file-buffer (car cell))
+				(find-file-noselect (car cell)))
+			  (get-buffer-create (nth 1 cell)))
+	    current-wb (window-buffer (car w-list)))
+      ;; Setting the window buffer to the same value it already
+      ;; has seems to confuse XEmacs' scroll-up function.  But
+      ;; _not_ setting it after windows torn down seem to cause
+      ;; window point to sometimes drift away from point at
+      ;; redisplay time.  The solution (hopefully!) is to track
+      ;; when windows have been rearranged and unconditionally do
+      ;; the set-window-buffer, otherwise do it only if the
+      ;; window buffer and the proposed window buffer differ.
+      (if (or tapestry-windows-changed (not (eq proposed-wb current-wb)))
+	  (set-window-buffer (car w-list) proposed-wb))
+      (setq w-list (cdr w-list)
+	    buffer-map (cdr buffer-map)))))
+
+(defun tapestry-position-map ()
+  (let ((sw (selected-window))
+	(w-list (tapestry-window-list))
+	list)
+    (while w-list
+      (setq list (cons (list (window-start (car w-list))
+			     (window-point (car w-list))
+			     (window-hscroll (car w-list))
+			     (eq (car w-list) sw))
+		       list)
+	    w-list (cdr w-list)))
+    (nreverse list)))
+
+(defun tapestry-set-position-map (position-map &optional first-window)
+  (let ((w-list (tapestry-window-list first-window))
+	(osw (selected-window))
+	sw p)
+    (while (and w-list position-map)
+      (setq p (car position-map))
+      (and (car p) (set-window-start (car w-list) (car p)))
+      (and (nth 1 p) (set-window-point (car w-list) (nth 1 p)))
+      (and (nth 2 p) (set-window-hscroll (car w-list) (nth 2 p)))
+      (and (nth 3 p) (setq sw (car w-list)))
+      ;; move this buffer up in the buffer-list
+      (select-window (car w-list))
+      (setq w-list (cdr w-list)
+	    position-map (cdr position-map)))
+    (select-window (or sw osw))))
+
+(defun tapestry-apply-window-map (map map-width map-height current-window
+				      &optional
+				      root-window-width
+				      root-window-height)
+  (let ((window-min-height 1)
+	(window-min-width 1)
+	horizontal)
+    (if (null root-window-width)
+	(setq root-window-height (window-height current-window)
+	      root-window-width (window-width current-window)))
+    (while map
+      (cond
+       ((numberp (car map)) (setq map nil))
+       ((eq (car map) '-) (setq horizontal nil))
+       ((eq (car map) '|) (setq horizontal t))
+       (t
+	(if (cdr map)
+	    (split-window
+	     current-window
+	     (if horizontal
+		 (/ (* (tapestry-compute-map-width (car map))
+		       root-window-width)
+		    map-width)
+	       (/ (* (tapestry-compute-map-height (car map))
+		     root-window-height)
+		  map-height))
+	     horizontal))
+	(if (not (numberp (car (car map))))
+	    (setq current-window
+		  (tapestry-apply-window-map (car map)
+					     map-width map-height
+					     current-window
+					     root-window-width
+					     root-window-height)))
+	(and (cdr map) (setq current-window (next-window current-window 0)))))
+      (setq map (cdr map)))
+    current-window ))
+
+(defun tapestry-windows-match-map (map
+				   &optional
+				   map-width map-height
+				   window-map
+				   window-map-width
+				   window-map-height)
+  (or map-width
+      (setq map-width (tapestry-compute-map-width map)
+	    map-height (tapestry-compute-map-height map)))
+  (or window-map
+      (setq window-map (tapestry-window-map)
+	    window-map-height (tapestry-compute-map-height window-map)
+	    window-map-width (tapestry-compute-map-width window-map)))
+  (let ((result t))
+    (cond ((numberp (car map))
+	   (and (numberp (car window-map))
+		(= (/ (* (nth 0 map) window-map-width)
+		      map-width)
+		   (nth 0 window-map))
+		(= (/ (* (nth 1 map) window-map-height)
+		      map-height)
+		   (nth 1 window-map))
+		(= (/ (* (nth 2 map) window-map-width)
+		      map-width)
+		   (nth 2 window-map))
+		(= (/ (* (nth 3 map) window-map-height)
+		      map-height)
+		   (nth 3 window-map))))
+	  ((eq (car map) '-)
+	   (if (not (eq (car window-map) '-))
+	       nil
+	     (setq map (cdr map)
+		   window-map (cdr window-map))
+	     (while (and result map window-map)
+	       (setq result (tapestry-windows-match-map (car map)
+						       map-width
+						       map-height
+						       (car window-map)
+						       window-map-width
+						       window-map-height)
+		     map (cdr map)
+		     window-map (cdr window-map)))
+	     (and result (null map) (null window-map))))
+	  ((eq (car map) '|)
+	   (if (not (eq (car window-map) '|))
+	       nil
+	     (setq map (cdr map)
+		   window-map (cdr window-map))
+	     (while (and result map window-map)
+	       (setq result (tapestry-windows-match-map (car map)
+						       map-width
+						       map-height
+						       (car window-map)
+						       window-map-width
+						       window-map-height)
+		     map (cdr map)
+		     window-map (cdr window-map)))
+	     (and result (null map) (null window-map)))))))
+
+(defun tapestry-find-window-map-edges (map)
+  (let (nw-edges se-edges)
+    (setq nw-edges map)
+    (while (and (consp nw-edges) (not (numberp (car nw-edges))))
+      (setq nw-edges (car (cdr nw-edges))))
+    (setq se-edges map)
+    (while (and (consp se-edges) (not (numberp (car se-edges))))
+      (while (cdr se-edges)
+	(setq se-edges (cdr se-edges)))
+      (setq se-edges (car se-edges)))
+    (if (eq nw-edges se-edges)
+	nw-edges
+      (setq nw-edges (copy-sequence nw-edges))
+      (setcdr (nthcdr 1 nw-edges) (nthcdr 2 se-edges))
+      nw-edges )))
+
+(defun tapestry-compute-map-width (map)
+  (let ((edges (tapestry-find-window-map-edges map)))
+    (- (nth 2 edges) (car edges))))
+
+(defun tapestry-compute-map-height (map)
+  (let ((edges (tapestry-find-window-map-edges map)))
+    (- (nth 3 edges) (nth 1 edges))))
+
+;; delq is to memq as delassq is to assq
+(defun tapestry-delassq (elt list)
+  (let ((prev nil)
+	(curr list))
+    (while curr
+      (if (eq elt (car (car curr)))
+	  (if (null prev)
+	      (setq list (cdr list) curr list)
+	    (setcdr prev (cdr curr))
+	    (setq curr (cdr curr)))
+	(setq prev curr curr (cdr curr))))
+    list ))
+
+(defun tapestry-remove-frame-parameters (map params)
+  (let (frame-map)
+    (while params
+      (setq frame-map (nth 0 map))
+      (while frame-map
+	(setcar frame-map (tapestry-delassq (car params) (car frame-map)))
+	(setq frame-map (cdr frame-map)))
+      (setq params (cdr params)))))
+
+(defun tapestry-nullify-tapestry-elements (map &optional buf-file-name buf-name
+					window-start window-point
+					window-hscroll selected-window)
+  (let (p)
+    (setq map (nth 1 map))
+    (while map
+      (setq p (nth 1 (car map)))
+      (while p
+	(and buf-file-name (setcar (car p) nil))
+	(and buf-name (setcar (cdr (car p)) nil))
+	(setq p (cdr p)))
+      (setq p (nth 2 (car map)))
+      (while p
+	(and window-start (setcar (car p) nil))
+	(and window-point (setcar (cdr (car p)) nil))
+	(and window-hscroll (setcar (nthcdr 2 (car p)) nil))
+	(and selected-window (setcar (nthcdr 3 (car p)) nil))
+	(setq p (cdr p)))
+      (setq map (cdr map)))))
+
+(defun tapestry-replace-tapestry-element (map what function)
+  (let (mapi mapj p old new)
+    (cond ((eq what 'buffer-file-name)
+	   (setq mapi 1 mapj 0))
+	   ((eq what 'buffer-name)
+	    (setq mapi 1 mapj 1))
+	   ((eq what 'window-start)
+	    (setq mapi 2 mapj 0))
+	   ((eq what 'window-point)
+	    (setq mapi 2 mapj 1))
+	   ((eq what 'window-hscroll)
+	    (setq mapi 2 mapj 2))
+	   ((eq what 'selected-window)
+	    (setq mapi 2 mapj 3)))
+    (setq map (nth 1 map))
+    (while map
+      (setq p (nth mapi (car map)))
+      (while p
+	(setq old (nth mapj (car p))
+	      new (funcall function old))
+	(if (not (equal old new))
+	    (setcar (nthcdr mapj (car p)) new))
+	(setq p (cdr p)))
+      (setq map (cdr map)))))
+
+(defun tapestry-window-list (&optional first-window)
+  (let* ((first-window (or first-window (tapestry-first-window)))
+	 (windows (cons first-window nil))
+	 (current-cons windows)
+	 (w (next-window first-window 'nomini)))
+    (while (not (eq w first-window))
+      (setq current-cons (setcdr current-cons (cons w nil)))
+      (setq w (next-window w 'nomini)))
+    windows ))
+
+(defun tapestry-first-window ()
+  (if (eq (tapestry-selected-frame)
+	  (tapestry-window-frame (minibuffer-window)))
+      (next-window (minibuffer-window))
+    (let ((w (selected-window))
+	  (top (or (cdr (assq 'menu-bar-lines (tapestry-frame-parameters))) 0))
+	  edges)
+      (while (or (not (= 0 (car (setq edges (tapestry-window-edges w)))))
+		 ;; >= instead of = because in FSF Emacs 19.2x
+		 ;; (whenever the Lucid menubar code was added) the
+		 ;; menu-bar-lines frame parameter == 1 when the
+		 ;; Lucid menubar is enabled even though the
+		 ;; menubar doesn't steal the first line from the
+		 ;; window.
+		 (not (>= top (nth 1 edges))))
+	(setq w (next-window w 'nomini)))
+      w )))
+
+(defun tapestry-window-area (edges)
+  (* (- (nth 3 edges) (nth 1 edges))
+     (- (nth 2 edges) (nth 0 edges))))
+
+(defun tapestry-window-overlap (e0 e1)
+  (let (top left bottom right)
+    (cond ((and (<= (nth 0 e0) (nth 0 e1)) (< (nth 0 e1) (nth 2 e0)))
+	   (setq left (nth 0 e1)))
+	  ((and (<= (nth 0 e1) (nth 0 e0)) (< (nth 0 e0) (nth 2 e1)))
+	   (setq left (nth 0 e0))))
+    (cond ((and (< (nth 0 e0) (nth 2 e1)) (<= (nth 2 e1) (nth 2 e0)))
+	   (setq right (nth 2 e1)))
+	  ((and (< (nth 0 e1) (nth 2 e0)) (<= (nth 2 e0) (nth 2 e1)))
+	   (setq right (nth 2 e0))))
+    (cond ((and (<= (nth 1 e0) (nth 1 e1)) (< (nth 1 e1) (nth 3 e0)))
+	   (setq top (nth 1 e1)))
+	  ((and (<= (nth 1 e1) (nth 1 e0)) (< (nth 1 e0) (nth 3 e1)))
+	   (setq top (nth 1 e0))))
+    (cond ((and (< (nth 1 e0) (nth 3 e1)) (<= (nth 3 e1) (nth 3 e0)))
+	   (setq bottom (nth 3 e1)))
+	  ((and (< (nth 1 e1) (nth 3 e0)) (<= (nth 3 e0) (nth 3 e1)))
+	   (setq bottom (nth 3 e0))))
+    (and left top right bottom (list left top right bottom))))
+
+(defun tapestry-window-edges (&optional window)
+  (if (and (fboundp 'window-pixel-edges)
+	   (fboundp 'face-width)
+	   (fboundp 'face-height))
+      (let ((edges (window-pixel-edges window))
+	    tmp)
+	(setq tmp edges)
+	(setcar tmp (/ (car tmp) (face-width 'default)))
+	(setq tmp (cdr tmp))
+	(setcar tmp (/ (car tmp) (face-height 'default)))
+	(setq tmp (cdr tmp))
+	(setcar tmp (/ (car tmp) (face-width 'default)))
+	(setq tmp (cdr tmp))
+	(setcar tmp (/ (car tmp) (face-height 'default)))
+	edges )
+    (window-edges window)))
+
+;; We call these functions instead of calling the Emacs 19 frame
+;; functions directly to let this package work with v18 Emacs.
+
+(defun tapestry-frame-list ()
+  (if (fboundp 'frame-list)
+      (frame-list)
+    (list nil)))
+
+(defun tapestry-frame-parameters (&optional f)
+  (if (fboundp 'frame-parameters)
+      (frame-parameters f)
+    nil ))
+
+(defun tapestry-window-frame (w)
+  (if (fboundp 'window-frame)
+      (window-frame w)
+    nil ))
+
+(defun tapestry-modify-frame-parameters (f alist)
+  (if (fboundp 'modify-frame-parameters)
+      (modify-frame-parameters f alist)
+    nil ))
+
+(defun tapestry-select-frame (f)
+  (if (fboundp 'select-frame)
+      (select-frame f)
+    nil ))
+
+(defun tapestry-selected-frame ()
+  (if (fboundp 'selected-frame)
+      (selected-frame)
+    nil ))
+
+(defun tapestry-next-frame (&optional f all)
+  (if (fboundp 'next-frame)
+      (next-frame f all)
+    nil ))
+
+(defun tapestry-make-frame (&optional alist)
+  (if (fboundp 'make-frame)
+      (make-frame alist)
+    nil ))
+
+(defun tapestry-delete-frame (&optional f)
+  (if (fboundp 'delete-frame)
+      (delete-frame f)
+    nil ))
+
+(defun tapestry-frame-live-p (f)
+  (if (fboundp 'frame-live-p)
+      (frame-live-p f)
+    t ))
+
+(provide 'tapestry)

File vm-byteopts.el

+;;(provide 'vm-byteopts)
+
+;; get the compiler loaded so we can undo some of the things that
+;; happen when it's loaded.
+(load "bytecomp" t t nil)
+;; Emacs 19 byte compiler complains about too much stuff by default.
+;; Turn off most of the warnings here.
+(setq byte-compile-warnings '(free-vars))
+;; need to use these variables for v18 support.
+;; stifle the compiler.
+(put 'inhibit-local-variables 'byte-obsolete-variable nil)
+;; Turn off dynamic docstrings and lazy function loading.  This
+;; is a new feature of FSF Emacs 19.29, and is incompatible
+;; with pre-19.29 versions of FSF Emacs and all version of Lucid
+;; Emacs / XEmacs.  I like being able to share .elc files between
+;; different v19 Emacses.
+(setq byte-compile-dynamic nil)
+(setq byte-compile-dynamic-docstrings nil)
+;; avoid v20 features because users are going
+;; to try to share elc files no matter what we tell them.
+(setq byte-compile-emacs19-compatibility t)
+
+(provide 'vm-byteopts)

File vm-crypto.el

+;;; Encryption and related functions for VM
+;;; Copyright (C) 2001 Kyle E. Jones
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;(provide 'vm-crypto)
+
+;; compatibility
+(fset 'vm-pop-md5 'vm-md5-string)
+
+(defun vm-md5-region (start end)
+  (if (fboundp 'md5)
+      (md5 (current-buffer) start end)
+    (let ((buffer nil)
+	  (retval nil)
+	  (curbuf (current-buffer)))
+      (unwind-protect
+	  (save-excursion
+	    (setq buffer (vm-make-work-buffer))
+	    (set-buffer buffer)
+	    (insert-buffer-substring curbuf start end)
+	    ;; call-process-region calls write-region.
+	    ;; don't let it do CR -> LF translation.
+	    (setq selective-display nil)
+	    (setq retval
+		  (call-process-region (point-min) (point-max)
+				       vm-pop-md5-program
+				       t buffer nil))
+	    (if (not (equal retval 0))
+		(progn
+		  (error "%s failed: exited with code %s"
+			 vm-pop-md5-program retval)))
+	    ;; md5sum generates extra output even when summing stdin.
+	    (goto-char (point-min))
+ 	    (if (re-search-forward " [ *]?-\n" nil t)
+		(replace-match ""))
+
+	    (goto-char (point-min))
+	    (if (or (re-search-forward "[^0-9a-f\n]" nil t)
+		    (< (point-max) 32))
+		(error "%s produced bogus MD5 digest '%s'"
+		       vm-pop-md5-program 
+		       (vm-buffer-substring-no-properties (point-min) 
+							  (point-max))))
+	    ;; MD5 digest is 32 chars long
+	    ;; mddriver adds a newline to make neaten output for tty
+	    ;; viewing, make sure we leave it behind.
+	    (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32)))
+	(and buffer (kill-buffer buffer))))))
+
+;; output is in hex
+(defun vm-md5-string (string)
+  (if (fboundp 'md5)
+      (md5 string)
+    (vm-with-string-as-temp-buffer
+     string (function
+	     (lambda ()
+	       (goto-char (point-min))
+	       (insert (vm-md5-region (point-min) (point-max)))
+	       (delete-region (point) (point-max)))))))
+
+;; output is the raw digest bits, not hex
+(defun vm-md5-raw-string (s)
+  (setq s (vm-md5-string s))
+  (let ((raw (make-string 16 0))
+	(i 0) n
+	(hex-digit-alist '((?0 .  0)  (?1 .  1)  (?2 .  2)  (?3 .  3)
+			   (?4 .  4)  (?5 .  5)  (?6 .  6)  (?7 .  7)
+			   (?8 .  8)  (?9 .  9)  (?A . 10)  (?B . 11)
+			   (?C . 12)  (?D . 13)  (?E . 14)  (?F . 15)
+			   ;; some mailer uses lower-case hex
+			   ;; digits despite this being forbidden
+			   ;; by the MIME spec.
+			   (?a . 10)  (?b . 11)  (?c . 12)  (?d . 13)
+			   (?e . 14)  (?f . 15))))
+    (while (< i 32)
+      (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16)
+		 (cdr (assoc (aref s (1+ i)) hex-digit-alist))))
+      (aset raw (/ i 2) n)
+      (setq i (+ i 2)))
+    raw ))
+
+(defun vm-xor-string (s1 s2)
+  (let ((len (length s1))
+	result (i 0))
+    (if (/= len (length s2))
+	(error "strings not of equal length"))
+    (setq result (make-string len 0))
+    (while (< i len)
+      (aset result i (logxor (aref s1 i) (aref s2 i)))
+      (setq i (1+ i)))
+    result ))
+
+(defun vm-setup-ssh-tunnel (host port)
+  (let (local-port process done)
+    (while (not done)
+      (setq local-port (+ 1025 (random (- 65536 1025)))
+	    process nil)
+      (condition-case nil
+	  (progn
+	    (setq process
+		  (open-network-stream "TEST-CONNECTION" nil
+				       "127.0.0.1" local-port))
+	    (process-kill-without-query process))
+	(error nil))
+      (cond ((null process)
+	     (setq process
+		   (apply 'start-process
+			  (format "SSH tunnel to %s:%s" host port)
+			  (vm-make-work-buffer)
+			  vm-ssh-program
+			  (nconc
+			   (list "-L"
+				 (format "%d:%s:%s" local-port host port))
+			   (copy-sequence vm-ssh-program-switches)
+			   (list host vm-ssh-remote-command)))
+		   done t)
+	     (process-kill-without-query process)
+	     (set-process-sentinel process 'vm-process-sentinel-kill-buffer))
+	    (t
+	     (delete-process process))))
+
+    ;; wait for some output from vm-ssh-remote-command.  this
+    ;; ensures that when we return the ssh connection is ready to
+    ;; do port-forwarding.
+    (accept-process-output process)
+
+    local-port ))
+
+(defun vm-generate-random-data-file (n-octets)
+  (let ((file (vm-make-tempfile))
+	work-buffer (i n-octets))
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer))
+	  (set-buffer work-buffer)
+	  (while (> i 0)
+	    (insert-char (random 256) 1)
+	    (setq i (1- i)))
+	  (write-region (point-min) (point-max) file nil 0))
+      (and work-buffer (kill-buffer work-buffer)))
+    file ))
+
+(defun vm-setup-stunnel-random-data-if-needed ()
+  (cond ((null vm-stunnel-random-data-method) nil)
+	((eq vm-stunnel-random-data-method 'generate)
+	 (if (and (stringp vm-stunnel-random-data-file)
+		  (file-readable-p vm-stunnel-random-data-file))
+	     nil
+	   (setq vm-stunnel-random-data-file
+		 (vm-generate-random-data-file (* 4 1024)))))))
+
+(defun vm-tear-down-stunnel-random-data ()
+  (if (stringp vm-stunnel-random-data-file)
+      (vm-error-free-call 'delete-file vm-stunnel-random-data-file))
+  (setq vm-stunnel-random-data-file nil))
+
+(defun vm-stunnel-random-data-args ()
+  (cond ((null vm-stunnel-random-data-method) nil)
+	((eq vm-stunnel-random-data-method 'generate)
+	 (list "-R" vm-stunnel-random-data-file))
+	(t nil)))
+
+(defun vm-stunnel-configuration-args (host port)
+  (if (eq vm-stunnel-wants-configuration-file 'unknown)
+      (setq vm-stunnel-wants-configuration-file
+	    (not (eq (call-process vm-stunnel-program nil nil nil "-h") 0))))
+  (if (not vm-stunnel-wants-configuration-file)
+      (nconc (vm-stunnel-random-data-args)
+	     (list "-W" "-c" "-r"
+		   (format "%s:%s" host port)))
+    (let ((work-buffer nil)
+	  (workfile (vm-stunnel-configuration-file)))
+      (unwind-protect
+	  (save-excursion
+	    (setq work-buffer (vm-make-work-buffer))
+	    (set-buffer work-buffer)
+	    (insert "client = yes\n")
+	    (insert "RNDfile = " vm-stunnel-random-data-file "\n")
+	    (insert "RNDoverwrite = no\n")
+	    (insert "connect = " (format "%s:%s" host port) "\n")
+	    (write-region (point-min) (point-max) workfile nil 0))
+	(and work-buffer (kill-buffer work-buffer)))
+      (list workfile) )))
+
+(defun vm-stunnel-configuration-file ()
+  (if vm-stunnel-configuration-file
+      vm-stunnel-configuration-file
+    (setq vm-stunnel-configuration-file (vm-make-tempfile))
+    (vm-register-global-garbage-files (list vm-stunnel-configuration-file))
+    vm-stunnel-configuration-file))
+
+(provide 'vm-crypto)

File vm-delete.el

+;;; Delete and expunge commands for VM.
+;;; Copyright (C) 1989-1997 Kyle E. Jones
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;(provide 'vm-delete)
+
+(defun vm-delete-message (count)
+  "Add the `deleted' attribute to the current message.
+
+The message will be physically deleted from the current folder the next
+time the current folder is expunged.
+
+With a prefix argument COUNT, the current message and the next
+COUNT - 1 messages are deleted.  A negative argument means
+the current message and the previous |COUNT| - 1 messages are
+deleted.
+
+When invoked on marked messages (via `vm-next-command-uses-marks'),
+only marked messages are deleted, other messages are ignored."
+  (interactive "p")
+  (if (interactive-p)
+      (vm-follow-summary-cursor))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-read-only)
+  (vm-error-if-folder-empty)
+  (let ((used-marks (eq last-command 'vm-next-command-uses-marks))
+	(mlist (vm-select-marked-or-prefixed-messages count))
+	(del-count 0))
+    (while mlist
+      (if (not (vm-deleted-flag (car mlist)))
+	  (progn
+	    (vm-set-deleted-flag (car mlist) t)
+	    (vm-increment del-count)))
+      (setq mlist (cdr mlist)))
+    (vm-display nil nil '(vm-delete-message vm-delete-message-backward)
+		(list this-command))
+    (if (and used-marks (interactive-p))
+	(if (zerop del-count)
+	    (message "No messages deleted")
+	  (message "%d message%s deleted"
+		   del-count
+		   (if (= 1 del-count) "" "s"))))
+    (vm-update-summary-and-mode-line)
+    (if (and vm-move-after-deleting (not used-marks))
+	(let ((vm-circular-folders (and vm-circular-folders
+					(eq vm-move-after-deleting t))))
+	  (vm-next-message count t executing-kbd-macro)))))
+
+(defun vm-delete-message-backward (count)
+  "Like vm-delete-message, except the deletion direction is reversed."
+  (interactive "p")
+  (if (interactive-p)
+      (vm-follow-summary-cursor))
+  (vm-delete-message (- count)))
+
+(defun vm-undelete-message (count)
+  "Remove the `deleted' attribute from the current message.
+
+With a prefix argument COUNT, the current message and the next
+COUNT - 1 messages are undeleted.  A negative argument means
+the current message and the previous |COUNT| - 1 messages are
+deleted.
+
+When invoked on marked messages (via `vm-next-command-uses-marks'),
+only marked messages are undeleted, other messages are ignored."
+  (interactive "p")
+  (if (interactive-p)
+      (vm-follow-summary-cursor))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-read-only)
+  (vm-error-if-folder-empty)
+  (let ((used-marks (eq last-command 'vm-next-command-uses-marks))
+	(mlist (vm-select-marked-or-prefixed-messages count))
+	(undel-count 0))
+    (while mlist
+      (if (vm-deleted-flag (car mlist))
+	  (progn
+	    (vm-set-deleted-flag (car mlist) nil)
+	    (vm-increment undel-count)))
+      (setq mlist (cdr mlist)))
+    (if (and used-marks (interactive-p))
+	(if (zerop undel-count)
+	    (message "No messages undeleted")
+	  (message "%d message%s undeleted"
+		   undel-count
+		   (if (= 1 undel-count)
+		       "" "s"))))
+    (vm-display nil nil '(vm-undelete-message) '(vm-undelete-message))
+    (vm-update-summary-and-mode-line)
+    (if (and vm-move-after-undeleting (not used-marks))
+	(let ((vm-circular-folders (and vm-circular-folders
+					(eq vm-move-after-undeleting t))))
+	  (vm-next-message count t executing-kbd-macro)))))
+
+(defun vm-kill-subject (&optional arg)
+  "Delete all messages with the same subject as the current message.
+Message subjects are compared after ignoring parts matched by
+the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix.
+
+The optional prefix argument ARG specifies the direction to move
+if vm-move-after-killing is non-nil.  The default direction is
+forward.  A positive prefix argument means move forward, a
+negative arugment means move backward, a zero argument means
+don't move at all."
+  (interactive "p")
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-read-only)
+  (vm-error-if-folder-empty)
+  (let ((subject (vm-so-sortable-subject (car vm-message-pointer)))
+	(mp vm-message-list)
+	(n 0)
+	(case-fold-search t))
+    (while mp
+      (if (and (not (vm-deleted-flag (car mp)))
+	       (string-equal subject (vm-so-sortable-subject (car mp))))
+	  (progn
+	    (vm-set-deleted-flag (car mp) t)
+	    (vm-increment n)))
+      (setq mp (cdr mp)))
+    (and (interactive-p)
+	 (if (zerop n)
+	     (message "No messages deleted.")
+	   (message "%d message%s deleted" n (if (= n 1) "" "s")))))
+  (vm-display nil nil '(vm-kill-subject) '(vm-kill-subject))
+  (vm-update-summary-and-mode-line)
+  (cond ((or (not (numberp arg)) (> arg 0))
+	 (setq arg 1))
+	((< arg 0)
+	 (setq arg -1))
+	(t (setq arg 0)))
+  (if vm-move-after-killing
+      (let ((vm-circular-folders (and vm-circular-folders
+				      (eq vm-move-after-killing t))))
+	(vm-next-message arg t executing-kbd-macro))))
+
+(defun vm-delete-duplicate-messages ()
+  "Delete duplicate messages in the current folder.
+This command works by computing an MD5 hash for the body ofeach
+non-deleted message in the folder and deleting messages that have
+a hash that has already been seen.  Messages that already deleted
+are never hashed, so VM will never delete the last copy of a
+message in a folder.  'Deleting' means flagging for deletion; you
+will have to expunge the messages with `vm-expunge-folder' to
+really get rid of them, as usual.
+
+When invoked on marked messages (via `vm-next-command-uses-marks'),
+only duplicate messages among the marked messages are deleted,
+unmarked messages are not hashed or considerd for deletion."
+  (interactive)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-read-only)
+  (vm-error-if-folder-empty)
+  (let ((used-marks (eq last-command 'vm-next-command-uses-marks))
+	(mlist vm-message-list)
+	(table (make-vector 61 0))
+	hash m
+	(del-count 0))
+    (if used-marks
+	(setq mlist (vm-select-marked-or-prefixed-messages 0)))
+    (save-excursion
+      (save-restriction
+	(widen)
+	(while mlist
+	  (if (vm-deleted-flag (car mlist))
+	      nil
+	    (setq m (vm-real-message-of (car mlist)))
+	    (set-buffer (vm-buffer-of m))
+	    (setq hash (vm-md5-region (vm-text-of m) (vm-text-end-of m)))
+	    (if (intern-soft hash table)
+		(progn
+		  (vm-set-deleted-flag (car mlist) t)
+		  (vm-increment del-count))
+	      (intern hash table)))
+	  (setq mlist (cdr mlist)))))
+    (vm-display nil nil '(vm-delete-duplicate-messages)
+		(list this-command))
+    (if (zerop del-count)
+	(message "No messages deleted")
+      (message "%d message%s deleted"
+	       del-count
+	       (if (= 1 del-count) "" "s")))
+    (vm-update-summary-and-mode-line)))
+
+(defun vm-expunge-folder (&optional shaddap just-these-messages
+				    messages-to-expunge)
+  "Expunge messages with the `deleted' attribute.
+For normal folders this means that the deleted messages are
+removed from the message list and the message contents are
+removed from the folder buffer.
+
+For virtual folders, messages are removed from the virtual
+message list.  If virtual mirroring is in effect for the virtual
+folder, the corresponding real messages are also removed from real
+message lists and the message contents are removed from real folders.
+
+When invoked on marked messages (via `vm-next-command-uses-marks'),
+only messages both marked and deleted are expunged, other messages are
+ignored."
+  (interactive)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-read-only)
+  ;; do this so we have a clean slate.  code below depends on the
+  ;; fact that the numbering redo start point begins as nil in
+  ;; all folder buffers.
+  (vm-update-summary-and-mode-line)
+  (if (not shaddap)
+      (message "Expunging..."))
+  (let ((use-marks (and (eq last-command 'vm-next-command-uses-marks)
+			(null just-these-messages)))
+	(mp vm-message-list)
+	(virtual (eq major-mode 'vm-virtual-mode))
+	(buffers-altered (make-vector 29 0))
+	prev virtual-messages)
+    (while mp
+      (cond
+       ((if just-these-messages
+	    (memq (car mp) messages-to-expunge)
+	  (and (vm-deleted-flag (car mp))
+	       (or (not use-marks)
+		   (vm-mark-of (car mp)))))
+	;; remove the message from the thread tree.
+	(if (vectorp vm-thread-obarray)
+	    (vm-unthread-message (vm-real-message-of (car mp))))
+	;; expunge from the virtual side first, removing all
+	;; references to this message before actually removing
+	;; the message itself.
+	(cond
+	 ((setq virtual-messages (vm-virtual-messages-of (car mp)))
+	  (let (vms prev curr)
+	    (if virtual
+		(setq vms (cons (vm-real-message-of (car mp))
+				(vm-virtual-messages-of (car mp))))
+	      (setq vms (vm-virtual-messages-of (car mp))))
+	    (while vms
+	      (save-excursion
+		(set-buffer (vm-buffer-of (car vms)))
+		(setq prev (vm-reverse-link-of (car vms))
+		      curr (or (cdr prev) vm-message-list))
+		(intern (buffer-name) buffers-altered)
+		(vm-set-numbering-redo-start-point (or prev t))
+		(vm-set-summary-redo-start-point (or prev t))
+		(if (eq vm-message-pointer curr)
+		    (setq vm-system-state nil
+			  vm-message-pointer (or prev (cdr curr))))
+		(if (eq vm-last-message-pointer curr)
+		    (setq vm-last-message-pointer nil))
+		;; lock out interrupts to preserve message-list integrity
+		(let ((inhibit-quit t))
+		  ;; vm-clear-expunge-invalidated-undos uses
+		  ;; this to recognize expunged messages.
+		  ;; If this stuff is mirrored we'll be
+		  ;; setting this value multiple times if there
+		  ;; are multiple virtual messages referencing
+		  ;; the underlying real message.  Harmless.
+		  (vm-set-deleted-flag-of (car curr) 'expunged)
+		  ;; disable any summary update that may have
+		  ;; already been scheduled.
+		  (vm-set-su-start-of (car curr) nil)
+		  (vm-increment vm-modification-counter)
+		  (if (null prev)
+		      (progn
+			(setq vm-message-list (cdr vm-message-list))
+			(and (cdr curr)
+			     (vm-set-reverse-link-of (car (cdr curr)) nil)))
+		    (setcdr prev (cdr curr))
+		    (and (cdr curr)
+			 (vm-set-reverse-link-of (car (cdr curr)) prev)))
+		  (vm-set-virtual-messages-of (car mp) (cdr vms))
+		  (vm-set-buffer-modified-p t)))
+	      (setq vms (cdr vms))))))
+	(cond
+	 ((or (not virtual-messages)
+	      (not virtual))
+	  (and (not virtual-messages) virtual
+	       (vm-set-virtual-messages-of
+		(vm-real-message-of (car mp))
+		(delq (car mp) (vm-virtual-messages-of
+				(vm-real-message-of (car mp))))))
+	  (if (eq vm-message-pointer mp)
+	      (setq vm-system-state nil
+		    vm-message-pointer (or prev (cdr mp))))
+	  (if (eq vm-last-message-pointer mp)
+	      (setq vm-last-message-pointer nil))
+	  (intern (buffer-name) buffers-altered)
+	  (if (null vm-numbering-redo-start-point)
+	      (progn 
+		(vm-set-numbering-redo-start-point (or prev t))
+		(vm-set-summary-redo-start-point (or prev t))))
+	  ;; lock out interrupt to preserve message list integrity
+	  (let ((inhibit-quit t))
+	    (if (null prev)
+		(progn (setq vm-message-list (cdr vm-message-list))
+		       (and (cdr mp)
+			    (vm-set-reverse-link-of (car (cdr mp)) nil)))
+	      (setcdr prev (cdr mp))
+	      (and (cdr mp) (vm-set-reverse-link-of (car (cdr mp)) prev)))
+	    ;; vm-clear-expunge-invalidated-undos uses this to recognize
+	    ;; expunged messages.
+	    (vm-set-deleted-flag-of (car mp) 'expunged)
+	    ;; disable any summary update that may have
+	    ;; already been scheduled.
+	    (vm-set-su-start-of (car mp) nil)
+	    (vm-set-buffer-modified-p t)
+	    (vm-increment vm-modification-counter))))
+	(if (eq (vm-attributes-of (car mp))
+		(vm-attributes-of (vm-real-message-of (car mp))))
+	    (save-excursion
+	      (set-buffer (vm-buffer-of (vm-real-message-of (car mp))))
+	      (cond ((eq vm-folder-access-method 'pop)
+		     (setq vm-pop-messages-to-expunge
+			   (cons (vm-pop-uidl-of (vm-real-message-of (car mp)))
+				 vm-pop-messages-to-expunge)
+			   ;; Set this so that if Emacs crashes or
+			   ;; the user quits without saving, we
+			   ;; have a record of messages that were
+			   ;; retrieved and expunged locally.
+			   ;; When the user does M-x recover-file
+			   ;; we won't re-retrieve messages the
+			   ;; user has already dealt with.
+			   vm-pop-retrieved-messages
+			   (cons (list (vm-pop-uidl-of
+					(vm-real-message-of (car mp)))
+				       (vm-folder-pop-maildrop-spec)
+				       'uidl)
+				 vm-pop-retrieved-messages)))
+		    ((eq vm-folder-access-method 'imap)
+		     (setq vm-imap-messages-to-expunge
+			   (cons (cons
+				  (vm-imap-uid-of (vm-real-message-of (car mp)))
+				  (vm-imap-uid-validity-of
+				   (vm-real-message-of (car mp))))
+				 vm-imap-messages-to-expunge)
+			   ;; Set this so that if Emacs crashes or
+			   ;; the user quits without saving, we
+			   ;; have a record of messages that were
+			   ;; retrieved and expunged locally.
+			   ;; When the user does M-x recover-file
+			   ;; we won't re-retrieve messages the
+			   ;; user has already dealt with.
+			   vm-imap-retrieved-messages
+			   (cons (list (vm-imap-uid-of
+					(vm-real-message-of (car mp)))
+				       (vm-imap-uid-validity-of
+					(vm-real-message-of (car mp)))
+				       (vm-folder-imap-maildrop-spec)
+				       'uid)
+				 vm-imap-retrieved-messages))))
+	      (vm-increment vm-modification-counter)
+	      (vm-save-restriction
+	       (widen)
+	       (let ((buffer-read-only nil))
+		 (delete-region (vm-start-of (vm-real-message-of (car mp)))
+				(vm-end-of (vm-real-message-of (car mp)))))))))
+       (t (setq prev mp)))
+      (setq mp (cdr mp)))
+    (vm-display nil nil '(vm-expunge-folder) '(vm-expunge-folder))
+    (cond
+     (buffers-altered
+      (save-excursion
+	(mapatoms
+	 (function
+	  (lambda (buffer)
+	    (set-buffer (symbol-name buffer))
+	    (if (null vm-system-state)
+		(progn
+		  (vm-garbage-collect-message)
+		  (if (null vm-message-pointer)
+		      ;; folder is now empty
+		      (progn (setq vm-folder-type nil)
+			     (vm-update-summary-and-mode-line))
+		    (vm-preview-current-message)))
+	      (vm-update-summary-and-mode-line))
+	    (if (not (eq major-mode 'vm-virtual-mode))
+		(setq vm-message-order-changed
+		      (or vm-message-order-changed
+			  vm-message-order-header-present)))
+	    (vm-clear-expunge-invalidated-undos)))
+	 buffers-altered))
+      (if (not shaddap)
+	  (message "Deleted messages expunged.")))
+     (t (message "No messages are flagged for deletion.")))))
+
+(provide 'vm-delete)

File vm-digest.el

+;;; Message encapsulation
+;;; Copyright (C) 1989, 1990, 1993, 1994, 1997, 2001 Kyle E. Jones
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;(provide 'vm-digest)
+
+(defun vm-no-frills-encapsulate-message (m keep-list discard-regexp)