;;; mmbabyl.el --- MIME entity module for Babyl buffer

;; Copyright (C) 2000 Free Software Foundation, Inc.

;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: Babyl, RMAIL, MIME, multimedia, mail

;; This file is part of GNU Emacs.

;; This program 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.

;; This program 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(require 'mmbuffer)

(eval-and-compile
  (luna-define-class mime-babyl-entity (mime-buffer-entity)
		     (visible-header-start
		      visible-header-end))

  (luna-define-internal-accessors 'mime-babyl-entity))

(luna-define-method initialize-instance
  :after ((entity mime-babyl-entity) &rest init-args)
  "Initialize slots of ENTITY.
ENTITY is an instance of `mime-babyl-entity'."
  (or (mime-buffer-entity-buffer-internal entity)
      (mime-buffer-entity-set-buffer-internal
       entity (get-buffer (mime-entity-location-internal entity))))
  (save-excursion
    (set-buffer (mime-buffer-entity-buffer-internal entity))
    (goto-char (point-min))
    (let (header-start
	  header-end
	  visible-header-start
	  visible-header-end
	  body-start)
      (forward-line 1)
      (if (= (following-char) ?0)
	  (progn
	    (forward-line 2)
	    ;; If there's a Summary-line in the (otherwise empty)
	    ;; header, we didn't yet get past the EOOH line.
	    (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")
		(forward-line 1))
	    (setq header-start (point))
	    (search-forward "\n\n" nil t)
	    (setq header-end (1+ (match-beginning 0)))
	    (setq body-start (match-end 0))
	    (setq visible-header-start header-start
		  visible-header-end header-end))
	(forward-line 1)
	(setq header-start (point))
	(search-forward "\n*** EOOH ***\n" nil t)
	(setq header-end (match-beginning 0))
	(setq visible-header-start (match-end 0))
	(search-forward "\n\n" nil t)
	(setq visible-header-end (1+ (match-beginning 0)))
	(setq body-start (match-end 0)))
      (mime-buffer-entity-set-header-start-internal entity header-start)
      (mime-buffer-entity-set-header-end-internal entity header-end)
      (mime-buffer-entity-set-body-start-internal entity body-start)
      (mime-buffer-entity-set-body-end-internal entity (point-max))
      (mime-babyl-entity-set-visible-header-start-internal
       entity visible-header-start)
      (mime-babyl-entity-set-visible-header-end-internal
       entity visible-header-end)
      (or (mime-entity-content-type-internal entity)
	  (save-restriction
	    (narrow-to-region header-start header-end)
	    (mime-entity-set-content-type-internal
	     entity
	     (let ((str (std11-fetch-field "Content-Type")))
	       (if str
		   (mime-parse-Content-Type str)
		 )))
	    ))
      ))
  entity)


;;; @ entity
;;;

(luna-define-method mime-insert-entity ((entity mime-babyl-entity))
   "Insert ENTITY into the current buffer.
ENTITY is an instance of `mime-babyl-entity'.
The header part and the body part of ENTITY are separated by a blank
line."
  (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
			   (mime-buffer-entity-header-start-internal entity)
			   (mime-buffer-entity-header-end-internal entity))
  (insert "\n")
  (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
			   (mime-buffer-entity-body-start-internal entity)
			   (mime-buffer-entity-body-end-internal entity))
  )

(luna-define-method mime-write-entity ((entity mime-babyl-entity)
				       filename)
  "Write ENTITY into FILENAME.
ENTITY is an instance of `mime-babyl-entity'."
  (with-temp-buffer
    (mime-insert-entity entity)
    (raw-message-write-region (point-min) (point-max) filename)))


;;; @ entity header
;;;


;;; @ entity body
;;;


;;; @ entity content
;;;


;;; @ header field
;;;

(luna-define-method mime-insert-header ((entity mime-babyl-entity)
					&optional invisible-fields
					visible-fields)
  "Insert the header of ENTITY in the current buffer.
ENTITY is an instance of `mime-babyl-entity'.
The optional arguemnts are currently ignored."
  (mime-insert-header-from-buffer
   (mime-buffer-entity-buffer-internal entity)
   (mime-babyl-entity-visible-header-start-internal entity)
   (mime-babyl-entity-visible-header-end-internal entity)
   nil nil)
  )


;;; @ children
;;;

;;;%%% docstring 合ってる？

(luna-define-method mime-entity-children ((entity mime-babyl-entity))
  "Return a list of ENTITY's children.
ENTITY is an instance of `mime-babyl-entity'."
  (let* ((content-type (mime-entity-content-type entity))
	 (primary-type (mime-content-type-primary-type content-type))
	 sub-type)
    (cond ((eq primary-type 'multipart)
	   (mmbuffer-parse-multipart entity 'mime-buffer-entity))
	  ((eq primary-type 'message)
	   (setq sub-type (mime-content-type-subtype content-type))
	   (cond ((eq sub-type 'external-body)
		  (mmbuffer-parse-encapsulated entity 'external
					       'mime-buffer-entity))
		 ((memq sub-type '(rfc822 news))
		  (mmbuffer-parse-encapsulated entity nil
					       'mime-buffer-entity)))))))


;;; @ end
;;;

(provide 'mmbabyl)

;;; mmbabyl.el ends here