;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Copyright (c) 1994 by William M. Perry (wmperry@spry.com)
;;;
;;; This file is not part of GNU Emacs, but the same permissions apply.
;;;
;;; GNU Emacs 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.
;;;
;;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Viewers for different MIME types.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; multipart/alternative -> Show display of choices
;;; multipart/mixed       -> Break chunks into cached file area
;;; multipart/digest
;;; multipart/parallel
;;; multipart/header-set
;;; message/rfc822
;;; message/partial
;;; message/external-body
;;; message/news
;;; application/octet-stream -> save to disk
;;; application/rtf
;;; application/mac-binhex40
;;; text/richtext         -> convert to HTML
;;;

(defvar content-transfer-encodings
  '(("base64" . "b64decode")
    ("x-gzip" . "gzip -dc"))
  "*An assoc list of content-transfer-encodings and how to decode them.")

(defun parse-mime-headers (&optional no-delete)
  "Return a list of the MIME headers at the top of this buffer.
If optional argument NO-DELETE is non-nil, don't delete the headers."
  (let* ((st (point-min))
	 (nd (progn
	       (goto-char (point-min))
	       (skip-chars-forward " \\\t\\\n")
	       (if (re-search-forward "^\r*$" nil t)
		   (1+ (point))
		 (point-max))))
	 save-pos
	 status
	 hname
	 hvalu
	 result
	 )
    (narrow-to-region st nd)
    (goto-char (point-min))
    (while (not (eobp))
      (skip-chars-forward " \\\t\\\n\\\r")
      (setq save-pos (point))
      (skip-chars-forward "^:\\\n\\\r")
      (downcase-region save-pos (point))
      (setq hname (buffer-substring save-pos (point)))
      (skip-chars-forward ": \\\t ")
      (setq save-pos (point))
      (skip-chars-forward "^\\\n\\\r")
      (setq hvalu (buffer-substring save-pos (point))
	    result (cons (cons hname hvalu) result)))
    (or no-delete (delete-region st nd))
    result))

(defun find-available-multiparts (separator &optional buf)
  "Return a list of ((content-type . filename) ...) for the
multipart message in buffer BUF with separator SEPARATOR.
The different multipart specs are put in url-temporary-directory."
  (let ((sep (concat "^--" separator "\r*$"))
	headers
	fname
	results)
    (save-excursion
      (and buf (set-buffer buf))
      (goto-char (point-min))
      (while (re-search-forward sep nil t)
	(let ((st (set-marker (make-marker)
			      (progn
				(forward-line 1)
				(beginning-of-line)
				(point))))
	      (nd (set-marker (make-marker)
			      (if (re-search-forward sep nil t)
				  (1- (match-beginning 0))
				(point-max)))))
	  (narrow-to-region st nd)
	  (goto-char st)
	  (if (looking-at "^\r*$")
	      (insert "Content-type: text/plain\n"
		      "Content-length: " (int-to-string (- nd st)) "\n"))
	  (setq headers (parse-mime-headers)
		fname (url-generate-unique-filename))
	  (widen)
	  (if (assoc "content-transfer-encoding" headers)
	      (let ((coding (cdr
			     (assoc "content-transfer-encoding" headers)))
		    (cmd nil))
		(setq cmd (or (cdr (assoc coding content-transfer-encodings))
			      (read-string
			       (concat "How shall I decode " coding "? ")
			       "cat")))
		(if (string= cmd "") (setq cmd "cat"))
		(shell-command-on-region st nd cmd t)
		(set-marker nd (point))))
	  (write-region st nd fname nil 5)
	  (delete-region st nd)
	  (setq results (cons
			 (cons
			  (cons "w3-filename" fname) headers) results)))))
    results))

(defun format-multipart-as-html (&optional buf)
  (if buf (set-buffer buf))
  (let* ((type     (cdr (assoc "content-type" url-current-mime-headers)))
	 (boundary (if (string-match
			"boundary[ \\\t]*=[ \\\t\"]*\\([^ \"\\\t\\\n]+\\)"
			type)
		       (url-match type 1)))
	 (parts    (find-available-multiparts boundary)))
    (erase-buffer)
    (insert "<htmlplus>\n"
	    " <head>\n"
	    "  <title>Multipart Message</title>\n"
	    " </head>\n"
	    " <body>\n"
	    "  <div1>\n"
	    "   <h1> Multipart message encountered </h1>\n"
	    "   <p> I have encountered a multipart MIME message.\n"
	    "       The following parts have been detected.  Please\n"
	    "       select which one you want to view.\n"
	    "   </p>\n"
	    "   <ul>\n"
	    (mapconcat 
	     (function (lambda (x)
			 (concat "    <li> <a href=\"file:"
				 (cdr (assoc "w3-filename" x))
				 "\">"
				 (or (cdr (assoc "content-type" x))
				     "unknown type")
				 "</a> </li>")))
	     parts "\n")
	    "   </ul>\n"
	    "  </div1>\n"
	    " </body>\n"
	    "</htmlplus>\n"
	    "<!-- Automatically generated by URL v" url-version "-->\n")))

