From: morioka <morioka>
Date: Fri, 10 Jul 1998 17:51:21 +0000 (+0000)
Subject: Merge flim-chao-1_8_0.
X-Git-Tag: flim-1_9_0~17
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9cf6838bc986b73bc83955794f7424e9d3e1539d;p=elisp%2Fflim.git

Merge flim-chao-1_8_0.
---

diff --git a/ChangeLog b/ChangeLog
index 793e326..d34ec5e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,77 @@
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* FLIM-Chao: Version 1.8.0 (Shij-Dò)-A was released.
+
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* mmcooked.el: Abolish method `open'.
+
+	* mmbuffer.el (initialize-instance): New method; abolish `open'.
+	(entity-children): New method.
+
+	* mime.el (mime-open-entity): Send `initialize-instance' to
+	created message.
+	(mime-entity-children): New implementation.
+	(mime-entity-parent): New implementation.
+	(mime-root-entity-p): New implementation.
+
+	* mime-parse.el (mime-parse-multipart): Specify current entity as
+	parent.
+	(mime-parse-encapsulated): Likewise.
+	(mime-parse-message): Change interface to specify parent; modify
+	for `make-mime-entity-internal'.
+	(mime-parse-buffer): Modify for `mime-parse-message'.
+
+	* mime-def.el (make-mime-entity-internal): Change interface; add
+	format of `mime-entity' to add `parent'.
+
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* mmbuffer.el (mime-visible-field-p): Renamed from
+	`eword-visible-field-p'.
+
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* mime.el (mm-arglist-to-arguments): New function.
+	(mm-define-generic): New macro.
+	(mime-entity-cooked-p): Use `mm-define-generic'.
+	(mime-entity-point-min): Use `mm-define-generic'.
+	(mime-insert-decoded-header): Use `mm-define-generic'.
+	(mime-entity-content): Use `mm-define-generic'.
+	(mime-write-entity-content): Use `mm-define-generic'.
+	(mime-write-entity): Use `mm-define-generic'.
+	(mime-write-entity-body): Use `mm-define-generic'.
+
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* mmbuffer.el (eword-visible-field-p): Moved from mime.el.
+
+	* mime.el: Move `eword-visible-field-p' to mmbuffer.el.
+	(mime-write-entity-body): Change message to `write-body'.
+
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* mmcooked.el, mmbuffer.el (open): Renamed from `open-entity'.
+
+	* mime.el (mime-open-entity): Change message to `open'.
+
+	* mime-def.el (mm-define-backend): Must `copy-alist'.
+
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+	* mmcooked.el, mmbuffer.el: Use `mm-define-backend' and
+	`mm-define-method'.
+
+	* mime.el: Move `mime-entity-implementation-alist' to mime-def.el.
+	(mime-find-function): New implementation.
+	(mime-entity-cooked-p): Use `mime-entity-send'.
+
+	* mime-def.el (mime-entity-implementation-alist): Moved from
+	mime.el.
+	(mm-define-backend): New macro.
+	(mm-define-method): New macro.
+
+
 1998-07-05  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
 
 	* FLIM: Version 1.8.1 (Kutsukawa) was released.
diff --git a/FLIM-VERSION b/FLIM-VERSION
index a2838ed..4971844 100644
--- a/FLIM-VERSION
+++ b/FLIM-VERSION
@@ -19,6 +19,7 @@
 1.7.0	Iseda			$(B0K@*ED(B
 1.8.0	-DÒkubo-A			$(BBg5WJ](B
 1.8.1	Kutsukawa		$(B5WDE@n(B
+1.8.2	Terada			$(B;{ED(B
 
 
 [Chao Version names]
@@ -35,3 +36,4 @@
 1.6.0	Kuj-Dò-A			$(B6e>r(B
 1.6.1	Ky-Dòto-A			$(B5~ET(B		; <=> JR, $(B6aE4(B
 1.7.0	Goj-Dò-A			$(B8^>r(B
+1.8.0	Shij-Dò-A			$(B;M>r(B
diff --git a/Makefile b/Makefile
index 7ab5b51..9280abf 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
 #
 
 PACKAGE = flim
-VERSION = 1.8.1
+VERSION = 1.8.2
 
 TAR	= tar
 RM	= /bin/rm -f
diff --git a/mime-def.el b/mime-def.el
index b8f4513..0e6fe72 100644
--- a/mime-def.el
+++ b/mime-def.el
@@ -24,7 +24,7 @@
 
 ;;; Code:
 
-(defconst mime-library-version-string "FLIM 1.8.1 - \"Kutsukawa\"")
+(defconst mime-library-version-string "FLIM 1.8.2 - \"Kutsukawa\"")
 
 
 ;;; @ variables
@@ -182,50 +182,75 @@
 ;;; @ MIME entity
 ;;;
 
-(defsubst make-mime-entity-internal (representation-type
-				     location
-				     &optional content-type children
-				     node-id
+(defsubst make-mime-entity-internal (representation-type location
+				     &optional content-type
+				     children parent node-id
 				     buffer
 				     header-start header-end
 				     body-start body-end)
   (vector representation-type location
-	  content-type children nil nil node-id
+	  content-type nil nil children parent node-id
 	  buffer header-start header-end body-start body-end
 	  nil nil))
 
-(defsubst mime-entity-representation-type-internal (entity) (aref entity  0))
-(defsubst mime-entity-location-internal            (entity) (aref entity  1))
-
-(defsubst mime-entity-content-type-internal (entity)        (aref entity  2))
-(defsubst mime-entity-children-internal (entity)            (aref entity  3))
-(defsubst mime-entity-content-disposition-internal (entity) (aref entity  4))
-(defsubst mime-entity-encoding-internal (entity)            (aref entity  5))
-(defsubst mime-entity-node-id-internal (entity)             (aref entity  6))
-
-(defsubst mime-entity-buffer-internal (entity)              (aref entity  7))
-(defsubst mime-entity-header-start-internal (entity)        (aref entity  8))
-(defsubst mime-entity-header-end-internal (entity)          (aref entity  9))
-(defsubst mime-entity-body-start-internal (entity)          (aref entity 10))
-(defsubst mime-entity-body-end-internal (entity)            (aref entity 11))
-
-(defsubst mime-entity-original-header-internal (entity)     (aref entity 12))
-(defsubst mime-entity-parsed-header-internal (entity)       (aref entity 13))
-
+(defsubst mime-entity-representation-type-internal (entity)
+  (aref entity 0))
 (defsubst mime-entity-set-representation-type-internal (entity type)
-  (aset entity  0 type))
+  (aset entity 0 type))
+(defsubst mime-entity-location-internal (entity)
+  (aref entity 1))
+
+(defsubst mime-entity-content-type-internal (entity)
+  (aref entity 2))
 (defsubst mime-entity-set-content-type-internal (entity type)
-  (aset entity  2 type))
-(defsubst mime-entity-set-children-internal (entity children)
-  (aset entity  3 children))
+  (aset entity 2 type))
+(defsubst mime-entity-content-disposition-internal (entity)
+  (aref entity 3))
 (defsubst mime-entity-set-content-disposition-internal (entity disposition)
-  (aset entity  4 disposition))
+  (aset entity 3 disposition))
+(defsubst mime-entity-encoding-internal (entity)
+  (aref entity 4))
 (defsubst mime-entity-set-encoding-internal (entity encoding)
-  (aset entity  5 encoding))
+  (aset entity 4 encoding))
+
+(defsubst mime-entity-children-internal (entity)
+  (aref entity 5))
+(defsubst mime-entity-set-children-internal (entity children)
+  (aset entity 5 children))
+(defsubst mime-entity-parent-internal (entity)
+  (aref entity 6))
+(defsubst mime-entity-node-id-internal (entity)
+  (aref entity 7))
+
+(defsubst mime-entity-buffer-internal (entity)
+  (aref entity 8))
+(defsubst mime-entity-set-buffer-internal (entity buffer)
+  (aset entity 8 buffer))
+(defsubst mime-entity-header-start-internal (entity)
+  (aref entity 9))
+(defsubst mime-entity-set-header-start-internal (entity point)
+  (aset entity 9 point))
+(defsubst mime-entity-header-end-internal (entity)
+  (aref entity 10))
+(defsubst mime-entity-set-header-end-internal (entity point)
+  (aset entity 10 point))
+(defsubst mime-entity-body-start-internal (entity)
+  (aref entity 11))
+(defsubst mime-entity-set-body-start-internal (entity point)
+  (aset entity 11 point))
+(defsubst mime-entity-body-end-internal (entity)
+  (aref entity 12))
+(defsubst mime-entity-set-body-end-internal (entity point)
+  (aset entity 12 point))
+
+(defsubst mime-entity-original-header-internal (entity)
+  (aref entity 13))
 (defsubst mime-entity-set-original-header-internal (entity header)
-  (aset entity 12 header))
-(defsubst mime-entity-set-parsed-header-internal (entity header)
   (aset entity 13 header))
+(defsubst mime-entity-parsed-header-internal (entity)
+  (aref entity 14))
+(defsubst mime-entity-set-parsed-header-internal (entity header)
+  (aset entity 14 header))
 
 
 ;;; @ message structure
@@ -255,6 +280,43 @@ message/rfc822, `mime-entity' structures of them are included in
 (make-variable-buffer-local 'mime-message-structure)
 
 
+;;; @ for mm-backend
+;;;
+
+(defvar mime-entity-implementation-alist nil)
+
+(defmacro mm-define-backend (type &optional parents)
+  (if parents
+      `(let ((rest ',(reverse parents)))
+	 (while rest
+	   (set-alist 'mime-entity-implementation-alist
+		      ',type
+		      (copy-alist
+		       (cdr (assq (car rest)
+				  mime-entity-implementation-alist))))
+	   (setq rest (cdr rest))
+	   ))))
+
+(defmacro mm-define-method (name args &rest body)
+  (let* ((specializer (car args))
+	 (class (nth 1 specializer))
+	 (self (car specializer)))
+    `(let ((imps (cdr (assq ',class mime-entity-implementation-alist)))
+	   (func (lambda ,(if self
+			      (cons self (cdr args))
+			    (cdr args))
+		   ,@body)))
+       (if imps
+	   (set-alist 'mime-entity-implementation-alist
+		      ',class (put-alist ',name func imps))
+	 (set-alist 'mime-entity-implementation-alist
+		    ',class
+		    (list (cons ',name func)))
+	 ))))
+
+(put 'mm-define-method 'lisp-indent-function 'defun)
+
+
 ;;; @ end
 ;;;
 
diff --git a/mime-parse.el b/mime-parse.el
index b198b96..d413655 100644
--- a/mime-parse.el
+++ b/mime-parse.el
@@ -184,8 +184,8 @@ If is is not found, return DEFAULT-ENCODING."
 	      (setq ncb (match-end 0))
 	      (save-restriction
 		(narrow-to-region cb ce)
-		(setq ret (mime-parse-message dc-ctl (cons i node-id)
-					      representation-type))
+		(setq ret (mime-parse-message dc-ctl representation-type
+					      entity (cons i node-id)))
 		)
 	      (setq children (cons ret children))
 	      (goto-char (setq cb ncb))
@@ -194,8 +194,8 @@ If is is not found, return DEFAULT-ENCODING."
 	    (setq ce (point-max))
 	    (save-restriction
 	      (narrow-to-region cb ce)
-	      (setq ret (mime-parse-message dc-ctl (cons i node-id)
-					    representation-type))
+	      (setq ret (mime-parse-message dc-ctl representation-type
+					    entity (cons i node-id)))
 	      )
 	    (setq children (cons ret children))
 	    (mime-entity-set-children-internal entity (nreverse children))
@@ -212,13 +212,14 @@ If is is not found, return DEFAULT-ENCODING."
      (narrow-to-region (mime-entity-body-start-internal entity)
 		       (mime-entity-body-end-internal entity))
      (list (mime-parse-message
-	    nil (cons 0 (mime-entity-node-id-internal entity))
-	    (mime-entity-representation-type-internal entity)))
+	    nil (mime-entity-representation-type-internal entity)
+	    entity (cons 0 (mime-entity-node-id-internal entity))))
      ))
   entity)
 
 ;;;###autoload
-(defun mime-parse-message (&optional default-ctl node-id representation-type)
+(defun mime-parse-message (&optional default-ctl representation-type
+				     parent node-id)
   "Parse current-buffer as a MIME message.
 DEFAULT-CTL is used when an entity does not have valid Content-Type
 field.  Its format must be as same as return value of
@@ -247,7 +248,7 @@ mime-{parse|read}-Content-Type."
       )
     (setq entity (make-mime-entity-internal (or representation-type 'buffer)
 					    (current-buffer)
-					    content-type nil node-id
+					    content-type nil parent node-id
 					    (current-buffer)
 					    header-start header-end
 					    body-start body-end))
@@ -273,7 +274,7 @@ If buffer is omitted, it parses current-buffer."
   (save-excursion
     (if buffer (set-buffer buffer))
     (setq mime-message-structure
-	  (mime-parse-message nil nil representation-type))
+	  (mime-parse-message nil representation-type))
     ))
 
 
diff --git a/mime.el b/mime.el
index 7961592..065e739 100644
--- a/mime.el
+++ b/mime.el
@@ -63,25 +63,14 @@ current-buffer, and return it.")
 ;;; @ Entity Representation and Implementation
 ;;;
 
-(defvar mime-entity-implementation-alist nil)
-
 (defsubst mime-find-function (service type)
   (let ((imps (cdr (assq type mime-entity-implementation-alist))))
     (if imps
-	(let ((func (cdr (assq service imps))))
-	  (unless func
-	    (setq func (intern (format "mm%s-%s" type service)))
-	    (set-alist 'mime-entity-implementation-alist
-		       type (put-alist service func imps))
-	    )
-	  func)
-      (let ((prefix (format "mm%s" type)))
-	(require (intern prefix))
-	(let ((func (intern (format "%s-%s" prefix service))))
-	  (set-alist 'mime-entity-implementation-alist
-		     type
-		     (list (cons service func)))
-	  func)))))
+	(cdr (assq service imps))
+      (require (intern (format "mm%s" type)))
+      (cdr (assq service
+		 (cdr (assq type mime-entity-implementation-alist))))
+      )))
 
 (defsubst mime-entity-function (entity service)
   (mime-find-function service
@@ -93,24 +82,49 @@ current-buffer, and return it.")
 	 entity
 	 args))
 
+(defsubst mm-arglist-to-arguments (arglist)
+  (let (dest)
+    (while arglist
+      (let ((arg (car arglist)))
+	(or (memq arg '(&optional &rest))
+	    (setq dest (cons arg dest)))
+	)
+      (setq arglist (cdr arglist)))
+    (nreverse dest)))
+
+(defmacro mm-define-generic (name args &optional doc)
+  (if doc
+      `(defun ,(intern (format "mime-%s" name)) ,args
+	 ,doc
+	 (mime-entity-send ,(car args) ',name
+			   ,@(mm-arglist-to-arguments (cdr args)))
+	 )
+    `(defun ,(intern (format "mime-%s" name)) ,args
+       (mime-entity-send ,(car args) ',name
+			 ,@(mm-arglist-to-arguments (cdr args)))
+       )))
+
+(put 'mm-define-generic 'lisp-indent-function 'defun)
+
 (defun mime-open-entity (type location)
   "Open an entity and return it.
 TYPE is representation-type.
 LOCATION is location of entity.  Specification of it is depended on
 representation-type."
-  (funcall (mime-find-function 'open-entity type) location)
-  )
+  (let ((entity (make-mime-entity-internal type location)))
+    (mime-entity-send entity 'initialize-instance)
+    entity))
 
-(defun mime-entity-cooked-p (entity)
-  "Return non-nil if contents of ENTITY has been already code-converted."
-  (funcall (mime-entity-function entity 'cooked-p))
-  )
+(mm-define-generic entity-cooked-p (entity)
+  "Return non-nil if contents of ENTITY has been already code-converted.")
 
 
 ;;; @ Entity as node of message
 ;;;
 
-(defalias 'mime-entity-children	'mime-entity-children-internal)
+(defun mime-entity-children (entity)
+  (or (mime-entity-children-internal entity)
+      (mime-entity-send entity 'entity-children)))
 
 (defalias 'mime-entity-node-id 'mime-entity-node-id-internal)
 
@@ -139,18 +153,15 @@ If MESSAGE is not specified, `mime-message-structure' is used."
 
 (defun mime-entity-parent (entity &optional message)
   "Return mother entity of ENTITY.
-If MESSAGE is not specified, `mime-message-structure' in the buffer of
-ENTITY is used."
-  (mime-find-entity-from-node-id
-   (cdr (mime-entity-node-id entity))
-   (or message
-       (save-excursion
-	 (set-buffer (mime-entity-buffer entity))
-	 mime-message-structure))))
+If MESSAGE is specified, it is regarded as root entity."
+  (if (equal entity message)
+      nil
+    (mime-entity-parent-internal entity)))
 
-(defun mime-root-entity-p (entity)
-  "Return t if ENTITY is root-entity (message)."
-  (null (mime-entity-node-id entity)))
+(defun mime-root-entity-p (entity &optional message)
+  "Return t if ENTITY is root-entity (message).
+If MESSAGE is specified, it is regarded as root entity."
+  (null (mime-entity-parent entity message)))
 
 
 ;;; @ Entity Buffer
@@ -160,11 +171,11 @@ ENTITY is used."
   (or (mime-entity-buffer-internal entity)
       (mime-entity-send entity 'entity-buffer)))
 
-(defun mime-entity-point-min (entity)
-  (mime-entity-send entity 'entity-point-min))
+(mm-define-generic entity-point-min (entity)
+  "Return the start point of ENTITY in the buffer which contains ENTITY.")
 
-(defun mime-entity-point-max (entity)
-  (mime-entity-send entity 'entity-point-max))
+(mm-define-generic entity-point-max (entity)
+  "Return the end point of ENTITY in the buffer which contains ENTITY.")
 
 (defun mime-entity-header-start (entity)
   (or (mime-entity-header-start-internal entity)
@@ -270,30 +281,9 @@ ENTITY is used."
 		    entity (put-alist field-name field header))
 		   field)))))))
 
-(defun eword-visible-field-p (field-name visible-fields invisible-fields)
-  (or (catch 'found
-	(while visible-fields
-	  (let ((regexp (car visible-fields)))
-	    (if (string-match regexp field-name)
-		(throw 'found t)
-	      ))
-	  (setq visible-fields (cdr visible-fields))
-	  ))
-      (catch 'found
-	(while invisible-fields
-	  (let ((regexp (car invisible-fields)))
-	    (if (string-match regexp field-name)
-		(throw 'found nil)
-	      ))
-	  (setq invisible-fields (cdr invisible-fields))
-	  )
-	t)))
-
-(defun mime-insert-decoded-header (entity &optional invisible-fields
+(mm-define-generic insert-decoded-header (entity &optional invisible-fields
 					  visible-fields)
-  "Insert before point a decoded header of ENTITY."
-  (mime-entity-send entity 'insert-decoded-header
-		    invisible-fields visible-fields))
+  "Insert before point a decoded header of ENTITY.")
 
 
 ;;; @ Entity Attributes
@@ -336,20 +326,17 @@ ENTITY is used."
 ;;; @ Entity Content
 ;;;
 
-(defun mime-entity-content (entity)
-  (mime-entity-send entity 'entity-content))
+(mm-define-generic entity-content (entity)
+  "Return content of ENTITY as byte sequence (string).")
 
-(defun mime-write-entity-content (entity filename)
-  "Write content of ENTITY into FILENAME."
-  (mime-entity-send entity 'write-entity-content filename))
+(mm-define-generic write-entity-content (entity filename)
+  "Write content of ENTITY into FILENAME.")
 
-(defun mime-write-entity (entity filename)
-  "Write ENTITY into FILENAME."
-  (mime-entity-send entity 'write-entity filename))
+(mm-define-generic write-entity (entity filename)
+  "Write header and body of ENTITY into FILENAME.")
 
-(defun mime-write-entity-body (entity filename)
-  "Write body of ENTITY into FILENAME."
-  (mime-entity-send entity 'write-entity-body filename))
+(mm-define-generic write-entity-body (entity filename)
+  "Write body of ENTITY into FILENAME.")
 
 
 ;;; @ end
diff --git a/mmbuffer.el b/mmbuffer.el
index e9d24b5..448d88e 100644
--- a/mmbuffer.el
+++ b/mmbuffer.el
@@ -25,20 +25,50 @@
 ;;; Code:
 
 (require 'mime)
+(require 'mime-parse)
 
-(defun mmbuffer-open-entity (location)
-  (mime-parse-buffer location)
-  )
+(mm-define-backend buffer)
 
-(defsubst mmbuffer-entity-point-min (entity)
-  (mime-entity-header-start-internal entity)
-  )
+(mm-define-method initialize-instance ((entity buffer))
+  (mime-entity-set-buffer-internal
+   entity (mime-entity-location-internal entity))
+  (save-excursion
+    (set-buffer (mime-entity-buffer-internal entity))
+    (setq mime-message-structure entity)
+    (let ((header-start (point-min))
+	  header-end
+	  body-start
+	  (body-end (point-max)))
+      (goto-char header-start)
+      (if (re-search-forward "^$" nil t)
+	  (setq header-end (match-end 0)
+		body-start (if (= header-end body-end)
+			       body-end
+			     (1+ header-end)))
+	(setq header-end (point-min)
+	      body-start (point-min)))
+      (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)
+	     )))
+	)
+      (mime-entity-set-header-start-internal entity header-start)
+      (mime-entity-set-header-end-internal entity header-end)
+      (mime-entity-set-body-start-internal entity body-start)
+      (mime-entity-set-body-end-internal entity body-end)
+      )))
 
-(defsubst mmbuffer-entity-point-max (entity)
-  (mime-entity-body-end-internal entity)
-  )
+(mm-define-method entity-point-min ((entity buffer))
+  (mime-entity-header-start-internal entity))
 
-(defun mmbuffer-fetch-field (entity field-name)
+(mm-define-method entity-point-max ((entity buffer))
+  (mime-entity-body-end-internal entity))
+
+(mm-define-method fetch-field ((entity buffer) field-name)
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
     (save-restriction
@@ -47,9 +77,25 @@
       (std11-fetch-field field-name)
       )))
 
-(defun mmbuffer-cooked-p () nil)
-
-(defun mmbuffer-entity-content (entity)
+(mm-define-method entity-cooked-p ((entity buffer)) nil)
+
+(mm-define-method entity-children ((entity buffer))
+  (let* ((content-type (mime-entity-content-type entity))
+	 (primary-type (mime-content-type-primary-type content-type)))
+    (cond ((eq primary-type 'multipart)
+	   (mime-parse-multipart entity)
+	   (mime-entity-children-internal entity)
+	   )
+	  ((and (eq primary-type 'message)
+		(memq (mime-content-type-subtype content-type)
+		      '(rfc822 news external-body)
+		      ))
+	   (mime-parse-encapsulated entity)
+	   (mime-entity-children-internal entity)
+	   )
+	  )))
+
+(mm-define-method entity-content ((entity buffer))
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
     (mime-decode-string
@@ -57,7 +103,7 @@
 		       (mime-entity-body-end-internal entity))
      (mime-entity-encoding entity))))
 
-(defun mmbuffer-write-entity-content (entity filename)
+(mm-define-method write-entity-content ((entity buffer) filename)
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
     (mime-write-decoded-region (mime-entity-body-start-internal entity)
@@ -66,22 +112,44 @@
 			       (or (mime-entity-encoding entity) "7bit"))
     ))
 
-(defun mmbuffer-write-entity (entity filename)
+(mm-define-method write-entity ((entity buffer) filename)
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
-    (write-region-as-binary (mmbuffer-entity-point-min entity)
-			    (mmbuffer-entity-point-max entity) filename)
+    (write-region-as-binary (mime-entity-header-start-internal entity)
+			    (mime-entity-body-end-internal entity)
+			    filename)
     ))
 
-(defun mmbuffer-write-entity-body (entity filename)
+(mm-define-method write-entity-body ((entity buffer) filename)
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
     (write-region-as-binary (mime-entity-body-start-internal entity)
-			    (mime-entity-body-end-internal entity) filename)
+			    (mime-entity-body-end-internal entity)
+			    filename)
     ))
 
-(defun mmbuffer-insert-decoded-header (entity &optional invisible-fields
-					      visible-fields)
+(defun mime-visible-field-p (field-name visible-fields invisible-fields)
+  (or (catch 'found
+	(while visible-fields
+	  (let ((regexp (car visible-fields)))
+	    (if (string-match regexp field-name)
+		(throw 'found t)
+	      ))
+	  (setq visible-fields (cdr visible-fields))
+	  ))
+      (catch 'found
+	(while invisible-fields
+	  (let ((regexp (car invisible-fields)))
+	    (if (string-match regexp field-name)
+		(throw 'found nil)
+	      ))
+	  (setq invisible-fields (cdr invisible-fields))
+	  )
+	t)))
+
+(mm-define-method insert-decoded-header ((entity buffer)
+					 &optional invisible-fields
+					 visible-fields)
   (save-restriction
     (narrow-to-region (point)(point))
     (let ((the-buf (current-buffer))
@@ -99,8 +167,8 @@
 		  field-name (buffer-substring beg (1- p))
 		  len (string-width field-name)
 		  end (std11-field-end))
-	    (when (eword-visible-field-p field-name
-					 visible-fields invisible-fields)
+	    (when (mime-visible-field-p field-name
+					visible-fields invisible-fields)
 	      (setq field (intern (capitalize field-name)))
 	      (save-excursion
 		(set-buffer the-buf)
diff --git a/mmcooked.el b/mmcooked.el
index d9d6608..cd261f4 100644
--- a/mmcooked.el
+++ b/mmcooked.el
@@ -26,19 +26,11 @@
 
 (require 'mmbuffer)
 
-(defun mmcooked-open-entity (location)
-  (mime-parse-buffer location 'cooked)
-  )
+(mm-define-backend cooked (buffer))
 
-(defalias 'mmcooked-entity-point-min	'mmbuffer-entity-point-min)
-(defalias 'mmcooked-entity-point-max	'mmbuffer-entity-point-max)
-(defalias 'mmcooked-fetch-field		'mmbuffer-fetch-field)
+(mm-define-method entity-cooked-p ((entity cooked)) t)
 
-(defun mmcooked-cooked-p () t)
-
-(defalias 'mmcooked-entity-content	'mmbuffer-entity-content)
-
-(defun mmcooked-write-entity-content (entity filename)
+(mm-define-method write-entity-content ((entity cooked) filename)
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
     (let ((encoding (or (mime-entity-encoding entity) "7bit")))
@@ -50,72 +42,29 @@
 				   filename encoding)
 	))))
 
-(defun mmcooked-write-entity (entity filename)
+(mm-define-method write-entity ((entity cooked) filename)
   (save-excursion
-    (set-buffer (mime-entity-buffer entity))
-    (write-region (mime-entity-point-min entity)
-		  (mime-entity-point-max entity) filename)
+    (set-buffer (mime-entity-buffer-internal entity))
+    (write-region (mime-entity-header-start-internal entity)
+		  (mime-entity-body-end-internal entity)
+		  filename)
     ))
 
-(defun mmcooked-write-entity-body (entity filename)
+(mm-define-method write-entity-body ((entity cooked) filename)
   (save-excursion
-    (set-buffer (mime-entity-buffer entity))
-    (write-region (mime-entity-body-start entity)
-		  (mime-entity-body-end entity) filename)
+    (set-buffer (mime-entity-buffer-internal entity))
+    (write-region (mime-entity-body-start-internal entity)
+		  (mime-entity-body-end-internal entity)
+		  filename)
     ))
 
-(defun mmcooked-insert-decoded-header (entity &optional invisible-fields
-					      visible-fields)
-  (save-restriction
-    (narrow-to-region (point)(point))
-    (let ((the-buf (current-buffer))
-	  (src-buf (mime-entity-buffer entity))
-	  (h-end (mime-entity-header-end entity))
-	  beg p end field-name len field)
-      (save-excursion
-	(set-buffer src-buf)
-	(goto-char (mime-entity-header-start entity))
-	(save-restriction
-	  (narrow-to-region (point) h-end)
-	  (while (re-search-forward std11-field-head-regexp nil t)
-	    (setq beg (match-beginning 0)
-		  p (match-end 0)
-		  field-name (buffer-substring beg (1- p))
-		  len (string-width field-name)
-		  end (std11-field-end))
-	    (when (eword-visible-field-p field-name
-					 visible-fields invisible-fields)
-	      (setq field (intern (capitalize field-name)))
-	      (save-excursion
-		(set-buffer the-buf)
-		(insert field-name)
-		(insert ":")
-		(cond ((memq field eword-decode-ignored-field-list)
-		       ;; Don't decode
-		       (insert-buffer-substring src-buf p end)
-		       )
-		      ((memq field eword-decode-structured-field-list)
-		       ;; Decode as structured field
-		       (let ((body (save-excursion
-				     (set-buffer src-buf)
-				     (buffer-substring p end)
-				     ))
-			     default-mime-charset)
-			 (insert (eword-decode-and-fold-structured-field
-				  body (1+ len)))
-			 ))
-		      (t
-		       ;; Decode as unstructured field
-		       (let ((body (save-excursion
-				     (set-buffer src-buf)
-				     (buffer-substring p end)
-				     ))
-			     default-mime-charset)
-			 (insert (eword-decode-unstructured-field-body
-				  body (1+ len)))
-			 )))
-		(insert "\n")
-		))))))))
+(mm-define-method insert-decoded-header ((entity cooked)
+					 &optional invisible-fields
+					 visible-fields)
+  (let (default-mime-charset)
+    (funcall (mime-find-function 'insert-decoded-header 'buffer)
+	     entity invisible-fields visible-fields)
+    ))
 
 
 ;;; @ end