From: tomo <tomo>
Date: Sat, 9 Dec 2000 03:32:13 +0000 (+0000)
Subject: New file.
X-Git-Tag: semi21-1_14_0-pre3~2
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=1a5fc4bf86c9bae0db424e67b4661f3d72309693;p=elisp%2Flemi.git

New file.
---

diff --git a/mime/mmbabyl.el b/mime/mmbabyl.el
new file mode 100644
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