xemacs-beta: lisp/tm/tm-vm.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:e2d7a37b7c8d
+:54cc21c15cbb
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
 ;;         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).
 ;; This program is free software; you can redistribute it and/or
 ;;      Plese insert `(require 'tm-vm)' in your ~/.vm file.
 ;;; 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)
 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
 mime-viewer/content-header-filter-alist))
 (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)
 	(setq visible-headers (cons "X-Face:" vm-visible-headers)))
 (vm-reorder-message-headers nil
 ;; don't display if neither mwin nor pwin was displayed before.
 )))
 (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.
 (setq tm-vm/system-state nil)
 (if (get-buffer mime/output-buffer-name)
 (defun tm-vm/show-current-message ()
 "Update current message display and summary. Remove 'unread' and 'new' flags. "
 (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
 (setq tm-vm/system-state 'reading)
 (if (vm-new-flag (car vm-message-pointer))
 (get-buffer mime::article/preview-buffer)))
 (pwin (and pbuf (vm-get-buffer-window pbuf)))
 (was-invisible (and (null mwin) (null pwin)))
 )
 ;; now current buffer is folder buffer.
-(tm-vm/save-window-excursion
+	(if (or mp-changed was-invisible)
-(if (or mp-changed was-invisible)
+	    (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
-(vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
+			(list this-command 'reading-message)))
-(list this-command 'reading-message)))
+	(tm-vm/display-preview-buffer)
-(tm-vm/display-preview-buffer)
+	(setq mwin (vm-get-buffer-window mbuf)
-(setq mwin (vm-get-buffer-window mbuf)
+	      pwin (and pbuf (vm-get-buffer-window pbuf)))
-pwin (and pbuf (vm-get-buffer-window pbuf)))
+	(cond
-(cond
+	 ((or mp-changed was-invisible)
-((or mp-changed was-invisible)
+	  nil)
-nil
+	 ((null pbuf)
-)
+	  ;; preview buffer is killed.
-((null pbuf)
+	  (tm-vm/preview-current-message)
-;; preview buffer is killed.
+	  (vm-update-summary-and-mode-line))
-(tm-vm/preview-current-message)
+	 ((eq (tm-vm/system-state) 'previewing)
-(vm-update-summary-and-mode-line))
+	  (tm-vm/show-current-message))
-((eq (tm-vm/system-state) 'previewing)
+	 (t
-(tm-vm/show-current-message))
+	  (tm-vm/save-window-excursion
-(t
+	   (select-window pwin)
-(select-window pwin)
+	   (set-buffer pbuf)
-(set-buffer pbuf)
+	   (if (pos-visible-in-window-p (point-max) pwin)
-(if (pos-visible-in-window-p (point-max) pwin)
+	       (tm-vm/next-message)
-(tm-vm/next-message)
+	     ;; not end of message. scroll preview buffer only.
-;; not end of message. scroll preview buffer only.
+	     (scroll-up)
-(scroll-up)
+	     (tm-vm/howl-if-eom)
-(tm-vm/howl-if-eom)
+	     (set-buffer mbuf))
-(set-buffer mbuf))
+	   ))))
-))))
 )))
 ;;; based on vm-scroll-backward [vm-page.el]
 (defun tm-vm/scroll-backward (&optional arg)
 (interactive "P")
 )
 ;; now current buffer is folder buffer.
 (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)
-(tm-vm/display-preview-buffer)
+	(setq mwin (vm-get-buffer-window mbuf)
-(setq mwin (vm-get-buffer-window mbuf)
+	      pwin (and pbuf (vm-get-buffer-window pbuf)))
-pwin (and pbuf (vm-get-buffer-window pbuf)))
+	(cond
-(cond
+	 (was-invisible
-(was-invisible
+	  nil
-nil
+	  )
-)
+	 ((null pbuf)
-((null pbuf)
+	  ;; preview buffer is killed.
-;; preview buffer is killed.
+	  (tm-vm/preview-current-message)
-(tm-vm/preview-current-message)
+	  (vm-update-summary-and-mode-line))
-(vm-update-summary-and-mode-line))
+	 ((eq (tm-vm/system-state) 'previewing)
-((eq (tm-vm/system-state) 'previewing)
+	  (tm-vm/show-current-message))
-(tm-vm/show-current-message))
+	 (t
-(t
+	  (tm-vm/save-window-excursion
-(select-window pwin)
+	   (select-window pwin)
-(set-buffer pbuf)
+	   (set-buffer pbuf)
-(if (pos-visible-in-window-p (point-min) pwin)
+	   (if (pos-visible-in-window-p (point-min) pwin)
-nil
+	       nil
-;; scroll preview buffer only.
+	     ;; scroll preview buffer only.
-(scroll-down)
+	     (scroll-down)
-(set-buffer mbuf))
+	     (set-buffer mbuf))
-))))
+	   ))))
 )))
 ;;; based on vm-beginning-of-message [vm-page.el]
 (defun tm-vm/beginning-of-message ()
 "Moves to the beginning of the current message."
 (vm-select-folder-buffer)
 (if (and mime::article/preview-buffer
 (get-buffer mime::article/preview-buffer))
 (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)
 (let ((this-command 'vm-next-message)
 (let* ((mbuf (current-buffer))
 pbuf)
 (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)
 (append-to-buffer tmp (point-min) (point-max))
 (set-buffer tmp)
 reply, but you must fill in the To: header and perhaps the
 Subject: header manually."
 (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)
 (vm-error-if-folder-empty)
 (if (eq last-command 'vm-next-command-uses-marks)
 'mail-mode (function tm-mail/insert-message))
 (set-alist 'mime-editor/split-message-sender-alist
 '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)
 (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
 )
 )))
 ;;; @ 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)
+(if tm-vm/use-ps-print
-(fset 'vm-toolbar-print-command 'tm-vm/print-message)
+(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)))
 (defun tm-vm/print-message ()
 (set-buffer pbuf)
 (require 'ps-print)
 (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
 ;;;
 (provide 'tm-vm)

Mercurial > hg > xemacs-beta

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