;;;
;;; A MIME viewer for GNU Emacs
;;;
;;; by Morioka Tomohiko, 1994/07/13
;;; 

;;; @ require modules
;;;

(require 'tl-str)
(require 'tl-list)
(require 'tl-atype)
(require 'tl-misc)
(require 'tl-header)
(require 'mel)
(require 'tiny-mime)
(require 'tm-def)


;;; @ version
;;;

(defconst mime-viewer/RCS-ID
  "$Id: tm-view.el,v 6.78 1995/09/05 01:08:55 morioka Exp $")

(defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID))
(defconst mime/viewer-version mime-viewer/version)


;;; @ constants
;;;

(defconst mime/content-type-subtype-regexp
  (concat mime/token-regexp "/" mime/token-regexp))
(defconst mime/content-parameter-value-regexp
  (concat "\\("
	  message/quoted-string-regexp
	  "\\|[^; \t\n]*\\)"))

(defconst mime/output-buffer-name "*MIME-out*")
(defconst mime/decoding-buffer-name "*MIME-decoding*")


;;; @ variables
;;;

(defvar mime/content-decoding-condition
  '(((type . "text/plain")
     (method "tm-plain" nil 'file 'type 'encoding 'mode 'name))
    ;;((type . "text/x-latex")
    ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name))
    ((type . "audio/basic")
     (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
    ((type . "image/gif")
     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
    ((type . "image/jpeg")
     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
    ((type . "image/tiff")
     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
    ((type . "image/x-tiff")
     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
    ((type . "image/x-xbm")
     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
    ((type . "image/x-pic")
     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
    ((type . "video/mpeg")
     (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
    ((type . "application/octet-stream")
     (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
    ;;((type . "message/external-body")
    ;; (method "xterm" nil
    ;;	       "-e" "showexternal"
    ;;         'file '"access-type" '"name" '"site" '"directory"))
    ((type . "message/partial")
     (method . mime/decode-message/partial-region))
    ((type . "message/rfc822")
     (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
    ((method "metamail" t
	     "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
    ))

(defvar mime-viewer/childrens-header-showing-Content-Type-list
  '("message/rfc822"))

(defvar mime-viewer/default-showing-Content-Type-list
  '("text/plain" "text/richtext" "text/enriched"
    "text/x-latex" "application/x-latex"
    "application/octet-stream" nil
    "application/x-selection" "application/x-comment"))

(defvar mime-viewer/content-subject-omitting-Content-Type-list
  '("application/x-selection"))

(defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode"))

(defvar mime-viewer/ignored-field-list
  '("Received" "Return-Path" "Replied" "Errors-To"
    "Lines" "Sender" "Path" "Nntp-Posting-Host"
    "Content-Type" "Precedence"))

(defvar mime-viewer/ignored-field-regexp)

(defvar mime-viewer/decoding-mode "play" "MIME body decoding mode")

(defvar mime-viewer/file-name-char-regexp "[A-Za-z0-9+_-]")

(defvar mime-viewer/file-name-regexp-1
  (concat mime-viewer/file-name-char-regexp "+\\."
	  mime-viewer/file-name-char-regexp "+"))

(defvar mime-viewer/file-name-regexp-2
  (concat (regexp-* mime-viewer/file-name-char-regexp)
	  "\\(\\." mime-viewer/file-name-char-regexp "+\\)*"))

(defvar mime-viewer/announcement-for-message/partial
  "[[ This is message/partial style split message. ]]
[[ Please press `v' key in this buffer.         ]]")


;;; @@ predicate functions
;;;

(defun mime-viewer/header-visible-p (cnum cinfo &optional ctype)
  (or (eq cnum t)
      (progn
	(setq ctype
	      (mime::content-info/type
	       (mime-article/cnum-to-cinfo (butlast cnum) cinfo)
	       ))
	(member ctype mime-viewer/childrens-header-showing-Content-Type-list)
	)))

(defun mime-viewer/body-visible-p (cnum cinfo &optional ctype)
  (let (ccinfo)
    (or ctype
	(setq ctype
	      (mime::content-info/type
	       (setq ccinfo (mime-article/cnum-to-cinfo cnum cinfo))
	       ))
	)
    (and (member ctype mime-viewer/default-showing-Content-Type-list)
	 (if (string-equal ctype "application/octet-stream")
	     (progn
	       (or ccinfo
		   (setq ccinfo (mime-article/cnum-to-cinfo cnum cinfo))
		   )
	       (member (mime::content-info/encoding ccinfo)
		       '(nil "7bit" "8bit"))
	       )
	   t))
    ))


;;; @@ content subject
;;;

(defun mime-viewer/insert-content-subject
  (cnum cinfo ctype params subj)
  (insert
   (let ((access-type (assoc "access-type" params))
	 (num (or (assoc-value "x-part-number" params)
		  (if (listp cnum)
		      (mapconcat (function
				  (lambda (num)
				    (format "%s" (+ num 1))
				    ))
				 cnum ".")
		    "0"))
	      ))
     (if access-type
	 (let ((server (assoc "server" params)))
	   (setq access-type (cdr access-type))
	   (if server
	       (format "[%s %s ([%s] %s)]\n" num subj
		       access-type (cdr server))
	     (let ((site (assoc-value "site" params))
		   (dir (assoc-value "directory" params))
		   )
	       (format "[%s %s ([%s] %s:%s)]\n" num subj
		       access-type site dir)
	       )))
       (format "[%s %s (%s)]\n" num subj ctype)
       ))))

(defun mime-viewer/default-content-subject-function
  (cnum cinfo ctype params subj)
  (if (and (listp cnum)
	   (not (member
		 ctype
		 mime-viewer/content-subject-omitting-Content-Type-list))
	   )
      (mime-viewer/insert-content-subject
       cnum cinfo ctype params subj)
    ))

(defvar mime-viewer/content-subject-function
  (function mime-viewer/default-content-subject-function))


;;; @ content header filter
;;;

(defun mime-viewer/default-content-header-filter ()
  (goto-char (point-min))
  (while (and (re-search-forward
	       (concat "^" mime-viewer/ignored-field-regexp ":")
	       nil t)
	      (progn
		(delete-region
		 (match-beginning 0)
		 (save-excursion
		   (and
		    (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
		    (match-beginning 0)
		    )))
		t)))
  (mime/decode-message-header)
  )

(defvar mime-viewer/content-header-filter-alist nil)


;;; @@ content filter
;;;

(defvar mime-viewer/content-filter-alist
  '(("text/plain" . mime-viewer/filter-text/plain)
    (nil . mime-viewer/filter-text/plain)))

(defun mime-viewer/default-content-filter (cnum cinfo ctype params subj)
  )


;;; @@ content separator
;;;

(defun mime-viewer/default-content-separator (cnum cinfo ctype params subj)
  (if (and (not (mime-viewer/header-visible-p cnum cinfo ctype))
	   (not (mime-viewer/body-visible-p cnum cinfo ctype))
	   )
      (progn
	(goto-char (point-max))
	(insert "\n")
	)))


;;; @@ buffer local variables
;;;

(defvar mime::article/content-info nil)
(defvar mime::article/preview-buffer nil)

(defvar mime::preview/article-buffer nil)
(defvar mime::preview/content-list nil)
(defvar mime::preview/original-major-mode nil)


;;; @@ quitting method
;;;

(defvar mime-viewer/quitting-method-alist
  '((mime/show-message-mode
     . (lambda ()
	 (set-window-configuration
	  mime/show-mode-old-window-configuration)
	 (let ((mother mime/mother-buffer))
	   (kill-buffer
	    (mime::preview-content-info/buffer
	     (car mime::preview/content-list)))
	   (mime-viewer/kill-buffer)
	   (pop-to-buffer mother)
	   (goto-char (point-min))
	   (mime-viewer/up-content)
	   )))
    ))


;;; @ data structures
;;;

;;; @@ content-info
;;;
(define-structure mime::content-info
  point-min point-max type parameters encoding children)

;;; @@ preview-content-info
;;;
(define-structure mime::preview-content-info
  point-min point-max buffer content-info)


;;; @ parser
;;;

(defun mime-viewer/parse-message (&optional ctl encoding)
  (make-variable-buffer-local 'mime::article/content-info)
  (setq mime::article/content-info (mime-viewer/parse ctl encoding))
  (let ((ret (mime-viewer/make-preview-buffer)))
    (make-variable-buffer-local 'mime::article/preview-buffer)
    (setq mime::article/preview-buffer (car ret))
    ret))

(defun mime-viewer/parse (&optional ctl encoding)
  (save-excursion
    (save-restriction
      (setq ctl (or (mime/Content-Type)
		    ctl))
      (setq encoding (or (mime/Content-Transfer-Encoding)
			 encoding))
      (let ((ctype (car ctl))
	    (params (cdr ctl))
	    )
	(let ((boundary (assoc "boundary" params)))
	  (goto-char (point-min))
	  (search-forward "\n\n" nil t)
	  (cond (boundary
		 (save-excursion
		   (save-restriction
		     (setq boundary
			   (message/strip-quoted-string (cdr boundary)))
		     (narrow-to-region
		      (point-min)
		      (if (re-search-forward
			   (concat "^--" (regexp-quote boundary) "--$") nil t)
			  (match-beginning 0)
			(point-max)
			))
		     (mime-viewer/parse-multipart 
		      (point-min)
		      (point-max)
		      boundary ctype params encoding)
		     )))
		((string= ctype "message/rfc822")
		 (mime::content-info/create
		  (point-min) (point-max)
		  ctype params encoding
		  (save-excursion
		    (save-restriction
		      (narrow-to-region (progn
					  (goto-char (point-min))
					  (if (re-search-forward "^$" nil t)
					      (+ (match-end 0) 1)
					    (point-min)
					    ))
					(point-max))
		      (list (mime-viewer/parse))
		      ))
		  )
		 )
		(t 
		 (mime::content-info/create (point-min) (point-max)
					  ctype params encoding nil)
		 ))
	  )))))

(defun mime-viewer/parse-multipart (beg end boundary ctype params encoding)
  (let ((sep (concat "^--" (regexp-quote boundary) "$"))
	cb ce ct ret ncb children)
    (save-excursion
      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
	(search-forward (concat "--" boundary "\n") nil t)
	(setq cb (match-end 0))
	(while (re-search-forward sep nil t)
	  (setq ce (match-beginning 0))
	  (setq ncb (match-end 0))
	  (save-excursion
	    (save-restriction
	      (narrow-to-region cb ce)
	      (setq ret (apply (function mime-viewer/parse)
			       (cond ((string= ctype "multipart/digest")
				      '(("message/rfc822") "7bit")
				      )
				     (t '(("text/plain") "7bit"))
				     )
			       ))
	      ))
	  (setq children (nconc children (list ret)))
	  (goto-char (mime::content-info/point-max ret))
	  (search-forward (concat "--" boundary "\n") nil t)
	  (goto-char (setq cb (match-end 0)))
	  )
	(setq ce (point-max))
	(save-excursion
	  (save-restriction
	    (narrow-to-region cb ce)
	    (setq ret (apply (function mime-viewer/parse)
			     (cond ((string= ctype "multipart/mixed")
				    '(("text/plain") "7bit")
				    )
				   ((string= ctype "multipart/digest")
				    '(("message/rfc822") "7bit")
				    ))
			     ))
	    ))
	(setq children (nconc children (list ret)))
	))
    (setq beg (point-min))
    (goto-char beg)
    (mime::content-info/create beg end ctype params encoding children)
    ))

(defun mime::parse-parameter (str)
  (let ((ret (message::parse "\;" str)))
    (if ret
	(if (setq ret
		  (message::parse mime/token-regexp
				  (message::parsed/rest ret)))
	    (let ((parameter (downcase (message::parsed/matched ret))))
	      (if (setq ret (message::parse "=" (message::parsed/rest ret)))
		  (if (setq ret
			    (message::parse
			     mime/content-parameter-value-regexp
			     (message::parsed/rest ret)))
		      (message::make-parsed
		       (cons parameter
			     (message/strip-quoted-string
			      (message::parsed/matched ret))
			     )
		       (message::parsed/rest ret)
		       )
		    )))))))

(defun mime::parse-field-body/Content-Type (str)
  (let ((ret (message::parse mime/content-type-subtype-regexp str)))
    (if ret
	(let ((ctype (downcase (message::parsed/matched ret)))
	      dest)
	  (while (progn
		   (setq str (message::parsed/rest ret))
		   (setq ret (mime::parse-parameter str))
		   )
	    (setq dest (cons (message::parsed/matched ret) dest))
	    )
	  (if (string-match "^[ \t]*$" str)
	      (cons ctype (reverse dest))
	    )))))

(defun mime/Content-Type (&optional port)
  "Read field-body of Content-Type field from PORT and parse it.
PORT must be buffer or string. If PORT is omitted,
it is regarded as current-buffer. [tm-view]"
  (or port
      (setq port (current-buffer))
      )
  (let ((str (if (get-buffer port)
		 (save-window-excursion
		   (switch-to-buffer port)
		   (message/get-field-body "Content-Type")
		   )
	       port)
	     ))
    (if str
	(mime::parse-field-body/Content-Type
	 (message/unfolding-string str))
      )))

(defun mime/Content-Transfer-Encoding (&optional default-encoding)
  (let ((str (message/get-field-body "Content-Transfer-Encoding")))
    (if str
	(downcase str)
      default-encoding)
      ))

(defun mime-viewer/get-subject (param)
  (if (member (cdr (assq 'encoding param))
	      mime-viewer/uuencode-encoding-name-list)
      (save-excursion
	(or (if (re-search-forward "^begin [0-9]+ " nil t)
		(if (looking-at ".+$")
		    (buffer-substring (match-beginning 0)(match-end 0))
		  ))
	    ""))
    (let (ret)
      (or (and (setq ret (assoc "name" param))
	       (message/strip-quoted-string (cdr ret))
	       )
	  (and (setq ret (assoc "x-name" param))
	       (message/strip-quoted-string (cdr ret))
	       )
	  
	  (save-excursion
	    (save-restriction
	      (narrow-to-region (point-min)
				(or (and (search-forward "\n\n" nil t)
					 (match-beginning 0)
					 )
				    (point-max)))
	      (or
	       (message/get-field-body "Content-Description")
	       (message/get-field-body "Subject")
	       )))
	  ""))
    ))

(defun mime-viewer/get-name (param)
  (let ((str (mime-viewer/get-subject param)))
    (if (string-match " " str)
	(if (or (string-match mime-viewer/file-name-regexp-1 str)
		(string-match mime-viewer/file-name-regexp-2 str))
	    (substring str (match-beginning 0)(match-end 0))
	  )
      (replace-as-filename str)
      )))

(defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf)
  (let ((the-buf (current-buffer))
	(mode major-mode)
	pcl dest)
    (setq buf
	  (if (null buf)
	      (current-buffer)
	    (prog1
		(get-buffer buf)
	      (switch-to-buffer buf)
	      )))
    (or cinfo
	(setq cinfo mime::article/content-info)
	)
    (or obuf
	(setq obuf (concat "*Preview-" (buffer-name buf) "*"))
	)
    (setq pcl (mime::make-flat-content-list cinfo))
    (let ((bf (get-buffer obuf)))
      (switch-to-buffer obuf)
      (setq buffer-read-only nil)
      (if bf
	  (erase-buffer)
	))
    (make-variable-buffer-local 'mime::preview/article-buffer)
    (setq mime::preview/article-buffer the-buf)
    (make-variable-buffer-local 'mime::preview/original-major-mode)
    (setq mime::preview/original-major-mode mode)
    (setq major-mode 'mime/viewer-mode)
    (setq mode-name "MIME-View")
    (setq dest
	  (mapcar
	   (function
	    (lambda (cell)
	      (let ((beg (mime::content-info/point-min cell))
		    (end (mime::content-info/point-max cell))
		    (ctype (mime::content-info/type cell))
		    (params (mime::content-info/parameters cell))
		    (encoding (mime::content-info/encoding cell))
		    he cnum e nb ne subj str)
		(setq cnum (mime::get-point-content-number beg cinfo))
		(switch-to-buffer the-buf)
		(setq he (save-excursion
			   (goto-char beg)
			   (re-search-forward "^$" nil t)
			   (+ (match-end 0) 1)
			   ))
		(if (> he (point-max))
		    (setq he (point-max))
		  )
		(save-excursion
		  (save-restriction
		    (narrow-to-region beg he)
		    (setq subj (mime-viewer/get-subject params))
		    ))
		(switch-to-buffer obuf)
		(setq nb (point))
		(narrow-to-region nb nb)
		(switch-to-buffer the-buf)
		(if (mime-viewer/header-visible-p cnum cinfo ctype)
		    (progn
		      (setq str (buffer-substring beg he))
		      (switch-to-buffer obuf)
		      (insert str)
		      (let ((f (assq
				mode
				mime-viewer/content-header-filter-alist))
			    )
			(if (and f (setq f (cdr f)))
			    (funcall f)
			  (mime-viewer/default-content-header-filter)
			  ))
		      (run-hooks 'mime-viewer/content-header-filter-hook)
		      (switch-to-buffer the-buf)
		      ))
		(cond ((mime-viewer/body-visible-p cnum cinfo ctype)
		       (let (be)
			 (setq str (buffer-substring he end))
			 (switch-to-buffer obuf)
			 (save-restriction
			   (setq be (point-max))
			   (narrow-to-region be be)
			   (insert str)
			   (setq ne (point-max))
			   (let ((f (or (assoc-value
					 ctype
					 mime-viewer/content-filter-alist)
					)))
			     (if (and f (fboundp f))
				 (funcall f ctype params encoding)
			       (mime-viewer/default-content-filter
				cnum cinfo ctype params subj)
			       ))
			   (setq ne (point-max))
			   )
			 (switch-to-buffer the-buf)
			 ))
		      ((equal ctype "message/partial")
		       (let (be)
			 (switch-to-buffer obuf)
			 (save-restriction
			   (setq be (point-max))
			   (narrow-to-region be be)
			   (insert
			    mime-viewer/announcement-for-message/partial)
			   (setq ne (point-max))
			   )
			 (switch-to-buffer the-buf)
			 ))
		      ((and (eq cnum t)
			    (null (mime::content-info/children cinfo))
			    )
		       (let (be)
			 (switch-to-buffer obuf)
			 (save-restriction
			   (setq be (point-max))
			   (narrow-to-region be be)
			   (mime-viewer/insert-content-subject
			    cnum cinfo ctype params subj)
			   (setq ne (point-max))
			   )
			 (switch-to-buffer the-buf)
			 ))
		      )
		(switch-to-buffer obuf)
		(mime-viewer/default-content-separator
	         cnum cinfo ctype params subj)
		(prog1
		    (progn
		      (goto-char nb)
		      (funcall mime-viewer/content-subject-function
			       cnum cinfo ctype params subj)
		      (setq ne (point-max))
		      (widen)
		      (mime::preview-content-info/create nb (- ne 1)
							 buf cell)
		      )
		  (goto-char ne)
		  ))))
	   pcl))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (switch-to-buffer the-buf)
    (list obuf dest)
    ))


;;; @ content information
;;;

(defun mime::get-point-content-number (p &optional cinfo)
  (or cinfo
      (setq cinfo mime::article/content-info)
      )
  (let ((b (mime::content-info/point-min cinfo))
	(e (mime::content-info/point-max cinfo))
	(c (mime::content-info/children cinfo))
	)
    (if (and (<= b p)(<= p e))
	(or (let (co ret (sn 0))
	      (catch 'tag
		(while c
		  (setq co (car c))
		  (setq ret (mime::get-point-content-number p co))
		  (cond ((eq ret t) (throw 'tag (list sn)))
			(ret (throw 'tag (cons sn ret)))
			)
		  (setq c (cdr c))
		  (setq sn (+ sn 1))
		  )))
	    t))))

(defun mime-article/cnum-to-cinfo (cn &optional cinfo)
  (or cinfo
      (setq cinfo mime::article/content-info)
      )
  (if (eq cn t)
      cinfo
    (let ((sn (car cn)))
      (if (null sn)
	  cinfo
	(let ((rc (nth sn (mime::content-info/children cinfo))))
	  (if rc
	      (mime-article/cnum-to-cinfo (cdr cn) rc)
	    ))
	))))

(defun mime::make-flat-content-list (&optional cinfo)
  (or cinfo
      (setq cinfo mime::article/content-info)
      )
  (let ((dest (list cinfo))
	(rcl (mime::content-info/children cinfo))
	)
    (while rcl
      (setq dest (nconc dest (mime::make-flat-content-list (car rcl))))
      (setq rcl (cdr rcl))
      )
    dest))

(defun mime::point-preview-content (p &optional pcl)
  (or pcl
      (setq pcl mime::preview/content-list)
      )
  (catch 'tag
    (let ((r pcl) cell)
      (while r
	(setq cell (car r))
	(if (and (<= (mime::preview-content-info/point-min cell) p)
		 (<= p (mime::preview-content-info/point-max cell))
		 )
	    (throw 'tag cell)
	  )
	(setq r (cdr r))
	))
    (car (last pcl))
    ))


;;; @ decoder
;;;

(defun mime/make-method-args (cal format)
  (mapcar (function
	   (lambda (arg)
	     (if (stringp arg)
		 arg
	       (let ((ret (cdr (assoc (eval arg) cal))))
		 (if ret
		     ret
		   "")
		 ))
	     ))
	  format))

(defun mime/start-external-method-region (beg end cal)
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char beg)
      (let ((method (cdr (assoc 'method cal)))
	    (name (mime-viewer/get-name cal))
	    )
	(if method
	    (let ((file (make-temp-name
			 (expand-file-name "TM" mime/tmp-dir)))
		  b args)
	      (if (nth 1 method)
		  (setq b beg)
		(setq b
		      (if (re-search-forward "^$" nil t)
			  (+ (match-end 0) 1)
			(point-min)
			))
		)
	      (goto-char b)
	      (write-region b end file)
	      (setq cal (put-alist
			 'name (replace-as-filename name) cal))
	      (setq cal (put-alist 'file file cal))
	      (setq args (nconc
			  (list (car method)
				mime/output-buffer-name (car method)
				)
			  (mime/make-method-args cal (cdr (cdr method)))
			  ))
	      (apply (function start-process) args)
	      (mime/show-output-buffer)
	      ))
	))))

(defun mime/decode-message/partial-region (beg end cal)
  (goto-char beg)
  (let* ((root-dir (expand-file-name
		    (concat "m-prts-" (user-login-name)) mime/tmp-dir))
	 (id (cdr (assoc "id" cal)))
	 (number (cdr (assoc "number" cal)))
	 (total (cdr (assoc "total" cal)))
	 (the-buf (current-buffer))
	 file
	 (mother mime::article/preview-buffer))
    (if (not (file-exists-p root-dir))
	(make-directory root-dir)
      )
    (setq id (replace-as-filename id))
    (setq root-dir (concat root-dir "/" id))
    (if (not (file-exists-p root-dir))
	(make-directory root-dir)
      )
    (setq file (concat root-dir "/FULL"))
    (if (not (file-exists-p file))
	(progn
	  (re-search-forward "^$")
	  (goto-char (+ (match-end 0) 1))
	  (setq file (concat root-dir "/" number))
	  (write-region (point) (point-max) file)
	  (if (get-buffer "*MIME-temp*")
	      (kill-buffer "*MIME-temp*")
	    )
	  (switch-to-buffer "*MIME-temp*")
	  (let ((i 1)
		(max (string-to-int total))
		)
	    (catch 'tag
	      (while (<= i max)
		(setq file (concat root-dir "/" (int-to-string i)))
		(if (not (file-exists-p file))
		    (progn
		      (switch-to-buffer the-buf)
		      (throw 'tag nil)
		      ))
		(insert-file-contents file)
		(goto-char (point-max))
		(setq i (+ i 1))
		)
	      (delete-other-windows)
	      (write-file (concat root-dir "/FULL"))
	      (setq major-mode 'mime/show-message-mode)
	      (mime/viewer-mode mother)
	      (pop-to-buffer (current-buffer))
	      ))
	  )
      (progn
	(delete-other-windows)
	(find-file file)
	(setq major-mode 'mime/show-message-mode)
	(mime/viewer-mode mother)
	(pop-to-buffer (current-buffer))
	))
    ))

(defun mime/get-content-decoding-alist (al)
  (get-unified-alist mime/content-decoding-condition al)
  )

(defun mime::article/decode-content-region (cinfo)
  (let ((beg (mime::content-info/point-min cinfo))
	(end (mime::content-info/point-max cinfo))
	(ctype (mime::content-info/type cinfo))
	(params (mime::content-info/parameters cinfo))
	(encoding (mime::content-info/encoding cinfo))
	)
    (if ctype
	(let (method cal ret)
	  (setq cal (append (list (cons 'type ctype)
				  (cons 'encoding encoding)
				  (cons 'major-mode major-mode)
				  )
			    params))
	  (if mime-viewer/decoding-mode
	      (setq cal (cons
			 (cons 'mode mime-viewer/decoding-mode)
			 cal))
	    )
	  (setq ret (mime/get-content-decoding-alist cal))
	  (setq method (cdr (assoc 'method ret)))
	  (cond ((and (symbolp method)
		      (fboundp method))
		 (funcall method beg end ret)
		 )
		((and (listp method)(stringp (car method)))
		 (mime/start-external-method-region beg end ret)
		 )
		(t (mime/show-output-buffer
		    "No method are specified for %s\n" ctype)
		   ))
	  ))
    ))

(defun mime/show-output-buffer (&rest forms)
  (let ((the-buf (current-buffer)))
    (if (null (get-buffer-window mime/output-buffer-name))
	(split-window-vertically (/ (* (window-height) 3) 4))
      )
    (pop-to-buffer mime/output-buffer-name)
    (goto-char (point-max))
    (if forms
	(insert (apply (function format) forms))
      )
    (pop-to-buffer the-buf)
    ))


;;; @ content filter
;;;

(defvar mime-viewer/code-converter-alist nil)

(defun mime-viewer/default-code-convert-region
  (beg end charset &optional encoding)
  (if (member encoding '("quoted-printable" "base64"))
      (mime/code-convert-region-to-emacs beg (point-max) charset)
    ))

(defun mime-viewer/filter-text/plain (ctype params encoding)
  (let ((charset (cdr (assoc "charset" params)))
	(beg (point-min)) (end (point-max))
	)
    (goto-char (point-min))
    (cond ((string= encoding "quoted-printable")
	   (quoted-printable-decode-region beg end)
	   )
	  ((string= encoding "base64")
	   (base64-decode-region beg end)
	   ))
    (let* ((mode mime::preview/original-major-mode)
	   (m (assq mode mime-viewer/code-converter-alist))
	   )
      (if (and m (fboundp (setq m (cdr m))))
	  (funcall m beg (point-max) charset encoding)
	(mime-viewer/default-code-convert-region beg (point-max)
						 charset encoding)
	)))
  (goto-char (point-max))
  (if (not (eq (char-after (1- (point))) ?\n))
      (insert "\n")
    )
  ;;(hide-sublevels 1)
  (run-hooks 'mime-viewer/plain-text-preview-hook)
  )


;;; @ MIME viewer mode
;;;

(defvar mime/viewer-mode-map nil)
(if (null mime/viewer-mode-map)
    (progn
      (setq mime/viewer-mode-map (make-keymap))
      (suppress-keymap mime/viewer-mode-map)
      (define-key mime/viewer-mode-map
	"u"        (function mime-viewer/up-content))
      (define-key mime/viewer-mode-map
	"p"        (function mime-viewer/previous-content))
      (define-key mime/viewer-mode-map
	"n"        (function mime-viewer/next-content))
      (define-key mime/viewer-mode-map
	" "        (function mime-viewer/scroll-up-content))
      (define-key mime/viewer-mode-map
	"\M- "     (function mime-viewer/scroll-down-content))
      (define-key mime/viewer-mode-map
	"\177"     (function mime-viewer/scroll-down-content))
      (define-key mime/viewer-mode-map
	"\C-m"     (function mime-viewer/next-line-content))
      (define-key mime/viewer-mode-map
	"\C-\M-m"  (function mime-viewer/previous-line-content))
      (define-key mime/viewer-mode-map
	"v"        (function mime-viewer/play-content))
      (define-key mime/viewer-mode-map
	"e"	   (function mime-viewer/extract-content))
      (define-key mime/viewer-mode-map
	"\C-c\C-p" (function mime-viewer/print-content))
      (define-key mime/viewer-mode-map
	"q"        (function mime-viewer/quit))
      (define-key mime/viewer-mode-map
	"\C-c\C-x" (function mime-viewer/kill-buffer))
      ))

(defun mime/viewer-mode (&optional mother ctl encoding)
  "Major mode for viewing MIME message.

u	Move to upper content
p	Move to previous content
n	Move to next content
SPC	Scroll up
M-SPC	Scroll down
DEL	Scroll down
RET	Move to next line
M-RET	Move to previous line
v	Decode the content as `play mode'
e	Decode the content as `extract mode'
C-c C-p	Decode the content as `print mode'
q	Quit
"
  (interactive)
  (setq mime-viewer/ignored-field-regexp
	(concat "\\("
		(mapconcat (function regexp-quote)
			   mime-viewer/ignored-field-list "\\|")
		"\\)"))
  (let ((buf (get-buffer mime/output-buffer-name))
	(the-buf (current-buffer))
	)
    (if buf
	(progn
	  (switch-to-buffer buf)
	  (erase-buffer)
	  (switch-to-buffer the-buf)
	  )))
  (let ((ret (mime-viewer/parse-message ctl encoding))) 
    (prog1
	(switch-to-buffer (car ret))
      (if mother
	  (progn
	    (make-variable-buffer-local
	     'mime/show-mode-old-window-configuration)
	    (setq mime/show-mode-old-window-configuration
		  (current-window-configuration))
	    (make-variable-buffer-local 'mime/mother-buffer)
	    (setq mime/mother-buffer mother)
	    ))
      (use-local-map mime/viewer-mode-map)
      (make-variable-buffer-local 'mime::preview/content-list)
      (setq mime::preview/content-list (nth 1 ret))
      (goto-char
       (let ((ce (mime::preview-content-info/point-max
		  (car mime::preview/content-list)
		  ))
	     e)
	 (goto-char (point-min))
	 (search-forward "\n\n" nil t)
	 (setq e (match-end 0))
	 (if (<= e ce)
	     e
	   ce)))
      (run-hooks 'mime/viewer-mode-hook)
      )))

(defun mime-preview/point-content-number (point)
  (save-window-excursion
    (let ((pc (mime::point-preview-content (point)))
	  cinfo)
      (switch-to-buffer (mime::preview-content-info/buffer pc))
      (setq cinfo (mime::preview-content-info/content-info pc))
      (mime::get-point-content-number (mime::content-info/point-min cinfo))
      )))

(defun mime-preview/cinfo-to-pcinfo (cinfo)
  (let ((rpcl mime::preview/content-list) cell)
    (catch 'tag
      (while rpcl
	(setq cell (car rpcl))
	(if (eq cinfo (mime::preview-content-info/content-info cell))
	    (throw 'tag cell)
	  )
	(setq rpcl (cdr rpcl))
	))))

(defvar mime-preview/after-decoded-position nil)

(defun mime-preview/decode-content ()
  (interactive)
  (let ((pc (mime::point-preview-content (point))))
    (if pc
	(let ((the-buf (current-buffer)))
	  (setq mime-preview/after-decoded-position (point))
	  (switch-to-buffer (mime::preview-content-info/buffer pc))
	  (mime::article/decode-content-region
	   (mime::preview-content-info/content-info pc))
	  (if (eq (current-buffer)
		  (mime::preview-content-info/buffer pc))
	      (progn
		(switch-to-buffer the-buf)
		(goto-char mime-preview/after-decoded-position)
		))
	  ))))

(defun mime-viewer/play-content ()
  (interactive)
  (let ((mime-viewer/decoding-mode "play"))
    (mime-preview/decode-content)
    ))

(defun mime-viewer/extract-content ()
  (interactive)
  (let ((mime-viewer/decoding-mode "extract"))
    (mime-preview/decode-content)
    ))

(defun mime-viewer/print-content ()
  (interactive)
  (let ((mime-viewer/decoding-mode "print"))
    (mime-preview/decode-content)
    ))

(defun mime-viewer/up-content ()
  (interactive)
  (let ((pc (mime::point-preview-content (point))) cinfo
	(the-buf (current-buffer))
	cn r)
    (switch-to-buffer (mime::preview-content-info/buffer pc))
    (setq cinfo (mime::preview-content-info/content-info pc))
    (setq cn (mime::get-point-content-number
	      (mime::content-info/point-min cinfo)))
    (if (eq cn t)
	(mime-viewer/quit the-buf
			  (mime::preview-content-info/buffer pc)
			  )
      (setq r (mime-article/cnum-to-cinfo (butlast cn)))
      (switch-to-buffer the-buf)
      (catch 'tag
	(let ((rpcl mime::preview/content-list) cell)
	  (while rpcl
	    (setq cell (car rpcl))
	    (if (eq r (mime::preview-content-info/content-info cell))
		(progn
		  (goto-char (mime::preview-content-info/point-min cell))
		  (throw 'tag nil)
		  ))
	    (setq rpcl (cdr rpcl))
	    )))
      )))

(defun mime-viewer/previous-content ()
  (interactive)
  (let* ((pcl mime::preview/content-list)
	 (p (point))
	 (i (- (length pcl) 1))
	 beg)
    (catch 'tag
      (while (>= i 0)
	(setq beg (mime::preview-content-info/point-min (nth i pcl)))
	(if (> p beg)
	    (throw 'tag (goto-char beg))
	  )
	(setq i (- i 1))
	))
    ))

(defun mime-viewer/next-content ()
  (interactive)
  (let ((pcl mime::preview/content-list)
	(p (point))
	beg)
    (catch 'tag
      (while pcl
	(setq beg (mime::preview-content-info/point-min (car pcl)))
	(if (< p beg)
	    (throw 'tag (goto-char beg))
	  )
	(setq pcl (cdr pcl))
	))
    ))

(defun mime-viewer/scroll-up-content (&optional h)
  (interactive)
  (or h
      (setq h (- (window-height) 1))
      )
  (let ((pcl mime::preview/content-list)
	(p (point))
	np beg)
    (setq np
	  (or (catch 'tag
		(while pcl
		  (setq beg (mime::preview-content-info/point-min (car pcl)))
		  (if (< p beg)
		      (throw 'tag beg)
		    )
		  (setq pcl (cdr pcl))
		  ))
	      (point-max)))
    (forward-line h)
    (if (> (point) np)
	(goto-char np)
      )
    ;;(show-subtree)
    ))

(defun mime-viewer/scroll-down-content (&optional h)
  (interactive)
  (or h
      (setq h (- (window-height) 1))
      )
  (let ((pcl mime::preview/content-list)
	(p (point))
	pp beg)
    (setq pp
	  (or (let ((i (- (length pcl) 1)))
		(catch 'tag
		  (while (> i 0)
		    (setq beg (mime::preview-content-info/point-min
			       (nth i pcl)))
		    (if (> p beg)
			(throw 'tag beg)
		      )
		    (setq i (- i 1))
		    )))
	      (point-min)))
    (forward-line (- h))
    (if (< (point) pp)
	(goto-char pp)
      )))

(defun mime-viewer/next-line-content ()
  (interactive)
  (mime-viewer/scroll-up-content 1)
  )

(defun mime-viewer/previous-line-content ()
  (interactive)
  (mime-viewer/scroll-down-content 1)
  )

(defun mime-viewer/quit (&optional the-buf buf)
  (interactive)
  (or the-buf
      (setq the-buf (current-buffer))
      )
  (or buf
      (setq buf (mime::preview-content-info/buffer
		 (mime::point-preview-content (point))))
      )
  (let ((r (progn
	     (switch-to-buffer buf)
	     (assoc major-mode mime-viewer/quitting-method-alist)
	     )))
    (if r
	(progn
	  (switch-to-buffer the-buf)
	  (funcall (cdr r))
	  ))
    ))

(defun mime-viewer/kill-buffer ()
  (interactive)
  (kill-buffer (current-buffer))
  )


;;; @ end
;;;

(provide 'tm-view)

(run-hooks 'tm-view-load-hook)