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

(provide 'tm-view)


;;; @ require modules
;;;

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


;;; @ version
;;;

(defconst mime-viewer/RCS-ID
  "$Id: tm-view.el,v 6.19 1995/04/28 06:13:27 morioka Exp $")

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


;;; @ constants
;;;

(defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
(defconst mime/token-regexp
  (concat "[^" mime/tspecials "]*"))
(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
;;(setq 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/content-filter-alist
  '(("text/plain" . mime-viewer/filter-text/plain)))

(defvar mime-viewer/content-subject-function
  (function
   (lambda (cnum subj ctype params)
     (insert
      (format "[%s %s (%s)]\n"
	      (if (listp cnum)
		  (mapconcat (function
			      (lambda (num)
				(format "%s" (+ num 1))
				))
			     cnum ".")
		"0")
	      subj ctype))
     )))

(defvar mime-viewer/content-header-filter-function
  (function mime-viewer/default-content-header-filter-function))

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

(defvar mime-viewer/ignored-field-list
  '("Received"))

(defun mime-viewer/default-content-header-filter-function (cnum cinfo)
  (if (and (listp cnum)
	   (not (member
		 (mime::content-info/type
		  (mime::article/get-content-region (butlast cnum) cinfo)
		  )
		 mime-viewer/childrens-header-showing-Content-Type-list)
		))
      (delete-region (goto-char (point-min))
		     (or (and (re-search-forward "^$" nil t)
			      (match-end 0))
			 (point-max))
		     )
    (save-excursion
      (save-restriction
	(narrow-to-region (goto-char (point-min))
			  (or (and (re-search-forward "^$" nil t)
				   (match-end 0))
			      (point-max))
			  )
	(mapcar (function
		 (lambda (field)
		   (goto-char (point-min))
		   (while (and (re-search-forward
				(concat "^" (regexp-quote field) ":")
				nil t)
			       (progn
				 (delete-region
				  (match-beginning 0)
				  (and
				   (re-search-forward
				    (concat message/field-body-regexp "\n")
				    nil t)
				   (match-end 0)
				   ))
				 t))
		     )
		   )) mime-viewer/ignored-field-list)
	))))

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

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


;;; @@ quitting
;;;

(defun mime::viewer/quitting-method-for-gnus4 ()
  (mime-viewer/kill-buffer)
  (delete-other-windows)
  (gnus-article-show-summary)
  )

(defun mime::viewer/quitting-method-for-rmail ()
  (mime-viewer/kill-buffer)
  (rmail-summary)
  (delete-other-windows)
  )

(defun mime::viewer/quitting-method-for-mh-e ()
  (let ((win (get-buffer-window
	      mime/output-buffer-name))
	(buf
	 (mime::preview-content-info/buffer
	  (car mime::preview/content-list)))
	)
    (if win
	(delete-window win)
      )
    (mime-viewer/kill-buffer)
    (pop-to-buffer
     (let ((name (buffer-name buf)))
       (string-match "show-" name)
       (substring name (match-end 0))
       ))
    ;; patch for mh-narrow.el
    ;; by YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
    (if (and (featurep 'mh-narrow)
	     (fboundp 'mh-narrow-to-page))
	(save-excursion
	  (set-buffer mh-show-buffer)
	  (mh-narrow-to-page)))
    ;; end of patch
    ))

(defvar mime-viewer/quitting-method-alist
  '((gnus-article-mode . mime::viewer/quitting-method-for-gnus4)
    (rmail-mode        . mime::viewer/quitting-method-for-rmail)
    (mh-show-mode      . mime::viewer/quitting-method-for-mh-e)
    (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 structure
;;;

;;; @@ content-info
;;;

(defun mime::make-content-info (beg end ctype params encoding children)
  (vector beg end ctype params encoding children)
  )

(defun mime::content-info/point-min (cinfo)
  (elt cinfo 0)
  )

(defun mime::content-info/point-max (cinfo)
  (elt cinfo 1)
  )

(defun mime::content-info/type (cinfo)
  (elt cinfo 2)
  )

(defun mime::content-info/parameters (cinfo)
  (elt cinfo 3)
  )

(defun mime::content-info/encoding (cinfo)
  (elt cinfo 4)
  )

(defun mime::content-info/children (cinfo)
  (elt cinfo 5)
  )

;;; @@ preview-content-info
;;;

(defun mime::make-preview-content-info (beg end buf cinfo)
  (vector beg end buf cinfo)
  )

(defun mime::preview-content-info/point-min (pcinfo)
  (elt pcinfo 0)
  )

(defun mime::preview-content-info/point-max (pcinfo)
  (elt pcinfo 1)
  )

(defun mime::preview-content-info/buffer (pcinfo)
  (elt pcinfo 2)
  )

(defun mime::preview-content-info/content-info (pcinfo)
  (elt pcinfo 3)
  )


;;; @ buffer local variables
;;;

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

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


;;; @ 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 (search-forward (concat "--" boundary "--\n") nil t)
			  (match-beginning 0)
			(point-max)
			))
		     (mime-viewer/parse-multipart 
		      (point-min)
		      (point-max)
		      boundary ctype params encoding)
		     )))
		((string= ctype "message/rfc822")
		 (mime::make-content-info
		  (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::make-content-info (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::make-content-info 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 ()
  (let ((str (message/get-field-body "Content-Type")))
    (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/get-subject (param)
  (save-excursion
    (save-restriction
      (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))
		 )
	    (progn
	      (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/get-name (param)
  (replace-as-filename (mime/get-subject param))
  )

(defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf)
  (let ((the-buf (current-buffer)) pcl dest)
    (setq buf
	  (if (null buf)
	      (current-buffer)
	    (get-buffer buf)
	    ))
    (if (null cinfo)
	(progn
	  (switch-to-buffer buf)
	  (setq cinfo mime::article/content-info)
	  ))
    (if (null obuf)
	(setq obuf (concat "*Preview-" (buffer-name buf) "*"))
      )
    (setq pcl (mime::make-flat-content-list cinfo))
    (if (get-buffer obuf)
	(kill-buffer obuf)
      )
    (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))
		    cnum e nb ne subj str)
		(setq cnum (mime::get-point-content-number beg cinfo))
		(switch-to-buffer buf)
		(setq e
		      (if (not
			   (member
			    ctype
			    mime-viewer/default-showing-Content-Type-list))
			  (save-excursion
			    (save-restriction
			      (goto-char beg)
			      (re-search-forward "^$" nil t)
			      (+ (match-end 0) 1)
			      ))
			end))
		(if (> e (point-max))
		    (setq e (point-max))
		  )
		(setq str (buffer-substring beg e))
		(switch-to-buffer obuf)
		(setq nb (point))
		(insert str)
		(setq ne (point))
		(prog1
		    (save-excursion
		      (save-restriction
			(narrow-to-region nb ne)
			(mime/decode-message-header)
			(setq subj (mime/get-subject params))
			(let ((f
			       (cdr
				(assoc ctype
				       mime-viewer/content-filter-alist))))
			  (if (and f (fboundp f))
			      (funcall f ctype params)
			    ))
			(funcall mime-viewer/content-header-filter-function
				 cnum cinfo)
			(goto-char nb)
			(funcall mime-viewer/content-subject-function
				 cnum subj ctype params)
			(setq ne (point-max))
			(mime::make-preview-content-info 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)
  (if (null 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/get-content-region (cn &optional cinfo)
  (if (null 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/get-content-region (cdr cn) rc)
	    ))
	))))

(defun mime::make-flat-content-list (&optional cinfo)
  (if (null 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)
  (if (null 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/Quoted-Printable-decode-region (beg end)
  (interactive "*r")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (while (re-search-forward "=\n" nil t)
	(replace-match "")
	)
      (goto-char (point-min))
      (let (b e str)
	(while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
	  (setq b (match-beginning 0))
	  (setq e (match-end 0))
	  (setq str (buffer-substring b e))
	  (delete-region b e)
	  (insert (mime/Quoted-Printable-decode-string str))
	  ))
      )))

(defun mime/Base64-decode-region (beg end)
  (interactive "*r")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (while (search-forward "\n" nil t)
	(replace-match "")
	)
      (let ((str (buffer-substring (point-min)(point-max))))
	(delete-region (point-min)(point-max))
	(insert (mime/base64-decode-string str))
	))))

(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/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
;;;

(defun mime-viewer/filter-text/plain (ctype params)
  (save-excursion
    (save-restriction
      (let ((charset (cdr (assoc "charset" params)))
	    (encoding
	     (save-excursion
	       (save-restriction
		 (goto-char (point-min))
		 (narrow-to-region (point-min)
				   (or (and (search-forward "\n\n" nil t)
					    (match-beginning 0))
				       (point-max)))
		 (goto-char (point-min))
		 (mime/Content-Transfer-Encoding "7bit")
		 )))
	    (beg (point-min)) (end (point-max))
	    )
	(goto-char (point-min))
	(if (search-forward "\n\n" nil t)
	    (setq beg (match-end 0))
	  )
	(if (cond ((string= encoding "quoted-printable")
		   (mime/Quoted-Printable-decode-region beg end)
		   t)
		  ((string= encoding "base64")
		   (mime/Base64-decode-region beg end)
		   t))
	    (mime/code-convert-region-to-emacs beg (point-max) charset)
	  )
	))))


;;; @ 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)
  (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))
	(mode major-mode))
    (switch-to-buffer (car ret))
    (setq major-mode 'mime/viewer-mode)
    (setq mode-name "MIME-View")
    (make-variable-buffer-local 'mime::preview/original-major-mode)
    (setq mime::preview/original-major-mode
	  (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)
		'mime/show-message-mode)
	    mode))
    (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/decode-content ()
  (interactive)
  (let ((pc (mime::point-preview-content (point))))
    (if pc
	(let ((the-buf (current-buffer)))
	  (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))
	      (switch-to-buffer the-buf)
	    )
	  ))))

(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/get-content-region (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)
  (if (null 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)
      )))

(defun mime-viewer/scroll-down-content (&optional h)
  (interactive)
  (if (null 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)
  (if (null the-buf)
      (setq the-buf (current-buffer))
    )
  (if (null 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))
  )

(fset 'mime/view-mode 'mime/viewer-mode)

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