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