;;;
;;; tm-vm.el --- tm-MUA for VM
;;;
;;; Copyright (C) 1995 Free Software Foundation, Inc.
;;; 
;;; Author:   MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
;;;           Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
;;;           MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;;           Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
;;;           Oscar Figueiredo <figueire@lspsun2.epfl.ch>
;;; modified by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Created: 1994/10/29
;;; Version: $Revision: 7.31 $
;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
;;;
;;; Plese insert (require 'tm-vm) in your ~/.vm or ~/.emacs file.
;;;
;;; 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 2, 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, 675 Mass Ave, Cambridge, MA 02139, USA.

(require 'tm-view)
(require 'vm)

(defconst tm-vm/RCS-ID
  "$Id: tm-vm.el,v 7.31 1995/12/08 22:32:55 morioka 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)


;;; @ for MIME encoded-words
;;;

(defvar tm-vm/use-tm-patch nil
  "Does not decode encoded-words in summary buffer if it is t.
If you use tiny-mime patch for VM (by RIKITAKE Kenji
<kenji@reseau.toyonaka.osaka.jp>), please set it t [tm-vm.el]")

(or tm-vm/use-tm-patch
    (progn
;;;
(defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name)
(setq vm-chop-full-name-function tm-vm/chop-full-name-function)

(defun tm-vm/default-chop-full-name (address)
  (let* ((ret (vm-default-chop-full-name address))
	 (full-name (car ret))
	 )
    (if (stringp full-name)
	(cons (mime-eword/decode-string full-name)
	      (cdr ret))
      ret)))

(require 'vm-summary)
(or (fboundp 'tm:vm-su-subject)
    (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject))
    )
(defun vm-su-subject (m)
  (mime-eword/decode-string (tm:vm-su-subject m))
  )
;;;
))

(defun tm-vm/decode-message-header (&optional count)
  "Decode MIME header of current message through tiny-mime.
Numeric prefix argument COUNT means to decode the current message plus
the next COUNT-1 messages.  A negative COUNT means decode the current
message and the previous COUNT-1 messages.
When invoked on marked messages (via vm-next-command-uses-marks),
all marked messages are affected, other messages are ignored."
  (interactive "p")
  (or count (setq count 1))
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (vm-error-if-folder-read-only)
  (let ((mlist (vm-select-marked-or-prefixed-messages count))
	(realm nil)
	(vlist nil)
	(vbufs nil))
    (save-excursion
      (while mlist
	(setq realm (vm-real-message-of (car mlist)))
	;; Go to real folder of this message.
	;; But maybe this message is already real message...
	(set-buffer (vm-buffer-of realm))
	(let ((buffer-read-only nil))
	  (vm-save-restriction
	   (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
	   (mime/decode-message-header))
	  (let ((vm-message-pointer (list realm))
		(last-command nil))
	    (vm-discard-cached-data))
	  ;; Mark each virtual and real message for later summary
	  ;; update.
	  (setq vlist (cons realm (vm-virtual-messages-of realm)))
	  (while vlist
	    (vm-mark-for-summary-update (car vlist))
	    ;; Remember virtual and real folders related this message,
	    ;; for later display update.
	    (or (memq (vm-buffer-of (car vlist)) vbufs)
		(setq vbufs (cons (vm-buffer-of (car vlist)) vbufs)))
	    (setq vlist (cdr vlist)))
	  (if (eq vm-flush-interval t)
	      (vm-stuff-virtual-attributes realm)
	    (vm-set-modflag-of realm t)))
	(setq mlist (cdr mlist)))
      ;; Update mail-buffers and summaries.
      (while vbufs
	(set-buffer (car vbufs))
	(vm-preview-current-message)
	(setq vbufs (cdr vbufs))))))


;;; @ automatic MIME preview
;;;

(defvar tm-vm/automatic-mime-preview t
  "*If non-nil, show MIME processed article.")

(defun tm-vm/preview-current-message ()
  ;;; suggested by Simon Rowe <smr@robots.oxford.ac.uk>
  ;;;	(cf. [tm-eng:163])
  ;; Selecting a new mail message, but we're already displaying a mime
  ;; on in the window, make sure that the mail buffer is displayed.
  (if (get-buffer-window mime/output-buffer-name)
      (delete-window (get-buffer-window (get-buffer mime/output-buffer-name)))
    )
  ;; fixed by Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
  ;;	1995/12/4 (cf. [tm-ja:1190])
  (if (and vm-message-pointer tm-vm/automatic-mime-preview
	   ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
	   ;;	1995/11/17 (cf. [tm-ja:1120])
      	   (display-buffer (current-buffer))
	   (let* ((mp (car vm-message-pointer))
		  (ct  (vm-get-header-contents mp "Content-Type:"))
		  (cte (vm-get-header-contents
			mp "Content-Transfer-Encoding:"))
		  )
	     ;; Check if this message actually is a mime, or just a text
	     ;; one sent by someone using PINE or similar.
	     (and ct
		  (not (and (string= (car (mime/parse-Content-Type ct))
				     "text/plain")
			    (member cte '("7bit" "8bit" "binary"))
			    ))))
	   )
      (let ((win (selected-window)) buf)
	(setq buf (window-buffer win))
	(let ((pwin (and mime::article/preview-buffer
			 (get-buffer mime::article/preview-buffer)
			 (get-buffer-window mime::article/preview-buffer))))
	  (if (and pwin
                   (not (eq win pwin)))
	      (delete-window pwin)
	    ))
	(vm-display nil nil
		    '(vm-next-message
		      vm-previous-message
		      vm-delete-message
		      vm-undelete-message
		      vm-scroll-forward vm-scroll-backward)
		    (list this-command 'reading-message))
	(setq win (get-buffer-window buf))
	(if win
	    (select-window win)
	  )
	(save-window-excursion
	  (vm-select-folder-buffer)
	  (setq win (get-buffer-window (current-buffer)))
          ;; (vm-display (current-buffer) t
          ;;             '(vm-scroll-forward vm-scroll-backward)
          ;;             (list this-command 'reading-message))
	  ;; (select-window (get-buffer-window (current-buffer)))
	  (mime/viewer-mode)
	  (setq buf (current-buffer))
	  (run-hooks 'tm-vm/select-message-hook)
	  )
	(set-window-buffer win buf)
	;;(select-window win)
	)
    ;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
    ;;	1995/11/17
    (if (and mime::article/preview-buffer
	     (get-buffer mime::article/preview-buffer))
	(kill-buffer mime::article/preview-buffer))
    (if tm-vm/automatic-mime-preview
	(let (buffer-read-only)
	  (mime/decode-message-header)
	  (run-hooks 'tm-vm/select-message-hook)
	  ))
    ))

(add-hook 'vm-select-message-hook 'tm-vm/preview-current-message)

(defun tm-vm/visit-folder-function ()
  (tm-vm/preview-current-message)
  (and vm-mail-buffer (set-buffer vm-mail-buffer))
  )

(add-hook 'vm-visit-folder-hook 'tm-vm/visit-folder-function)

;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
;;	1995/11/14 (cf.[tm-eng:162])
(defun tm-vm/scroll-forward (&optional arg)
  (interactive "P")
  (if (not tm-vm/automatic-mime-preview)
      ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
      ;;	1995/11/17 (cf.[tm-ja:1119])
      (progn
	(setq this-command 'vm-scroll-forward)
	(vm-scroll-forward arg))
    (let* ((summary-buffer (or vm-summary-buffer
			       (and (eq major-mode 'vm-summary-mode)
				    (current-buffer))))
	   (summary-win (get-buffer-window summary-buffer))
	   (mail-buffer (save-excursion
			  (set-buffer summary-buffer)
			  vm-mail-buffer))
	   (mail-win (get-buffer-window mail-buffer))
	   (preview-buf (save-excursion
			  (set-buffer mail-buffer)
			  mime::article/preview-buffer))
	   (preview-win (and preview-buf (get-buffer-window preview-buf)))
	   )
      (if preview-win
	  (progn
	    (select-window preview-win)
	    (if (pos-visible-in-window-p (point-max) preview-win)
		(progn
		  (switch-to-buffer mail-buffer)
		  (goto-char (point-max))
		  (select-window summary-win))
	      (scroll-up)
	      (switch-to-buffer mail-buffer)
	      (select-window summary-win))))
      ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
      ;;	1995/11/17 (cf.[tm-ja:1119])
      (setq this-command 'vm-scroll-forward)
      (vm-scroll-forward arg)
      (save-excursion
	(set-buffer summary-buffer)
	(setq mail-win (get-buffer-window vm-mail-buffer)))
      ;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
      ;;	1995/11/17
      (if (and mail-win
	       mime::article/preview-buffer
	       (get-buffer mime::article/preview-buffer))
	  (progn
	    (select-window mail-win)
	    (switch-to-buffer mime::article/preview-buffer)
	    (select-window summary-win)))
      )))

(defun tm-vm/scroll-backward (&optional arg)
  (interactive "P")
  (if (not tm-vm/automatic-mime-preview)
      ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
      ;;	1995/11/17 (cf.[tm-ja:1119])
      (progn
	(setq this-command 'vm-scroll-backward)
	(vm-scroll-backward arg))
    (let* ((summary-buffer (or vm-summary-buffer
			       (and (eq major-mode 'vm-summary-mode)
				    (current-buffer))))
	   (summary-win (get-buffer-window summary-buffer))
	   (mail-buffer (save-excursion
			  (set-buffer summary-buffer)
			  vm-mail-buffer))
	   (mail-win (get-buffer-window mail-buffer))
	   (preview-buf (save-excursion
			  (set-buffer mail-buffer)
			  mime::article/preview-buffer))
	   (preview-win (and preview-buf (get-buffer-window preview-buf)))
	   )
      (if preview-win
	  (progn
	    (select-window preview-win)
	    (if (pos-visible-in-window-p (point-min) preview-win)
		(progn
		  (switch-to-buffer mail-buffer)
		  (goto-char (point-min))
		  (select-window summary-win))
	      (scroll-down)		
	      (switch-to-buffer mail-buffer)
	      (select-window summary-win))))
      ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
      ;;	1995/11/17 (cf.[tm-ja:1119])
      (setq this-command 'vm-scroll-backward)
      (vm-scroll-backward arg)
      (save-excursion
	(set-buffer summary-buffer)
	(setq mail-win (get-buffer-window vm-mail-buffer)))
      (if (and mail-win
	       mime::article/preview-buffer
	       (get-buffer mime::article/preview-buffer))
	  (progn
	    (select-window mail-win)
	    (goto-char (point-max))
	    (switch-to-buffer mime::article/preview-buffer)
	    (select-window summary-win)))
      )))

(defun tm-vm/over-to-previous-method ()
  (set-buffer mime::preview/article-buffer)
  (setq this-command 'vm-previous-message)
  (let (buf)
    (save-window-excursion
      (vm-previous-message 1 nil t)
      (setq buf
	    (if (and mime::article/preview-buffer
		     (get-buffer mime::article/preview-buffer))
		mime::article/preview-buffer
	      (current-buffer)
	      ))
      )
    (set-window-buffer (selected-window) buf)
    ))

(defun tm-vm/over-to-next-method ()
  (set-buffer mime::preview/article-buffer)
  (setq this-command 'vm-next-message)
  (let (buf)
    (save-window-excursion
      (vm-next-message 1 nil t)
      (setq buf
	    (if (and mime::article/preview-buffer
		     (get-buffer mime::article/preview-buffer)
		     )
		mime::article/preview-buffer
	      (current-buffer)
	      ))
      )
    (set-window-buffer (selected-window) buf)
    ))

(set-alist 'mime-viewer/over-to-previous-method-alist
	   'vm-mode 'tm-vm/over-to-previous-method)
(set-alist 'mime-viewer/over-to-next-method-alist
	   'vm-mode 'tm-vm/over-to-next-method)
(set-alist 'mime-viewer/over-to-previous-method-alist
	   'vm-virtual-mode 'tm-vm/over-to-previous-method)
(set-alist 'mime-viewer/over-to-next-method-alist
	   'vm-virtual-mode 'tm-vm/over-to-next-method)

;; 1995/11/16 by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
(defun tm-vm/expunge-folder ()
  (interactive)
  (let* ((summary-buf (or (and (eq major-mode 'vm-summary-mode)
			       (current-buffer))
			  vm-summary-buffer))
	 (preview-buf (save-excursion
			(set-buffer (save-excursion
				      (set-buffer summary-buf)
				      vm-mail-buffer))
			mime::article/preview-buffer))
	 (preview-win (and preview-buf
			   (get-buffer-window preview-buf)))
	 (win (selected-window)))
    
    (vm-expunge-folder)
    (if preview-win
	(save-excursion
	  (set-buffer summary-buf)
	  (set-buffer vm-mail-buffer)
	  (if (eq (point-min) (point-max))
	      (kill-buffer preview-buf))))
    ))

;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
;;	1995/11/14 (cf. [tm-eng:162])
(defun tm-vm/quit ()
  (interactive)
  (save-excursion
    (vm-select-folder-buffer)
    (if (and mime::article/preview-buffer
	     (get-buffer mime::article/preview-buffer))
	(kill-buffer mime::article/preview-buffer)))
  (vm-quit)
  )

(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-expunge-folder
			   'tm-vm/expunge-folder vm-mode-map)
(substitute-key-definition 'vm-quit
			   'tm-vm/quit vm-mode-map)
;; end


(defun tm-vm/toggle-preview-mode ()
  (interactive)
  (if tm-vm/automatic-mime-preview
      (progn
	(setq tm-vm/automatic-mime-preview nil)
	(vm-select-folder-buffer)
	(vm-display (current-buffer) t
		    '(tm-vm/toggle-preview-mode)
		    '(tm-vm/toggle-preview-mode reading-message))
	)
    (setq tm-vm/automatic-mime-preview t)
    (let ((win (selected-window)))
      (vm-select-folder-buffer)
      (save-window-excursion
	(let* ((mp (car vm-message-pointer))
	       (ct  (vm-get-header-contents mp "Content-Type:"))
	       (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
	       )
	  (mime/viewer-mode nil (mime/parse-Content-Type (or ct "")) cte)
	  ))
      (vm-display mime::article/preview-buffer t
		  '(tm-vm/toggle-preview-mode)
		  '(tm-vm/toggle-preview-mode reading-message))
      (select-window win)
      )
    ))


;;; @ for tm-view
;;;

(defun tm-vm/quit-view-message ()
  "Quit MIME-viewer and go back to VM.
This function is called by `mime-viewer/quit' command via
`mime-viewer/quitting-method-alist'."
  (mime-viewer/kill-buffer)
  (if (get-buffer mime/output-buffer-name)
      (bury-buffer mime/output-buffer-name))
  (vm-select-folder-buffer)
  (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
	      '(mime-viewer/quit reading-message)))

(defun tm-vm/view-message ()
  "Decode and view MIME encoded message, under VM."
  (interactive)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (vm-display (current-buffer) t '(tm-vm/view-message)
              '(tm-vm/view-mesage reading-message))
  (let* ((mp (car vm-message-pointer))
	 (ct  (vm-get-header-contents mp "Content-Type:"))
	 (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
	 (exposed (= (point-min) (vm-start-of mp))))
    (save-restriction
      (vm-widen-page)
      ;; vm-widen-page hides exposed header if pages are delimited.
      ;; So, here we expose it again.
      (if exposed
	  (narrow-to-region (vm-start-of mp) (point-max)))
      (select-window (vm-get-buffer-window (current-buffer)))
      (mime/viewer-mode nil
			(mime/parse-Content-Type (or ct ""))
			cte)
      )))

(set-alist 'mime-viewer/quitting-method-alist
	   'vm-mode
	   'tm-vm/quit-view-message)

(set-alist 'mime-viewer/quitting-method-alist
	   'vm-virtual-mode
	   'tm-vm/quit-view-message)


;;; @ for tm-partial
;;;

(call-after-loaded
 'tm-partial
 (function
  (lambda ()
    (set-atype 'mime/content-decoding-condition
	       '((type . "message/partial")
		 (method . mime-article/grab-message/partials)
		 (major-mode . vm-mode)
		 (summary-buffer-exp . vm-summary-buffer)
		 ))
    (set-alist 'tm-partial/preview-article-method-alist
	       'vm-mode
	       (function
		(lambda ()
		  (tm-vm/view-message)
		  )))
    )))


;;; @ for tm-edit
;;;

;;; @@ for multipart/digest
;;;

(defun tm-vm/enclose-messages (mlist)
  "Enclose the messages in MLIST as multipart/digest.
The resulting digest is inserted at point in the current buffer.

MLIST should be a list of message structs (real or virtual).
These are the messages that will be enclosed."
  (if mlist
      (let ((digest (consp (cdr mlist)))
            m)
	(save-restriction
	  (narrow-to-region (point) (point))
	  (while mlist
	    (setq m (vm-real-message-of (car mlist)))
            (mime-editor/insert-tag "message" "rfc822")
            (tm-mail/insert-message m)
            (goto-char (point-max))
	    (setq mlist (cdr mlist)))
          (if digest
              (mime-editor/enclose-digest-region (point-min) (point-max)))
          ))))

(defun tm-vm/forward-message ()
  "Forward the current message to one or more recipients.
You will be placed in a Mail mode buffer as you would with a
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)
    (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)
        (let ((vm-digest-send-type vm-forwarding-digest-type))
          (setq this-command 'vm-next-command-uses-marks)
          (command-execute 'tm-vm/send-digest))
      (let ((dir default-directory)
            (mp vm-message-pointer))
        (save-restriction
          (widen)
          (vm-mail-internal
           (format "forward of %s's note re: %s"
                   (vm-su-full-name (car vm-message-pointer))
                   (vm-su-subject (car vm-message-pointer)))
           nil
           (and vm-forwarding-subject-format
                (let ((vm-summary-uninteresting-senders nil))
                  (vm-sprintf 'vm-forwarding-subject-format (car mp)))))
          (make-local-variable 'vm-forward-list)
          (setq vm-system-state 'forwarding
                vm-forward-list (list (car mp))
                default-directory dir)
          (goto-char (point-min))
          (re-search-forward
           (concat "^" (regexp-quote mail-header-separator) "\n") nil 0)
          (tm-vm/enclose-messages vm-forward-list)
          (mail-position-on-field "To"))
        (run-hooks 'tm-vm/forward-message-hook)
        (run-hooks 'vm-mail-mode-hook)))))

(defun tm-vm/send-digest (&optional prefix)
  "Send a digest of all messages in the current folder to recipients.
The type of the digest is specified by the variable vm-digest-send-type.
You will be placed in a Mail mode buffer as is usual with replies, but you
must fill in the To: and Subject: headers manually.

If invoked on marked messages (via vm-next-command-uses-marks),
only marked messages will be put into the digest."
  (interactive "P")
  (if (not (equal vm-digest-send-type "rfc1521"))
      (vm-send-digest prefix)
    (vm-select-folder-buffer)
    (vm-check-for-killed-summary)
    (vm-error-if-folder-empty)
    (let ((dir default-directory)
          (mp vm-message-pointer)
          (mlist (if (eq last-command 'vm-next-command-uses-marks)
                     (vm-select-marked-or-prefixed-messages 0)
                   vm-message-list))
          start)
      (save-restriction
        (widen)
        (vm-mail-internal (format "digest from %s" (buffer-name)))
        (setq vm-system-state 'forwarding
              vm-forward-list mlist
              default-directory dir)
        (goto-char (point-min))
        (re-search-forward (concat "^" (regexp-quote mail-header-separator)
                                   "\n"))
        (goto-char (match-end 0))
        (setq start (point)
              mp mlist)
        (vm-unsaved-message "Building %s digest..." vm-digest-send-type)
        (tm-vm/enclose-messages mlist)
        (goto-char start)
        (setq mp mlist)
        (if prefix
	  (progn
            (mime-editor/insert-tag "text" "plain")
	    (vm-unsaved-message "Building digest preamble...")
	    (while mp
	      (let ((vm-summary-uninteresting-senders nil))
		(insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
	      (if vm-digest-center-preamble
		  (progn
		    (forward-char -1)
		    (center-line)
		    (forward-char 1)))
	      (setq mp (cdr mp)))))
        (mail-position-on-field "To")
        (message "Building %s digest... done" vm-digest-send-type)))
    (run-hooks 'tm-vm/send-digest-hook)
    (run-hooks 'vm-mail-mode-hook)))


;;; @@ setting
;;;

(substitute-key-definition 'vm-forward-message
			   'tm-vm/forward-message vm-mode-map)
(substitute-key-definition 'vm-send-digest
			   'tm-vm/send-digest vm-mode-map)

;;; modified by Steven L. Baur <steve@miranova.com>
;;;	1995/12/6 (c.f. [tm-en:209])
(defun mime-editor/attach-to-vm-mode-menu ()
  "Arrange to attach MIME editor's popup menu to VM's"
  (if (boundp 'vm-menu-mail-menu)
      (progn
	(setq vm-menu-mail-menu
	      (nconc vm-menu-mail-menu
		     (list "----")
		     mime-editor/popup-menu-for-xemacs))
	(remove-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
	)))

(call-after-loaded
 'tm-edit
 (function
  (lambda ()
    (autoload 'tm-mail/insert-message "tm-mail")
    (set-alist 'mime-editor/message-inserter-alist
	       'mail-mode (function tm-mail/insert-message))
    (if (string-match "XEmacs\\|Lucid" emacs-version)
	(add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
      )
    )))

(call-after-loaded
 'mime-setup
 (function
  (lambda ()
    ;;(remove-hook 'mail-mode-hook 'mime/editor-mode)
    ;;(add-hook 'vm-mail-mode-hook 'mime/editor-mode)
    (setq vm-forwarding-digest-type "rfc1521")
    (setq vm-digest-send-type "rfc1521")
    )))


;;; @ for BBDB
;;;

(call-after-loaded
 'bbdb-vm
 (function
  (lambda ()
    (or (fboundp 'tm:bbdb/vm-update-record)
	(fset 'tm:bbdb/vm-update-record
	      (symbol-function 'bbdb/vm-update-record))
	)
    (defun bbdb/vm-update-record (&optional offer-to-create)
      (vm-select-folder-buffer)
      (let ((vm-mail-buffer
	     (if (and mime::article/preview-buffer
		      (get-buffer mime::article/preview-buffer))
		 mime::article/preview-buffer
	       (current-buffer)
	       ))
	    (bbdb/vm-update-record-recursive
	     (boundp 'bbdb/vm-update-record-recursive))
	    bbdb/vm-update-record-recursive ret)
	(let ((bbdb/vm-update-record-answer
	       (if (boundp 'bbdb/vm-update-record-answer)
		   (setq bbdb/vm-update-record-answer
			 (or bbdb/vm-update-record-answer
			     (tm:bbdb/vm-update-record)
			     ))
		 (setq ret (tm:bbdb/vm-update-record))
		 nil)))
	  (or bbdb/vm-update-record-answer ret)
	  )))
    (defun tm-vm/bbdb-update-record (&optional offer-to-create)
      (let ((vm-mail-buffer (current-buffer)))
	(tm:bbdb/vm-update-record offer-to-create)
	))
    (remove-hook 'vm-select-message-hook 'bbdb/vm-update-record)
    (remove-hook 'vm-show-message-hook 'bbdb/vm-update-record)
    (add-hook 'tm-vm/select-message-hook 'tm-vm/bbdb-update-record)
    )))


;;; @ end
;;;

(provide 'tm-vm)