New file.

diff --git a/mime/mmbabyl.el b/mime/mmbabyl.el
new file mode 100644 (file)
index 0000000..0999917
--- /dev/null
+++ b/mime/mmbabyl.el
@@ -0,0 +1,164 @@
+;;; 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 FLIM (Faithful Library about Internet Message).
+
+;; 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)
+  (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-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)
+  (with-temp-buffer
+    (mime-insert-entity entity)
+    (write-region-as-raw-text-CRLF (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)
+  (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)
+   invisible-fields visible-fields)
+  )
+
+
+;;; @ children
+;;;
+
+(luna-define-method mime-entity-children ((entity 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