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>
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.
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]
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
#
PACKAGE = flim
-VERSION = 1.8.1
+VERSION = 1.9.0
TAR = tar
RM = /bin/rm -f
;;; 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
(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
;;;
<!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
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>
\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
@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
<!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
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>
\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
@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
(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))
(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
(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)
(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
(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))
))
"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.")
;;; @ 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
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)
(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
(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)
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
;;; @ 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
;;; 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)
(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
projects / elisp / flim.git / commitdiff