;;; mew-mime.el --- MIME launcher for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>
;; Created: Mar 23, 1997
;; Revised: Oct 25, 1997

;;; Code:

(defconst mew-mime-version "mew-mime.el version 0.10")

(require 'mew)

;;
;;
;;

(defmacro mew-attr-by-ct (ct)
  (` (mew-assoc-match2 (, ct) mew-mime-content-type 0)))

(defmacro mew-attr-by-file (ct)
  (` (mew-assoc-match2 (, ct) mew-mime-content-type 1)))

(defmacro mew-attr-get-ct (attr)
  (` (nth 0 (, attr))))

(defmacro mew-attr-get-cte (attr)
  (` (symbol-value (nth 2 (, attr)))))

(defun mew-attr-get-prog (attr)
  (let ((val (symbol-value (nth 3 attr))))
    (if (and (listp val) (equal 'if (car val)))
	(setq val (eval val)))
    (nth 0 val)))

(defun mew-attr-get-opt (attr)
  (let ((val (symbol-value (nth 3 attr))))
    (if (and (listp val) (equal 'if (car val)))
	(setq val (eval val)))
    (nth 1 val)))

(defun mew-attr-get-async (attr)
  (let ((val (symbol-value (nth 3 attr))))
    (if (and (listp val) (equal 'if (car val)))
	(setq val (eval val)))
    (nth 2 val)))

(defmacro mew-attr-get-icon (attr)
  (` (symbol-value (nth 4 (, attr)))))

;;
;;
;;

(defun mew-mime-start-process (program options file)
  (let ((process-connection-type mew-connection-type1) pro)
    (message "Starting %s ..." program)
    (setq pro (apply (function start-process)
		     (format "*mew %s*" program)
		     mew-buffer-tmp ;; xxx
		     program
		     (append options (list file))))
    (set-process-sentinel pro 'mew-mime-start-process-sentinel)
    (message "Sending %s ... done" program)
    (setq mew-process-file-alist (cons (cons pro file) mew-process-file-alist))
    )
  t ;; to next part
  )

(defun mew-mime-start-process-sentinel (process event)
  (let ((al (assoc process mew-process-file-alist)))
    (if (cdr al) (delete-file (cdr al)))
    (setq mew-process-file-alist (delete al mew-process-file-alist))
    ))

(defun mew-mime-call-process (program options file)
  (message "Calling %s ..." program)
  (apply (function call-process) program file nil nil options)
  (message "Calling %s ... done" program)
  t ;; to next part
  )

(defun mew-mime-image (begin end format)
  (let ((buffer-read-only nil))
    (message "Loading image...")
    (cond 
     ((eq format 'xbm) ;; use temporary file.
      (let ((temp-file-name (mew-make-temp-name))
	    glyph)
	(save-excursion
	  (set-buffer (mew-current-get 'cache))
	  (write-region begin end temp-file-name nil 'no-msg)
	  (set-buffer (mew-buffer-message))
	  (setq glyph (make-glyph (vector 
				   'xbm
				   :file
				   temp-file-name)))
	  (set-glyph-property glyph 'face 'x-face)
	  (set-extent-end-glyph (make-extent (point-min) (point-min)) glyph)
	  (if (file-exists-p temp-file-name)
	      (delete-file temp-file-name)))))
     (t
      (set-buffer (mew-buffer-message))
      (set-extent-end-glyph (make-extent (point-min) (point-min))
			    (make-glyph (vector 
					 format
					 :data
					 (buffer-substring 
					  begin end
					  (mew-current-get 'cache)))))))
    (message "Loading image...done")
    ))

(defun mew-mime-image/jpeg (begin end &optional params)
  (mew-mime-image begin end 'jpeg))

(defun mew-mime-image/gif (begin end &optional params)
  (mew-mime-image begin end 'gif))

(defun mew-mime-image/xbm (begin end &optional params)
  (mew-mime-image begin end 'xbm))

(defun mew-mime-image/xpm (begin end &optional params)
  (mew-mime-image begin end 'xpm))

(defun mew-mime-image/png (begin end &optional params)
  (mew-mime-image begin end 'png))

(defun mew-mime-text/plain (begin end &optional params)
  (if (> end begin)
      (save-excursion
	(set-buffer (mew-buffer-message))
	(let ((buffer-read-only nil))
	  (insert-buffer-substring (mew-current-get 'cache) begin end)
	  ;; End of message or part
	  (if (or mew-end-of-message-string mew-end-of-part-string)
	      (if (and (markerp	mew-summary-buffer-end)
		       (marker-buffer mew-summary-buffer-end))
		  (let (msgp pos beg end)
		    (save-excursion
		      (set-buffer (marker-buffer mew-summary-buffer-end))
		      (setq pos (point))
		      (setq end (marker-position mew-summary-buffer-end))
		      (goto-char end)
		      (forward-line -1)
		      (beginning-of-line)
		      (setq beg (point))
		      (if (and (<= beg pos) (< pos end))
			  (setq msgp t)))
		    (if msgp
			(insert mew-end-of-message-string)
		      (insert mew-end-of-part-string)))
		(insert mew-end-of-message-string)))
	  ;; Highlight
	  (mew-highlight-url)
	  (mew-highlight-body))
	;; Page breaks
	(if mew-break-pages
	    (progn
	      (goto-char (point-min))
	      (mew-message-narrow-to-page)))
	(set-buffer-modified-p nil))))

(defun mew-mime-text/html (begin end &optional params execute)
  (let ((size (- end begin))
	(buffer-read-only nil))
    (insert " #     # ####### #     # #\n"
	    " #     #    #    ##   ## #\n"
	    " #     #    #    # # # # #\n"
	    " #######    #    #  #  # #\n"
	    " #     #    #    #     # #\n"
	    " #     #    #    #     # #\n"
	    " #     #    #    #     # #######\n"
	    "\n\n")
    (and size (insert (format "Size:\t\t%d bytes\n" size)))
    (insert (format "Browser:\t%s\n"
		    (cond ((and (symbolp mew-prog-text/html)
				(fboundp mew-prog-text/html))
			   (symbol-name mew-prog-text/html))
			  ((stringp mew-prog-text/html) mew-prog-text/html)
			  (t "none")))
	    "\nTo save this part, type "
	    (substitute-command-keys
	     "\\<mew-summary-mode-map>\\[mew-summary-save].")
	    "\nTo display this part in Message mode, type "
	    (substitute-command-keys
	     "\\<mew-summary-mode-map>\\[mew-summary-insert]."))
    (if (null execute)
        (insert "\nTo display this text/html contents with browser, type "
                (substitute-command-keys
                 "\\<mew-summary-mode-map>\\[mew-summary-execute-external]."))
      (cond
       ((and (symbolp mew-prog-text/html) (fboundp mew-prog-text/html))
	(let (source)
	  (set-buffer (mew-current-get 'cache))
	  (setq source (buffer-substring begin end))
	  (set-buffer (mew-buffer-message))
	  (mew-erase-buffer)
	  (insert source)
	  (funcall mew-prog-text/html (point-min) (point-max))))
       ((stringp mew-prog-text/html)
	(if (> end begin)
	    (let ((file (format "%s.html" (mew-make-temp-name))))
	      (save-excursion
		(set-buffer (mew-current-get 'cache))
		(mew-frwlet
		 mew-cs-noconv mew-cs-outfile ;; xxx anyway
		 (write-region begin end file nil 'no-msg)
		 (apply (function start-process)
			mew-prog-text/html mew-buffer-tmp mew-prog-text/html
			(append mew-prog-text/html-arg (list file))))))))))
    ))

(defun mew-mime-message/rfc822 (part)
  (let* ((hbegin (mew-syntax-get-begin part))
	 (hend   (mew-syntax-get-end   part))
	 (cache  (mew-current-get 'cache))
	 (body   (mew-syntax-get-part part))
	 (buffer-read-only nil))
    (insert-buffer-substring cache hbegin hend)
    (mew-decode-syntax-insert-privacy)
    (insert "\n")
    (mew-header-arrange)
    (cond
     ;; Displaying the text/plain body or the first part of 
     ;; top level multipart if it is text/plain.
     ;; see also mew-syntax-singlepart
     ((mew-syntax-singlepart-p body)
      (mew-summary-display-part part nil 'non-erase)) ;; nil is single
     ((mew-syntax-multipart-p body)
      (let* ((first (mew-syntax-get-part body))
	     (ct (car (mew-syntax-get-ct first)))
	     (cdpl (mew-syntax-get-cdp first)))
	(if (and (mew-case-equal ct mew-ct-txt)
		 (or (null cdpl)
		     (null (mew-syntax-get-member cdpl "filename"))))
	    (progn
	      (mew-summary-display-part body "1" 'non-erase)
	      (mew-current-set 'part nil) ;; clear part
	      ))))
     )
    ;; display-part sets citation noheader
    (setq mew-message-citation 'header)
    (set-buffer-modified-p nil) ;; xxx
    ))

(defun mew-mime-application/octet-stream (begin end &optional params ct)
  (let ((size (- end begin))
	(buffer-read-only nil))
    (insert " ######    ###   #     #    #    ######  #     #\n"
	    " #     #    #    ##    #   # #   #     #  #   #\n"
	    " #     #    #    # #   #  #   #  #     #   # #\n"
	    " ######     #    #  #  # #     # ######     #\n"
	    " #     #    #    #   # # ####### #   #      #\n"
	    " #     #    #    #    ## #     # #    #     #\n"
	    " ######    ###   #     # #     # #     #    #\n"
	    "\n\n")
    (and ct (insert (format "Content-Type:\t%s\n" ct)))
    (and params (insert (format "Params:\t\t%s\n"
				(mapconcat 'concat params "; "))))
    (and size (insert (format "Size:\t\t%d bytes\n" size)))
    (insert "\nTo save this part, type "
	    (substitute-command-keys
	     "\\<mew-summary-mode-map>\\[mew-summary-save].")
	    "\nTo display this part in Message mode, type "
	    (substitute-command-keys
	     "\\<mew-summary-mode-map>\\[mew-summary-insert]."))))

(defun mew-summary-insert ()
  (interactive)
  (let* ((ofld-msg (mew-current-get 'message))
	 (msg (mew-summary-message-number))
	 (part (mew-syntax-number))
	 (buf (buffer-name)))
    (if (or msg (not part))
	(let ((mew-analysis nil))
	  (mew-summary-display))
      (unwind-protect
	  (progn
	    (mew-summary-toggle-disp-msg 'on)
	    (mew-window-configure buf 'message)
	    (set-buffer (mew-buffer-message))
	    (let* ((buffer-read-only nil)
		   (syntax (mew-cache-decode-syntax (mew-cache-hit ofld-msg)))
		   (stx (mew-syntax-get-entry-strnum syntax part))
		   (begin (mew-syntax-get-begin stx))
		   (end (mew-syntax-get-end stx)))
	      (erase-buffer)
	      (insert-buffer-substring (mew-current-get 'cache) begin end)
	      (goto-char (point-min))
	      ))
	(mew-pop-to-buffer buf)))
    ))

(provide 'mew-mime)

;;; Copyright Notice:

;; Copyright (C) 1997, 1998 Mew developing team.
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. All advertising materials mentioning features or use of this software
;;    must display the following acknowledgement:
;;       This product includes software developed by 
;;       Mew developing team and its contributors.
;; 4. Neither the name of the team nor the names of its contributors
;;    may be used to endorse or promote products derived from this software
;;    without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; mew-mime.el ends here
