Sync up with flim-1_8_1 to flim-1_9_0.
authorakr <akr>
Sat, 18 Jul 1998 06:10:32 +0000 (06:10 +0000)
committerakr <akr>
Sat, 18 Jul 1998 06:10:32 +0000 (06:10 +0000)
12 files changed:
ChangeLog
FLIM-VERSION
Makefile
mime-def.el
mime-en.sgml
mime-en.texi
mime-ja.sgml
mime-ja.texi
mime-parse.el
mime.el
mmbuffer.el
mmcooked.el

index d060c7c..15452ea 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,14 +1,18 @@
 1998-07-18  Tanaka Akira  <akr@jaist.ac.jp>
 
-       * (TESTPAT): add test driver for FLIM-FLAM.
+       * Sync up with flim-1_8_1 to flim-1_9_0.
+
+1998-07-18  Tanaka Akira  <akr@jaist.ac.jp>
+
+       * (TESTPAT): add test driver for FLIM-FLAM.
 
 1998-07-16  Tanaka Akira  <akr@jaist.ac.jp>
 
-       * (TESTPAT): change format to s-exp.
+       * (TESTPAT): change format to s-exp.
 
 1998-07-13  Tanaka Akira  <akr@jaist.ac.jp>
 
-       * (TESTPAT): add one test.
+       * (TESTPAT): add one test.
 
 1998-07-06  Tanaka Akira  <akr@jaist.ac.jp>
 
@@ -20,7 +24,7 @@
 
 1998-05-27  Tanaka Akira  <akr@jaist.ac.jp>
 
-       * eword-decode.el (eword-after-encoded-word-in-phrase-regexp): remove `
+       * eword-decode.el (eword-after-encoded-word-in-phrase-regexp): remove
        `(' to do not decode encoded word just before comment.
 
 1998-05-27  Tanaka Akira  <akr@jaist.ac.jp>
 
        * Sync up with flim-1_0_0 to flim-1_0_1.
 
+1998-07-15  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * FLIM: Version 1.9.0 (Terada) was released.
+
+1998-07-10  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * mime-parse.el (mime-parse-multipart): Set message/x-broken if
+       parsing is failed.
+
+1998-07-10  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * mmbuffer.el (entity-children): Don't use
+       `mime-entity-children-internal'.
+
+       * mime-parse.el (mime-parse-multipart): Modify for
+       `mime-parse-message'; return children.
+       (mime-parse-encapsulated): Likewise.
+       (mime-parse-message): Change interface; delete DOC-string; don't
+       parse children instantly.
+       (mime-parse-buffer): Modify for `mime-parse-message'.
+
+       * mime-parse.el (mime-parse-message): Delete autoload cookie.
+
+       * mime.el: Delete autoload setting for `mime-parse-message'.
+
+       * mime-en.sgml, mime-ja.sgml (Entity creation): Delete description
+       of `mime-parse-message'; modify description of `mime-parse-buffer'
+       to add `representation-type'.
+
+\f
+1998-07-07  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * FLIM-Chao: Version 1.8.0 (Shij\e.D\eNr) was released.\e*B
+
+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.
+
+\f
 1998-07-05  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
 
        * FLIM: Version 1.8.1 (Kutsukawa) was released.
index a2838ed..c5eee0f 100644 (file)
@@ -19,6 +19,7 @@
 1.7.0  Iseda                   \e$(B0K@*ED\e(B
 1.8.0  \e-DÒkubo\e-A                     \e$(BBg5WJ]\e(B
 1.8.1  Kutsukawa               \e$(B5WDE@n\e(B
+1.9.0  Terada                  \e$(B;{ED\e(B
 
 
 [Chao Version names]
@@ -35,3 +36,4 @@
 1.6.0  Kuj\e-Dò\e-A                      \e$(B6e>r\e(B
 1.6.1  Ky\e-Dòto\e-A                     \e$(B5~ET\e(B             ; <=> JR, \e$(B6aE4\e(B
 1.7.0  Goj\e-Dò\e-A                      \e$(B8^>r\e(B
+1.8.0  Shij\e-Dò\e-A                     \e$(B;M>r\e(B
index 7ab5b51..2de3bac 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
 #
 
 PACKAGE = flim
-VERSION = 1.8.1
+VERSION = 1.9.0
 
 TAR    = tar
 RM     = /bin/rm -f
index 90c8a9c..bfccf3e 100644 (file)
@@ -25,7 +25,7 @@
 ;;; Code:
 
 (defconst mime-spadework-module-version-string
-  "FLIM-FLAM 1.8.0 - \"\e$B@VAIK'\e(B\" 7.5R4.0/14.0")
+  "FLIM-FLAM 1.9.0 - \"\e$B6d<k\e(B\" 5.0R4.5/13.0")
 
 
 ;;; @ variables
 ;;; @ 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
@@ -256,6 +281,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
 ;;;
 
index 8d0c86e..f9d5d4e 100644 (file)
@@ -1,6 +1,6 @@
 <!doctype sinfo system>
 <head>
-<title>FLIM 1.8 Manual about MIME Features
+<title>FLIM 1.9 Manual about MIME Features
 <author>MORIOKA Tomohiko <mail>morioka@jaist.ac.jp</mail>
 <date>1998/07/01
 
@@ -98,20 +98,17 @@ Open an entity and return it.
 depended on representation-type.
 </defun>
 
-<defun name="mime-parse-message">
-         <opts> default-ctl node-id
-<p>
-Parse current buffer as message, and return the result as mime-entity.
-</defun>
-
 <defun name="mime-parse-buffer">
-         <opts> buffer
+         <opts> buffer type
 <p>
 Parse <var>buffer</var> as message, and set the result to buffer local
 variable <code>mime-message-structure</code> of <var>buffer</var> as
 mime-entity.
 <p>
 If <var>buffer</var> is omitted, current buffer is used.
+<p>
+<var>type</var> is representation-type of created mime-entity. <cf
+node="mm-backend"> Default value is <var>buffer</var>.
 </defun>
 
 
index e28e73f..a95ec3d 100644 (file)
@@ -1,13 +1,13 @@
 \input texinfo.tex
 @setfilename mime-en.info
-@settitle{FLIM 1.8 Manual about MIME Features}
+@settitle{FLIM 1.9 Manual about MIME Features}
 @titlepage
-@title FLIM 1.8 Manual about MIME Features
+@title FLIM 1.9 Manual about MIME Features
 @author MORIOKA Tomohiko <morioka@@jaist.ac.jp>
 @subtitle 1998/07/01
 @end titlepage
 @node Top, Introduction, (dir), (dir)
-@top FLIM 1.8 Manual about MIME Features
+@top FLIM 1.9 Manual about MIME Features
 
 @ifinfo
 
@@ -126,19 +126,16 @@ on representation-type.
 @end defun
 
 
-@defun mime-parse-message &optional  default-ctl node-id
-
-Parse current buffer as message, and return the result as mime-entity.
-@end defun
-
-
-@defun mime-parse-buffer &optional  buffer
+@defun mime-parse-buffer &optional  buffer type
 
 Parse @var{buffer} as message, and set the result to buffer local
 variable @code{mime-message-structure} of @var{buffer} as
 mime-entity.@refill
 
-If @var{buffer} is omitted, current buffer is used.
+If @var{buffer} is omitted, current buffer is used.@refill
+
+@var{type} is representation-type of created
+mime-entity. (cf. @ref{mm-backend}) Default value is @var{buffer}.
 @end defun
 
 
index 2a726d5..c3cfb08 100644 (file)
@@ -1,6 +1,6 @@
 <!doctype sinfo system>
 <head>
-<title>FLIM 1.8 MIME \e$B5!G=@bL@=q\e(B
+<title>FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B
 <author>\e$B<i2,\e(B \e$BCNI'\e(B <mail>morioka@jaist.ac.jp</mail>
 <date>1998/07/01
 
@@ -102,20 +102,17 @@ Open an entity and return it.
 depended on representation-type.
 </defun>
 
-<defun name="mime-parse-message">
-         <opts> default-ctl node-id
-<p>
-\e$B8=:_$N\e(B buffer \e$B$r\e(B message \e$B$H$7$F9=J82r@O$7!"$=$N7k2L$N\e(B mime-entity \e$B$rJV\e(B
-\e$B$9!#\e(B
-</defun>
-
 <defun name="mime-parse-buffer">
-         <opts> buffer
+         <opts> buffer type
 <p>
 <var>buffer</var> \e$B$r\e(B message \e$B$H$7$F9=J82r@O$7!"$=$N7k2L$N\e(B mime-entity 
 \e$B$r\e(B <var>buffer</var> \e$B$N\e(B<code>mime-message-structure</code> \e$B$K3JG<$9$k!#\e(B
 <p>
 <var>buffer</var> \e$B$,>JN,$5$l$?>l9g!"8=:_$N\e(B buffer \e$B$r9=J82r@O$9$k!#\e(B
+<p>
+<var>type</var> \e$B$,;XDj$5$l$?>l9g!"$=$NCM$r@8@.$5$l$k\e(B mime-entity \e$B$NI=\e(B
+\e$B>]7?$H$7$FMQ$$$k!#>JN,$5$l$?>l9g$O\e(B <var>buffer</var> \e$B$H$J$k!#\e(B<cf
+node="mm-backend">
 </defun>
 
 
index e1fd0bb..7474bc2 100644 (file)
@@ -1,13 +1,13 @@
 \input texinfo.tex
 @setfilename mime-ja.info
-@settitle{FLIM 1.8 MIME \e$B5!G=@bL@=q\e(B}
+@settitle{FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B}
 @titlepage
-@title FLIM 1.8 MIME \e$B5!G=@bL@=q\e(B
+@title FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B
 @author \e$B<i2,\e(B \e$BCNI'\e(B <morioka@@jaist.ac.jp>
 @subtitle 1998/07/01
 @end titlepage
 @node Top, Introduction, (dir), (dir)
-@top FLIM 1.8 MIME \e$B5!G=@bL@=q\e(B
+@top FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B
 
 @ifinfo
 
@@ -132,18 +132,15 @@ on representation-type.
 @end defun
 
 
-@defun mime-parse-message &optional  default-ctl node-id
-
-\e$B8=:_$N\e(B buffer \e$B$r\e(B message \e$B$H$7$F9=J82r@O$7!"$=$N7k2L$N\e(B mime-entity \e$B$rJV$9!#\e(B
-@end defun
-
-
-@defun mime-parse-buffer &optional  buffer
+@defun mime-parse-buffer &optional  buffer type
 
 @var{buffer} \e$B$r\e(B message \e$B$H$7$F9=J82r@O$7!"$=$N7k2L$N\e(B mime-entity \e$B$r\e(B 
 @var{buffer} \e$B$N\e(B@code{mime-message-structure} \e$B$K3JG<$9$k!#\e(B@refill
 
-@var{buffer} \e$B$,>JN,$5$l$?>l9g!"8=:_$N\e(B buffer \e$B$r9=J82r@O$9$k!#\e(B
+@var{buffer} \e$B$,>JN,$5$l$?>l9g!"8=:_$N\e(B buffer \e$B$r9=J82r@O$9$k!#\e(B@refill
+
+@var{type} \e$B$,;XDj$5$l$?>l9g!"$=$NCM$r@8@.$5$l$k\e(B mime-entity \e$B$NI=>]7?$H$7\e(B
+\e$B$FMQ$$$k!#>JN,$5$l$?>l9g$O\e(B @var{buffer} \e$B$H$J$k!#\e(B(cf. @ref{mm-backend})
 @end defun
 
 
index b198b96..fa20a85 100644 (file)
@@ -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 representation-type dc-ctl
+                                             entity (cons i node-id)))
                )
              (setq children (cons ret children))
              (goto-char (setq cb ncb))
@@ -194,16 +194,16 @@ 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 representation-type dc-ctl
+                                           entity (cons i node-id)))
              )
            (setq children (cons ret children))
            (mime-entity-set-children-internal entity (nreverse children))
            )
        (mime-entity-set-content-type-internal
-        entity (make-mime-content-type 'application 'octet-stream))
-       )))
-  entity)
+        entity (make-mime-content-type 'message 'x-broken))
+       nil)
+      )))
 
 (defun mime-parse-encapsulated (entity)
   (mime-entity-set-children-internal
@@ -212,22 +212,17 @@ 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)))
-     ))
-  entity)
+           (mime-entity-representation-type-internal entity) nil
+           entity (cons 0 (mime-entity-node-id-internal entity))))
+     )))
 
-;;;###autoload
-(defun mime-parse-message (&optional default-ctl node-id representation-type)
-  "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
-mime-{parse|read}-Content-Type."
+(defun mime-parse-message (representation-type &optional default-ctl 
+                                              parent node-id)
   (let ((header-start (point-min))
        header-end
        body-start
        (body-end (point-max))
-       content-type primary-type entity)
+       content-type)
     (goto-char header-start)
     (if (re-search-forward "^$" nil t)
        (setq header-end (match-end 0)
@@ -242,25 +237,15 @@ mime-{parse|read}-Content-Type."
                               (if str
                                   (mime-parse-Content-Type str)
                                 ))
-                            default-ctl)
-           primary-type (mime-content-type-primary-type content-type))
+                            default-ctl))
       )
-    (setq entity (make-mime-entity-internal (or representation-type 'buffer)
-                                           (current-buffer)
-                                           content-type nil node-id
-                                           (current-buffer)
-                                           header-start header-end
-                                           body-start body-end))
-    (cond ((eq primary-type 'multipart)
-          (mime-parse-multipart entity)
-          )
-         ((and (eq primary-type 'message)
-               (memq (mime-content-type-subtype content-type)
-                     '(rfc822 news external-body)
-                     ))
-          (mime-parse-encapsulated entity)
-          )
-         (t entity))))
+    (make-mime-entity-internal representation-type
+                              (current-buffer)
+                              content-type nil parent node-id
+                              (current-buffer)
+                              header-start header-end
+                              body-start body-end)
+    ))
 
 
 ;;; @ for buffer
@@ -273,7 +258,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 (or representation-type 'buffer) nil))
     ))
 
 
diff --git a/mime.el b/mime.el
index 7961592..338aa9c 100644 (file)
--- a/mime.el
+++ b/mime.el
@@ -53,9 +53,6 @@ and return parsed it.")
   "Read field-body of Content-Transfer-Encoding field from
 current-buffer, and return it.")
 
-(autoload 'mime-parse-message "mime-parse"
-  "Parse current-buffer as a MIME message.")
-
 (autoload 'mime-parse-buffer "mime-parse"
   "Parse BUFFER as a MIME message.")
 
@@ -63,25 +60,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 +79,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 +150,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 +168,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 +278,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 +323,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
index e9d24b5..76b3fdc 100644 (file)
 ;;; 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
       (std11-fetch-field field-name)
       )))
 
-(defun mmbuffer-cooked-p () nil)
+(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)
+          )
+         ((and (eq primary-type 'message)
+               (memq (mime-content-type-subtype content-type)
+                     '(rfc822 news external-body)
+                     ))
+          (mime-parse-encapsulated entity)
+          ))
+    ))
 
-(defun mmbuffer-entity-content (entity)
+(mm-define-method entity-content ((entity buffer))
   (save-excursion
     (set-buffer (mime-entity-buffer-internal entity))
     (mime-decode-string
                       (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)
                               (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))
                  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)
index d9d6608..cd261f4 100644 (file)
 
 (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")))
                                   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