X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime.el;h=908923fa48a0f7dc150e91edd849782ff2c7032a;hb=eb9783f46dee7de4c9372e428a26e384e04d60f8;hp=9672dd8c20a3d08616f1996b7ea5687b9dd753f7;hpb=77efec113892b1ac1f059d0c7f5774d69f9eebb3;p=elisp%2Fflim.git diff --git a/mime.el b/mime.el index 9672dd8..908923f 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,54 +60,59 @@ 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 (mime-entity-representation-type-internal entity))) -(defsubst mime-entity-send (entity service &rest args) +(defsubst mime-entity-send (entity message &rest args) + "Send MESSAGE to ENTITY with ARGS, and return the result." (apply (mime-find-function - service (mime-entity-representation-type-internal entity)) + message (mime-entity-representation-type-internal entity)) entity args)) +(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 +141,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 +159,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) @@ -215,14 +214,15 @@ ENTITY is used." entity disposition) disposition)))))) -(defun mime-entity-encoding (entity) +(defun mime-entity-encoding (entity &optional default-encoding) (or (mime-entity-encoding-internal entity) - (let ((ret (mime-fetch-field 'Content-Transfer-Encoding entity))) - (if ret - (let ((encoding (mime-parse-Content-Transfer-Encoding ret))) - (when encoding - (mime-entity-set-encoding-internal entity encoding) - encoding)))))) + (let ((encoding + (or (let ((ret (mime-fetch-field + 'Content-Transfer-Encoding entity))) + (and ret (mime-parse-Content-Transfer-Encoding ret))) + default-encoding "7bit"))) + (mime-entity-set-encoding-internal entity encoding) + encoding))) (defun mime-read-field (field-name &optional entity) (or (symbolp field-name) @@ -262,37 +262,16 @@ ENTITY is used." (setq field (eword-decode-structured-field-body field-body))) (t - (setq field (eword-decode-unstructured-field-body - field-body)) + (setq field (ew-decode-field (symbol-name field-name) + field-body)) )) (mime-entity-set-parsed-header-internal 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 @@ -335,20 +314,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