From: morioka <morioka>
Date: Mon, 2 Mar 1998 13:52:56 +0000 (+0000)
Subject: tm 5.16
X-Git-Tag: tm5_16~1
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=005aa36fcd52725b175fe13376b26a9cbf8dba96;p=elisp%2Ftm.git

tm 5.16
---

diff --git a/Makefile b/Makefile
index 59f6155..7f8c656 100644
--- a/Makefile
+++ b/Makefile
@@ -4,14 +4,22 @@ CFLAGS	= -O
 
 UTILS	= ol2 decode-b
 METHODS	= tm-au tm-file tm-image tm-latex tm-mpeg
-GOMI	= $(UTILS)
-FILES	= README.eng Makefile *.el *.c methods \
-	doc/Makefile doc/*.pln doc/*.ol doc/*.tex
+GOMI	= $(UTILS) *.elc
+FILES	= README.eng Makefile Makefile.18 Makefile.19 *.el *.c methods \
+		doc/Makefile doc/*.pln doc/*.ol doc/*.tex
 
-TARFILE = tm5.15.tar
+TARFILE = tm5.16.tar
 
 all:	$(UTILS) $(DVI)
 
+
+18:
+	make -f Makefile.18
+
+19:
+	make -f Makefile.19
+
+
 ol2:	ol2.c
 	$(CC) $(CFLAGS) ol2.c -o ol2
 
@@ -33,9 +41,15 @@ install:	$(UTILS) methods
 	cp -p $(UTILS) $(bindir)
 	cp -p methods/* $(bindir)
 
+install-18:
+	make -f Makefile.18 install
+
+install-19:
+	make -f Makefile.19 install
+
 
 clean:
-	rm $(GOMI)
+	-rm $(GOMI)
 	(cd doc; make clean)
 
 
diff --git a/Makefile.18 b/Makefile.18
new file mode 100644
index 0000000..35af116
--- /dev/null
+++ b/Makefile.18
@@ -0,0 +1,73 @@
+EMACS	= nemacs
+NEMACS	= nemacs
+MULE	= mule
+
+TLEL	= tl-18.el tl-header.el tl-list.el tl-str.el signature.el
+TLELC	= ${TLEL:el=elc}
+TMEL	= tm-misc.el
+TMELC	= ${TMEL:el=elc}
+TMMEL	= tm-view.el tm-rmail.el tm-comp.el
+TMMELC	= ${TMMEL:el=elc}
+TMVEL	= tm-rich.el tm-vm.el
+TMVELC	= ${TMVEL:el=elc}
+
+TLDIR	= $(HOME)/lib/emacs18/lisp
+TMDIR	= $(HOME)/lib/emacs18/lisp/tm
+	
+
+.SUFFIXES:	.el .elc
+
+.el.elc:
+	$(EMACS) -batch -q . -f batch-byte-compile $<
+
+all:	$(TLELC) tl-nemacs.elc tl-mule.elc \
+	tiny-mime.elc $(TMELC) tm-nemacs.elc tm-mule.elc $(TMMELC) \
+	tm-mh-e.elc tm-gnus.elc $(TMVELC)
+
+$(TLELC):	$(TLEL)
+
+tl-nemacs.elc:	tl-nemacs.el
+
+tl-mule.elc:	tl-mule.el
+
+tiny-mime.elc:	tiny-mime.el
+
+$(TMELC):
+	$(EMACS) -batch -q . -l tiny-mime -f batch-byte-compile $<
+
+tm-nemacs.elc:	tm-nemacs.el
+	$(NEMACS) -batch -q . -l tiny-mime -f batch-byte-compile $<
+
+tm-mule.elc:	tm-mule.el
+	$(MULE) -batch -q . -f batch-byte-compile $<
+
+$(TMMELC):
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -f batch-byte-compile $<
+
+tm-gnus.elc:	tm-gnus.el
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l gnus \
+		-f batch-byte-compile $<
+
+tm-mh-e.elc:	tm-mh-e.el
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l mh-e \
+		-f batch-byte-compile $<
+
+$(TMVELC):
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l tm-view \
+		-f batch-byte-compile $<
+
+install:	all tl-install tm-install
+
+tl-install:
+	-chmod +w $(TLDIR)/*.el
+	cp -p tl-*.el signature.el $(TLDIR)
+	mv tl-*.elc signature.elc $(TLDIR)
+
+tm-install:
+	-chmod +w $(TMDIR)/*.el
+	cp -p tiny-mime.el tm-*.el mime-setup.el \
+		gnushook.el sc-setup.el $(TMDIR)
+	mv tiny-mime.elc tm-*.elc $(TMDIR)
+
+clean:
+	-rm *.elc
diff --git a/Makefile.19 b/Makefile.19
new file mode 100644
index 0000000..6a669f0
--- /dev/null
+++ b/Makefile.19
@@ -0,0 +1,78 @@
+EMACS	= mule2
+ORIG	= emacs19
+MULE	= mule2
+
+TLEL	= tl-header.el tl-str.el signature.el
+TLELC	= ${TLEL:el=elc}
+TMEL	= tm-misc.el
+TMELC	= ${TMEL:el=elc}
+TMMEL	= tm-view.el tm-rmail.el tm-comp.el tm-gnus4.el
+TMMELC	= ${TMMEL:el=elc}
+TMVEL	= tm-rich.el tm-vm.el
+TMVELC	= ${TMVEL:el=elc}
+
+TLDIR	= $(HOME)/lib/emacs19/lisp
+TMDIR	= $(HOME)/lib/emacs19/lisp/tm
+
+
+.SUFFIXES:	.el .elc
+
+.el.elc:
+	$(EMACS) -batch -q . -f batch-byte-compile $<
+
+all:	$(TLELC) tl-orig.elc tl-mule.elc \
+	tiny-mime.elc $(TMELC) tm-orig.elc tm-mule.elc $(TMMELC) \
+	tm-mh-e.elc tm-gnus.elc $(TMVELC)
+
+$(TLELC):	$(TLEL)
+
+tl-orig.elc:	tl-orig.el
+	$(ORIG) -batch -q . -f batch-byte-compile $<
+
+tl-mule.elc:	tl-mule.el
+	$(MULE) -batch -q . -f batch-byte-compile $<
+
+tl-list.elc:	tl-list.el
+	$(EMACS) -batch -q . -l tl-list.el -f batch-byte-compile $<
+
+tiny-mime.elc:	tiny-mime.el
+
+$(TMELC):
+	$(EMACS) -batch -q . -l tiny-mime -f batch-byte-compile $<
+
+tm-orig.elc:	tm-orig.el
+	$(ORIG) -batch -q . -l tl-orig.el -f batch-byte-compile $<
+
+tm-mule.elc:	tm-mule.el
+	$(MULE) -batch -q . -f batch-byte-compile $<
+
+$(TMMELC):
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -f batch-byte-compile $<
+
+tm-gnus.elc:	tm-gnus.el
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l gnus \
+		-f batch-byte-compile $<
+
+tm-mh-e.elc:	tm-mh-e.el
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l mh-e \
+		-f batch-byte-compile $<
+
+$(TMVELC):
+	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l tm-view \
+		-f batch-byte-compile $<
+
+install:	all tl-install tm-install
+
+tl-install:
+	-chmod +w $(TLDIR)/*.el
+	cp -p tl-*.el signature.el $(TLDIR)
+	mv tl-*.elc signature.elc $(TLDIR)
+
+tm-install:
+	-chmod +w $(TMDIR)/*.el
+	cp -p tiny-mime.el tm-*.el mime-setup.el \
+		gnushook.el sc-setup.el $(TMDIR)
+	mv tiny-mime.elc tm-*.elc $(TMDIR)
+
+clean:
+	-rm *.elc
diff --git a/methods/tm-au b/methods/tm-au
index 52e053e..3fccba0 100755
--- a/methods/tm-au
+++ b/methods/tm-au
@@ -30,7 +30,7 @@ case "quoted-printable":
 	mmencode -q -u $1 > $filename
 	breaksw
 default:
-	echo "unkown encoding"
+	echo "unknown encoding"
 	exit -1
 endsw
 
diff --git a/methods/tm-file b/methods/tm-file
index aa94b2f..752e75d 100755
--- a/methods/tm-file
+++ b/methods/tm-file
@@ -30,7 +30,7 @@ case "x-uue":
 	popd
 	breaksw
 default:
-	echo "unkown encoding"
+	echo "unknown encoding"
 	exit -1
 endsw
 
diff --git a/methods/tm-image b/methods/tm-image
index 1a321a7..f5bc63b 100755
--- a/methods/tm-image
+++ b/methods/tm-image
@@ -46,6 +46,9 @@ case "base64":
 case "quoted-printable":
 	mmencode -u -q $1 > $filename
 	breaksw
+default:
+	echo "unknown encoding"
+	exit -1
 endsw
 
 /bin/rm $1
diff --git a/methods/tm-latex b/methods/tm-latex
index 8648050..d4d72c9 100755
--- a/methods/tm-latex
+++ b/methods/tm-latex
@@ -18,7 +18,7 @@ case "quoted-printable":
 	mmencode -q -u $1 > $filename
 	breaksw
 default:
-	echo "unkown encoding"
+	echo "unknown encoding"
 	exit -1
 endsw
 
diff --git a/methods/tm-mpeg b/methods/tm-mpeg
index c5324f7..643421e 100755
--- a/methods/tm-mpeg
+++ b/methods/tm-mpeg
@@ -21,7 +21,7 @@ case "quoted-printable":
 	mmencode -q -u $1 > $filename
 	breaksw
 default:
-	echo "unkown encoding"
+	echo "unknown encoding"
 	exit -1
 endsw
 
diff --git a/methods/tm-plain b/methods/tm-plain
index 9800cdf..f28934f 100755
--- a/methods/tm-plain
+++ b/methods/tm-plain
@@ -21,7 +21,7 @@ case "quoted-printable":
 	mmencode -q -u $1 > $filename
 	breaksw
 default:
-	echo "unkown encoding"
+	echo "unknown encoding"
 	exit -1
 endsw
 
diff --git a/tiny-mime.el b/tiny-mime.el
index bf2c518..07bbbb1 100644
--- a/tiny-mime.el
+++ b/tiny-mime.el
@@ -21,7 +21,7 @@
 ;;; @ version
 ;;;
 (defconst mime/RCS-ID
-  "$Id: tiny-mime.el,v 5.4 1994/10/26 14:45:53 morioka Exp $")
+  "$Id: tiny-mime.el,v 5.5 1994/10/26 18:36:38 morioka Exp $")
 
 (defconst mime/tiny-mime-version (get-version-string mime/RCS-ID))
 
@@ -49,7 +49,7 @@
 	  mime/Quoted-Printable-hex-char-regexp
 	  mime/Quoted-Printable-hex-char-regexp))
 (defconst mime/Quoted-Printable-encoded-text-regexp
-  (concat "\\([^=?_]\\|" mime/Quoted-Printable-octet-regexp "\\)+"))
+  (concat "\\([^=?]\\|" mime/Quoted-Printable-octet-regexp "\\)+"))
 (defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp
   (concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp))
 
diff --git a/tl-list.el b/tl-list.el
index 116b3db..93f861c 100644
--- a/tl-list.el
+++ b/tl-list.el
@@ -1,9 +1,12 @@
 ;;;
-;;; $Id: tl-list.el,v 1.1 1994/10/26 15:55:34 morioka Exp $
+;;; $Id: tl-list.el,v 1.2 1994/10/29 14:40:02 morioka Exp $
 ;;;
 
 (provide 'tl-list)
 
+(require 'tl-str)
+
+
 ;;; @ list
 ;;;
 
diff --git a/tl-nemacs.el b/tl-nemacs.el
index d8b6a6d..78bd3b8 100644
--- a/tl-nemacs.el
+++ b/tl-nemacs.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-nemacs.el,v 1.2 1994/10/20 00:37:15 morioka Exp $
+;;; $Id: tl-nemacs.el,v 2.0 1994/10/29 18:31:55 morioka Exp $
 ;;;
 
 (provide 'tl-nemacs)
@@ -56,3 +56,43 @@ else returns nil. [Mule compatible function in tm-nemacs]"
   (if (< chr 128)
       lc-ascii
     lc-jp))
+
+
+;; by YAMATE Keiichirou 1994/10/28
+(defun attribute-add-narrow-attribute (attr from to)
+  (or (consp (symbol-value attr))
+      (set attr (list 1)))
+  (let* ((attr-value (symbol-value attr))
+	 (len (car attr-value))
+	 (posfrom 1)
+	 posto)
+    (while (and (< posfrom len)
+		(> from (nth posfrom attr-value)))
+      (setq posfrom (1+ posfrom)))
+    (setq posto posfrom)
+    (while (and (< posto len)
+		(> to (nth posto attr-value)))
+      (setq posto (1+ posto)))
+    (if  (= posto posfrom)
+	(if (= (% posto 2) 1)
+	    (if (and (< to len)
+		     (= to (nth posto attr-value)))
+		(set-marker (nth posto attr-value) from)
+	      (setcdr (nthcdr (1- posfrom) attr-value)
+		      (cons (set-marker-type (set-marker (make-marker)
+							 from)
+					     'point-type)
+			    (cons (set-marker-type (set-marker (make-marker)
+							       to)
+						   nil)
+				  (nthcdr posto attr-value))))
+	      (setcar attr-value (+ len 2))))
+      (if (= (% posfrom 2) 0)
+	  (setq posfrom (1- posfrom))
+	(set-marker (nth posfrom attr-value) from))
+      (if (= (% posto 2) 0)
+	  nil
+	(setq posto (1- posto))
+	(set-marker (nth posto attr-value) to))
+      (setcdr (nthcdr posfrom attr-value)
+	      (nthcdr posto attr-value)))))
diff --git a/tl-str.el b/tl-str.el
index 5d38226..deeddb4 100644
--- a/tl-str.el
+++ b/tl-str.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-str.el,v 3.0 1994/10/17 07:16:25 morioka Exp $
+;;; $Id: tl-str.el,v 3.1 1994/10/29 09:48:46 morioka Exp $
 ;;;
 
 (provide 'tl-str)
@@ -58,6 +58,7 @@
 
 ;;; @@ message editing utilities
 ;;;
+(defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*")
 
 (defun fill-cited-region (beg end)
   (interactive "*r")
@@ -71,8 +72,9 @@
       (narrow-to-region beg end)
       (goto-char (point-min))
       (let* ((fill-prefix
-	      (and (re-search-forward "^[^ \t>]*[>|]+[ \t#]*" nil t)
-		   (re-search-forward "^[^ \t>]*[>|]+[ \t#]*" nil t)
+	      (and (re-search-forward cited-prefix-regexp nil t)
+		   (or (re-search-forward cited-prefix-regexp nil t)
+		       t)
 		   (buffer-substring (match-beginning 0)
 				     (match-end 0)
 				     )))
diff --git a/tm-rich.el b/tm-rich.el
index f91a763..f498b72 100644
--- a/tm-rich.el
+++ b/tm-rich.el
@@ -1,76 +1,93 @@
 ;;;
-;;; $Id: tm-rich.el,v 1.2 1994/10/26 15:57:51 morioka Exp $
+;;; $Id: tm-rich.el,v 2.1 1994/10/31 05:05:51 morioka Exp $
+;;;
+;;;          by MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp>
 ;;;
 
 (provide 'tm-rich)
 
 (require 'tm-view)
 
-(if (and (>= (string-to-int emacs-version) 19) window-system)
-    (progn
-      (require 'hilit19)
-      
-      (defun mime/set-face-region (b e face)
-	(let ((sym (intern face)))
-	  (if (eq sym 'italic)
-	      (setq sym 'modeline)
-	    )
-	  (if (member sym (face-list))
-	      (progn
-		(hilit-unhighlight-region b e)
-		(hilit-region-set-face b e sym)
-		))
-	  ))
-      )
-  (defun mime/set-face-region (beg end sym)
-    )
-  )
-
 (defvar mime/text/enriched-face-list
   '("bold" "italic" "fixed" "underline"))
-  
+
+(cond ((and (>= (string-to-int emacs-version) 19) window-system)
+       (require 'hilit19)
+       (defun mime/set-face-region (b e face)
+	 (let ((sym (intern face)))
+	   (if (eq sym 'italic)
+	       (setq sym 'modeline)
+	     )
+	   (if (member sym (face-list))
+	       (progn
+		 (hilit-unhighlight-region b e)
+		 (hilit-region-set-face b e sym)
+		 ))))
+       )
+      ((and (boundp 'NEMACS) NEMACS)
+       (setq mime/text/enriched-face-list
+	     '("bold" "italic" "underline"))
+       (setq mime/text/enriched-face-attribute-alist
+	     '(("bold"      . inversed-region)
+	       ("italic"    . underlined-region)
+	       ("underline" . underlined-region)
+	       ))
+       (defun mime/set-face-region (beg end sym)
+	 (attribute-add-narrow-attribute
+	  (cdr (assoc sym mime/text/enriched-face-attribute-alist))
+	  beg end))
+       )
+      (t
+       (setq mime/text/enriched-face-list
+	     nil)
+       (defun mime/set-face-region (beg end sym)
+	 )
+       ))
+
 (defun mime/decode-text/enriched-region (beg end)
   (interactive "*r")
   (save-excursion
     (save-restriction
       (narrow-to-region beg end)
+      (while (search-forward "\n" nil t)
+	(replace-match "")
+	)
       (goto-char beg)
-      (let (cmd (fb (point)) fe b e)
-	(while (re-search-forward
-		"[ \t\n\r]*<[^<>\n\r \t]+>[ \t\n\r]*" nil t)
-	  (setq cmd (buffer-substring (match-beginning 0) (match-end 0)))
+      (let (cmd str (fb (point)) fe b e)
+	(while (re-search-forward "<[^<>\n\r \t]+>" nil t)
+	  (setq b (match-beginning 0))
+	  (setq cmd (buffer-substring (+ b 1)
+				      (- (match-end 0) 1)))
 	  (replace-match "")
-	  (string-match "^[ \t\n\r]*<" cmd)
-	  (setq cmd (substring cmd (match-end 0)))
-	  (string-match ">[ \t\n\r]*$" cmd)
-	  (setq cmd (substring cmd 0 (match-beginning 0)))
 	  (cond ((string= cmd "nl")
-		 (fill-region fb (point) t)
-		 (insert "\n")
+		 (if (= fb b)
+		     (insert "\n")
+		   (fill-region fb b t)
+		   )
 		 (setq fb (point))
 		 )
 		((member (downcase cmd) mime/text/enriched-face-list)
-		 (if (not (bolp))
-		     (insert " ")
-		   )
 		 (setq b (point))
 		 (save-excursion
 		   (save-restriction
-		     (if (re-search-forward (concat "[ \t\n\r]*</"
-						    cmd ">[ \t\n\r]*")
-					    nil t)
+		     (if (re-search-forward (concat "</" cmd ">") nil t)
 			 (progn
-			   (replace-match " ")
-			   (setq e (- (point) 1))
+			   (replace-match "")
+			   (setq e (point))
 			   )
 		       (setq e end)
 		       )))
 		 (mime/set-face-region b e cmd)
 		 )))
-	(fill-region fb (point) t)
+	(fill-region fb (point-max) t)
+	(goto-char (point-max))
+	(if (not (eq (char-before (point)) ?\n))
+	    (insert "\n")
+	  )
 	))))
 
-(defun mime/decode-text/enriched (ctl)
+(defun mime/decode-text/enriched (&optional ctl)
   (interactive)
   (save-excursion
     (save-restriction
@@ -88,3 +105,4 @@
 
 (set-alist 'mime/content-filter-alist
 	   "text/richtext" (function mime/decode-text/enriched))
+
diff --git a/tm-view.el b/tm-view.el
index c9ef502..aadc2b3 100644
--- a/tm-view.el
+++ b/tm-view.el
@@ -20,7 +20,7 @@
 ;;;
 
 (defconst mime/viewer-RCS-ID
-  "$Id: tm-view.el,v 5.15 1994/10/26 16:02:22 morioka Exp $")
+  "$Id: tm-view.el,v 5.16 1994/10/26 19:03:12 morioka Exp $")
 
 (defconst mime/viewer-version (get-version-string mime/viewer-RCS-ID))
 
@@ -475,16 +475,14 @@
 	(replace-match "")
 	)
       (goto-char (point-min))
-      (while (re-search-forward "_" nil t)
- 	(replace-match " ")
-	)
-      (goto-char (point-min))
-      (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
-	(replace-match
-	 (mime/Quoted-Printable-decode-string
-	  (buffer-substring (match-beginning 0)(match-end 0))
+      (let (b e str)
+	(while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
+	  (setq b (match-beginning 0))
+	  (setq e (match-end 0))
+	  (setq str (buffer-substring b e))
+	  (delete-region b e)
+	  (insert (mime/Quoted-Printable-decode-string str))
 	  ))
-	)
       )))
 
 (defun mime/Base64-decode-region (beg end)
diff --git a/tm-vm.el b/tm-vm.el
index a125131..61184f5 100644
--- a/tm-vm.el
+++ b/tm-vm.el
@@ -2,37 +2,67 @@
 ;;; tm-vm.el : tm-MUA for vm
 ;;;
 ;;; by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
+;;; modified by SHIONO <jun@p5.nm.fujitsu.co.jp>
 ;;;
 ;;; Plese insert (load "tm-vm") in .vm or .emacs.
 ;;;
 
-(define-key vm-mode-map "Z" 'tm-vm/view-message)
+(provide 'tm-vm)
 
 (require 'tl-list)
 (require 'tm-view)
 
-(setq mime/go-to-top-node-method-alist
-      (put-alist 'vm-mode
-		 (function
-		  (lambda ()
-		    (mime/exit-view-mode)
-		    (let ((w (get-buffer-window mime/output-buffer-name)))
-		      (if w (delete-window w)))
-		    (vm-display vm-summary-buffer t
-				'(mime/exit-view-mode)
-				'(this-command))
-		    (vm-widen-page)
-		    (goto-char (point-max))
-		    (widen)
-		    (narrow-to-region (point)
-				      (vm-vheaders-of
-				       (car vm-message-pointer)))
-		    (goto-char (point-min))
-		    (if vm-honor-page-delimiters
-			(vm-narrow-to-page))
-		    (select-window (get-buffer-window vm-summary-buffer))
-		    ))
-		 mime/go-to-top-node-method-alist))
+
+(defconst tm-vm/RCS-ID
+  "$Id: tm-vm.el,v 1.3 1994/10/29 10:01:21 morioka Exp $")
+(defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
+
+
+(define-key vm-mode-map "Z" 'tm-vm/view-message)
+
+(set-alist mime/go-to-top-node-method-alist
+	   'vm-mode
+	   (function
+	    (lambda ()
+	      (mime/exit-view-mode)
+	      (let ((w (get-buffer-window mime/output-buffer-name)))
+		(if w (delete-window w)))
+	      (vm-display vm-summary-buffer t
+			  '(mime/exit-view-mode)
+			  '(this-command))
+	      (vm-widen-page)
+	      (goto-char (point-max))
+	      (widen)
+	      (narrow-to-region (point)
+				(vm-vheaders-of
+				 (car vm-message-pointer)))
+	      (goto-char (point-min))
+	      (if vm-honor-page-delimiters
+		  (vm-narrow-to-page))
+	      (select-window (get-buffer-window vm-summary-buffer))
+	      )))
+(set-alist mime/go-to-top-node-method-alist
+	   'vm-virtual-mode
+	   (function
+	    (lambda ()
+	      (mime/exit-view-mode)
+	      (let ((w (get-buffer-window mime/output-buffer-name)))
+		(if w (delete-window w)))
+	      (vm-display vm-summary-buffer t
+			  '(mime/exit-view-mode)
+			  '(this-command))
+	      (vm-widen-page)
+	      (goto-char (point-max))
+	      (widen)
+	      (narrow-to-region (point)
+				(vm-vheaders-of
+				 (car vm-message-pointer)))
+	      (goto-char (point-min))
+	      (if vm-honor-page-delimiters
+		  (vm-narrow-to-page))
+	      (select-window (get-buffer-window vm-summary-buffer))
+	      ))
+	   )
 
 (defun tm-vm/view-message ()
   "Decode and view MIME message for VM"