From b597a8bffd0e0c3645546f206f2d962b4f93801c Mon Sep 17 00:00:00 2001 From: akr Date: Sat, 18 Jul 1998 06:10:32 +0000 Subject: [PATCH] Sync up with flim-1_8_1 to flim-1_9_0. --- ChangeLog | 116 +++++++++++++++++++++++++++++++++++++++++++++++-- FLIM-VERSION | 2 + Makefile | 2 +- mime-def.el | 126 +++++++++++++++++++++++++++++++++++++++-------------- mime-en.sgml | 13 +++--- mime-en.texi | 19 ++++---- mime-ja.sgml | 15 +++---- mime-ja.texi | 19 ++++---- mime-parse.el | 59 ++++++++++--------------- mime.el | 134 +++++++++++++++++++++++++-------------------------------- mmbuffer.el | 110 ++++++++++++++++++++++++++++++++++++---------- mmcooked.el | 91 +++++++++------------------------------ 12 files changed, 425 insertions(+), 281 deletions(-) diff --git a/ChangeLog b/ChangeLog index d060c7c..15452ea 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,14 +1,18 @@ 1998-07-18 Tanaka Akira - * (TESTPAT): add test driver for FLIM-FLAM. + * Sync up with flim-1_8_1 to flim-1_9_0. + +1998-07-18 Tanaka Akira + + * (TESTPAT): add test driver for FLIM-FLAM. 1998-07-16 Tanaka Akira - * (TESTPAT): change format to s-exp. + * (TESTPAT): change format to s-exp. 1998-07-13 Tanaka Akira - * (TESTPAT): add one test. + * (TESTPAT): add one test. 1998-07-06 Tanaka Akira @@ -20,7 +24,7 @@ 1998-05-27 Tanaka Akira - * 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 @@ -134,6 +138,110 @@ * Sync up with flim-1_0_0 to flim-1_0_1. +1998-07-15 MORIOKA Tomohiko + + * FLIM: Version 1.9.0 (Terada) was released. + +1998-07-10 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-multipart): Set message/x-broken if + parsing is failed. + +1998-07-10 MORIOKA Tomohiko + + * 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'. + + +1998-07-07 MORIOKA Tomohiko + + * FLIM-Chao: Version 1.8.0 (Shij.DNr) was released.*B + +1998-07-07 MORIOKA Tomohiko + + * 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 + + * mmbuffer.el (mime-visible-field-p): Renamed from + `eword-visible-field-p'. + +1998-07-07 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * 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 * FLIM: Version 1.8.1 (Kutsukawa) was released. diff --git a/FLIM-VERSION b/FLIM-VERSION index a2838ed..c5eee0f 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.9.0 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..2de3bac 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # PACKAGE = flim -VERSION = 1.8.1 +VERSION = 1.9.0 TAR = tar RM = /bin/rm -f diff --git a/mime-def.el b/mime-def.el index 90c8a9c..bfccf3e 100644 --- a/mime-def.el +++ b/mime-def.el @@ -25,7 +25,7 @@ ;;; Code: (defconst mime-spadework-module-version-string - "FLIM-FLAM 1.8.0 - \"$B@VAIK'(B\" 7.5R4.0/14.0") + "FLIM-FLAM 1.9.0 - \"$B6d -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> diff --git a/mime-en.texi b/mime-en.texi index e28e73f..a95ec3d 100644 --- a/mime-en.texi +++ b/mime-en.texi @@ -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 diff --git a/mime-ja.sgml b/mime-ja.sgml index 2a726d5..c3cfb08 100644 --- a/mime-ja.sgml +++ b/mime-ja.sgml @@ -1,6 +1,6 @@ <!doctype sinfo system> <head> -<title>FLIM 1.8 MIME $B5!G=@bL@=q(B +<title>FLIM 1.9 MIME $B5!G=@bL@=q(B <author>$B<i2,(B $BCNI'(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> -$B8=:_$N(B buffer $B$r(B message $B$H$7$F9=J82r@O$7!"$=$N7k2L$N(B mime-entity $B$rJV(B -$B$9!#(B -</defun> - <defun name="mime-parse-buffer"> - <opts> buffer + <opts> buffer type <p> <var>buffer</var> $B$r(B message $B$H$7$F9=J82r@O$7!"$=$N7k2L$N(B mime-entity $B$r(B <var>buffer</var> $B$N(B<code>mime-message-structure</code> $B$K3JG<$9$k!#(B <p> <var>buffer</var> $B$,>JN,$5$l$?>l9g!"8=:_$N(B buffer $B$r9=J82r@O$9$k!#(B +<p> +<var>type</var> $B$,;XDj$5$l$?>l9g!"$=$NCM$r@8@.$5$l$k(B mime-entity $B$NI=(B +$B>]7?$H$7$FMQ$$$k!#>JN,$5$l$?>l9g$O(B <var>buffer</var> $B$H$J$k!#(B<cf +node="mm-backend"> </defun> diff --git a/mime-ja.texi b/mime-ja.texi index e1fd0bb..7474bc2 100644 --- a/mime-ja.texi +++ b/mime-ja.texi @@ -1,13 +1,13 @@ \input texinfo.tex @setfilename mime-ja.info -@settitle{FLIM 1.8 MIME $B5!G=@bL@=q(B} +@settitle{FLIM 1.9 MIME $B5!G=@bL@=q(B} @titlepage -@title FLIM 1.8 MIME $B5!G=@bL@=q(B +@title FLIM 1.9 MIME $B5!G=@bL@=q(B @author $B<i2,(B $BCNI'(B <morioka@@jaist.ac.jp> @subtitle 1998/07/01 @end titlepage @node Top, Introduction, (dir), (dir) -@top FLIM 1.8 MIME $B5!G=@bL@=q(B +@top FLIM 1.9 MIME $B5!G=@bL@=q(B @ifinfo @@ -132,18 +132,15 @@ on representation-type. @end defun -@defun mime-parse-message &optional default-ctl node-id - -$B8=:_$N(B buffer $B$r(B message $B$H$7$F9=J82r@O$7!"$=$N7k2L$N(B mime-entity $B$rJV$9!#(B -@end defun - - -@defun mime-parse-buffer &optional buffer +@defun mime-parse-buffer &optional buffer type @var{buffer} $B$r(B message $B$H$7$F9=J82r@O$7!"$=$N7k2L$N(B mime-entity $B$r(B @var{buffer} $B$N(B@code{mime-message-structure} $B$K3JG<$9$k!#(B@refill -@var{buffer} $B$,>JN,$5$l$?>l9g!"8=:_$N(B buffer $B$r9=J82r@O$9$k!#(B +@var{buffer} $B$,>JN,$5$l$?>l9g!"8=:_$N(B buffer $B$r9=J82r@O$9$k!#(B@refill + +@var{type} $B$,;XDj$5$l$?>l9g!"$=$NCM$r@8@.$5$l$k(B mime-entity $B$NI=>]7?$H$7(B +$B$FMQ$$$k!#>JN,$5$l$?>l9g$O(B @var{buffer} $B$H$J$k!#(B(cf. @ref{mm-backend}) @end defun diff --git a/mime-parse.el b/mime-parse.el index b198b96..fa20a85 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 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 --- 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 diff --git a/mmbuffer.el b/mmbuffer.el index e9d24b5..76b3fdc 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,23 @@ (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 @@ -57,7 +101,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 +110,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 +165,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 -- 1.7.10.4