;;;
;;; tm-vm.el: tm-MUA for VM
;;; This version is tested under VM-5.76 with tm-6.20
;;;
;;; Written  by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
;;; Modified by SHIONO <jun@p5.nm.fujitsu.co.jp>
;;;         and Steinar Bang <steinarb@falch.no>
;;;         and Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
;;;
;;; Plese insert (require 'tm-vm) in your .vm or .emacs.
;;;

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

(defconst tm-vm/RCS-ID
  "$Id: tm-vm.el,v 6.1 1995/05/16 12:33:21 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)

(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 MIME header
;;;
;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji
;; <kenji@reseau.toyonaka.osaka.jp>), please use following definition:

;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n")
;; (defun vm-summary-function-A (m)
;;   (mime/decode-string (vm-su-subject m)))


;;; @ functions
;;;

(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-field-body/Content-Type
			 (message/unfolding-string (or ct "")))
			cte))))

(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))))))