diff lisp/tm/tm-vm.el @ 74:54cc21c15cbb r20-0b32

Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents 131b0175ea99
children 0d2f883870bc
line wrap: on
line diff
--- a/lisp/tm/tm-vm.el	Mon Aug 13 09:03:47 2007 +0200
+++ b/lisp/tm/tm-vm.el	Mon Aug 13 09:04:33 2007 +0200
@@ -9,7 +9,7 @@
 ;;         Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Created: 1994/10/29
-;; Version: $Revision: 1.1.1.1 $
+;; Version: $Revision: 1.1.1.2 $
 ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
 
 ;; This file is part of tm (Tools for MIME).
@@ -35,11 +35,16 @@
 
 ;;; Code:
 
+(eval-when-compile
+  (require 'tm-edit)
+  (require 'tm-mail)
+  (require 'vm)
+  (require 'vm-window))
+
 (require 'tm-view)
-(require 'vm)
 
 (defconst tm-vm/RCS-ID
-  "$Id: tm-vm.el,v 1.1.1.1 1996/12/18 22:43:38 steve Exp $")
+  "$Id: tm-vm.el,v 1.1.1.2 1996/12/21 20:50:47 steve Exp $")
 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
 
 (define-key vm-mode-map "Z" 'tm-vm/view-message)
@@ -175,7 +180,7 @@
 (defun tm-vm/header-filter ()
   "Filter headers in current buffer (assumed to be a message-like buffer)
 according to vm-visible-headers and vm-invisible-header-regexp"
-  (beginning-of-buffer)
+  (goto-char (point-min))
   (let ((visible-headers vm-visible-headers))
     (if (or vm-use-lucid-highlighting
 	    vm-display-xfaces)
@@ -255,7 +260,7 @@
     (set-buffer mbuf)))
 
 (defun tm-vm/preview-current-message ()
-  "Preview current message if it has a MIME contents and 
+  "Preview current message if it has MIME contents and 
 tm-vm/automatic-mime-preview is non nil. Installed on 
 vm-visit-folder-hook and vm-select-message-hook."
   ;; assumed current buffer is folder buffer.
@@ -313,12 +318,14 @@
   (if mime::preview/article-buffer
       (set-buffer mime::preview/article-buffer)
     (vm-select-folder-buffer))
-  (if mime::article/preview-buffer
+  (if (and mime::article/preview-buffer
+	   (get-buffer mime::article/preview-buffer))
       (save-excursion
 	(set-buffer mime::article/preview-buffer)
 	(goto-char (point-min))
 	(widen)))
   (if (or (and mime::article/preview-buffer
+	       (get-buffer mime::article/preview-buffer)
 	       (vm-get-visible-buffer-window mime::article/preview-buffer))
 	  (vm-get-visible-buffer-window (current-buffer)))
       (progn
@@ -378,33 +385,32 @@
              (was-invisible (and (null mwin) (null pwin)))
              )
         ;; now current buffer is folder buffer.
-        (tm-vm/save-window-excursion
-         (if (or mp-changed was-invisible)
-             (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
-                         (list this-command 'reading-message)))
-         (tm-vm/display-preview-buffer)
-         (setq mwin (vm-get-buffer-window mbuf)
-               pwin (and pbuf (vm-get-buffer-window pbuf)))
-         (cond
-          ((or mp-changed was-invisible)
-           nil
-           )
-          ((null pbuf)
-           ;; preview buffer is killed.
-           (tm-vm/preview-current-message)
-           (vm-update-summary-and-mode-line))
-          ((eq (tm-vm/system-state) 'previewing)
-           (tm-vm/show-current-message))
-          (t
-           (select-window pwin)
-           (set-buffer pbuf)
-           (if (pos-visible-in-window-p (point-max) pwin)
-               (tm-vm/next-message)
-             ;; not end of message. scroll preview buffer only.
-             (scroll-up)
-             (tm-vm/howl-if-eom)
-             (set-buffer mbuf))
-           ))))
+	(if (or mp-changed was-invisible)
+	    (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
+			(list this-command 'reading-message)))
+	(tm-vm/display-preview-buffer)
+	(setq mwin (vm-get-buffer-window mbuf)
+	      pwin (and pbuf (vm-get-buffer-window pbuf)))
+	(cond
+	 ((or mp-changed was-invisible)
+	  nil)
+	 ((null pbuf)
+	  ;; preview buffer is killed.
+	  (tm-vm/preview-current-message)
+	  (vm-update-summary-and-mode-line))
+	 ((eq (tm-vm/system-state) 'previewing)
+	  (tm-vm/show-current-message))
+	 (t
+	  (tm-vm/save-window-excursion
+	   (select-window pwin)
+	   (set-buffer pbuf)
+	   (if (pos-visible-in-window-p (point-max) pwin)
+	       (tm-vm/next-message)
+	     ;; not end of message. scroll preview buffer only.
+	     (scroll-up)
+	     (tm-vm/howl-if-eom)
+	     (set-buffer mbuf))
+	   ))))
       )))
 
 ;;; based on vm-scroll-backward [vm-page.el]
@@ -425,29 +431,29 @@
         (if (or mp-changed was-invisible)
             (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
                         (list this-command 'reading-message)))
-        (tm-vm/save-window-excursion
-         (tm-vm/display-preview-buffer)
-         (setq mwin (vm-get-buffer-window mbuf)
-               pwin (and pbuf (vm-get-buffer-window pbuf)))
-         (cond
-          (was-invisible
-           nil
-           )
-          ((null pbuf)
-           ;; preview buffer is killed.
-           (tm-vm/preview-current-message)
-           (vm-update-summary-and-mode-line))
-          ((eq (tm-vm/system-state) 'previewing)
-           (tm-vm/show-current-message))
-          (t
-           (select-window pwin)
-           (set-buffer pbuf)
-           (if (pos-visible-in-window-p (point-min) pwin)
-               nil
-             ;; scroll preview buffer only.
-             (scroll-down)
-             (set-buffer mbuf))
-           ))))
+	(tm-vm/display-preview-buffer)
+	(setq mwin (vm-get-buffer-window mbuf)
+	      pwin (and pbuf (vm-get-buffer-window pbuf)))
+	(cond
+	 (was-invisible
+	  nil
+	  )
+	 ((null pbuf)
+	  ;; preview buffer is killed.
+	  (tm-vm/preview-current-message)
+	  (vm-update-summary-and-mode-line))
+	 ((eq (tm-vm/system-state) 'previewing)
+	  (tm-vm/show-current-message))
+	 (t
+	  (tm-vm/save-window-excursion
+	   (select-window pwin)
+	   (set-buffer pbuf)
+	   (if (pos-visible-in-window-p (point-min) pwin)
+	       nil
+	     ;; scroll preview buffer only.
+	     (scroll-down)
+	     (set-buffer mbuf))
+	   ))))
       )))
 
 ;;; based on vm-beginning-of-message [vm-page.el]
@@ -558,19 +564,6 @@
         (kill-buffer mime::article/preview-buffer)))
   (vm-quit-no-change))
 
-(substitute-key-definition 'vm-scroll-forward
-                           'tm-vm/scroll-forward vm-mode-map)
-(substitute-key-definition 'vm-scroll-backward
-                           'tm-vm/scroll-backward vm-mode-map)
-(substitute-key-definition 'vm-beginning-of-message
-                           'tm-vm/beginning-of-message vm-mode-map)
-(substitute-key-definition 'vm-end-of-message
-                           'tm-vm/end-of-message vm-mode-map)
-(substitute-key-definition 'vm-quit
-                           'tm-vm/quit vm-mode-map)
-(substitute-key-definition 'vm-quit-no-change
-                           'tm-vm/quit-no-change vm-mode-map)
-
 ;;; based on vm-next-message [vm-motion.el]                        
 (defun tm-vm/next-message ()
   (set-buffer mime::preview/article-buffer)
@@ -687,7 +680,8 @@
             (tm-vm/sync-preview-buffer)
             (setq pbuf (and mime::article/preview-buffer
                             (get-buffer mime::article/preview-buffer)))
-            (if pbuf
+            (if (and pbuf
+		     (not (eq this-command 'tm-vm/forward-message)))
                 (if running-xemacs
                     (let ((tmp (generate-new-buffer "tm-vm/tmp")))
                       (set-buffer pbuf)
@@ -965,6 +959,8 @@
   (interactive)
   (if (not (equal vm-forwarding-digest-type "rfc1521"))
       (vm-forward-message)
+    (if mime::preview/article-buffer
+	(set-buffer mime::preview/article-buffer))
     (vm-follow-summary-cursor)
     (vm-select-folder-buffer)
     (vm-check-for-killed-summary)
@@ -1067,7 +1063,7 @@
                'mail-mode (function
                            (lambda ()
                              (interactive)
-                             (sendmail-send-it)
+                             (funcall send-mail-function)
                              )))
     (if (and (string-match "XEmacs\\|Lucid" emacs-version)
              tm-vm/use-xemacs-popup-menu)
@@ -1111,16 +1107,23 @@
 ;;; @ for ps-print (Suggestted by Anders Stenman <stenman@isy.liu.se>)
 ;;;
 
-(require 'ps-print)
+(defvar tm-vm/use-ps-print (not (featurep 'mule))
+  "*Use Postscript printing (ps-print) to print MIME messages.")
 
-(add-hook 'vm-mode-hook 'tm-vm/ps-print-setup)
-(add-hook 'mime-viewer/define-keymap-hook 'tm-vm/ps-print-setup)
-(fset 'vm-toolbar-print-command 'tm-vm/print-message)
+(if tm-vm/use-ps-print
+    (progn
+      (autoload 'ps-print-buffer-with-faces "ps-print" "Postscript Print" t)
+      (add-hook 'vm-mode-hook 'tm-vm/ps-print-setup)
+      (add-hook 'mime-viewer/define-keymap-hook 'tm-vm/ps-print-setup)
+      (fset 'vm-toolbar-print-command 'tm-vm/print-message)))
 
 (defun tm-vm/ps-print-setup ()
   "Set things up for printing MIME messages with ps-print. Set binding to 
 the [Print Screen] key."
-  (local-set-key (ps-prsc) 'tm-vm/print-message)
+  (local-set-key (if running-xemacs
+		     'f22
+		   [f22]) 
+		 'tm-vm/print-message)
   (setq ps-header-lines 3)
   (setq ps-left-header
         (list 'ps-article-subject 'ps-article-author 'buffer-name)))
@@ -1142,6 +1145,35 @@
           (ps-print-buffer-with-faces))
       (vm-print-message))))
 
+
+;;; @ Substitute VM bindings and menus
+;;;
+
+(substitute-key-definition 'vm-scroll-forward
+                           'tm-vm/scroll-forward vm-mode-map)
+(substitute-key-definition 'vm-scroll-backward
+                           'tm-vm/scroll-backward vm-mode-map)
+(substitute-key-definition 'vm-beginning-of-message
+                           'tm-vm/beginning-of-message vm-mode-map)
+(substitute-key-definition 'vm-end-of-message
+                           'tm-vm/end-of-message vm-mode-map)
+(substitute-key-definition 'vm-forward-message
+			   'tm-vm/forward-message vm-mode-map)
+(substitute-key-definition 'vm-quit
+                           'tm-vm/quit vm-mode-map)
+(substitute-key-definition 'vm-quit-no-change
+                           'tm-vm/quit-no-change vm-mode-map)
+
+;; The following function should be modified and called on vm-menu-setup-hook
+;; but VM 5.96 does not run that hook on XEmacs
+(require 'vm-menu)
+(if running-xemacs
+    (condition-case nil
+	(aset (car (find-menu-item vm-menu-dispose-menu '("Forward")))
+	      1
+	      'tm-vm/forward-message)
+      (t nil)))
+
 ;;; @ end
 ;;;