update.
[elisp/flim.git] / mime.el
diff --git a/mime.el b/mime.el
index 681376d..7961592 100644 (file)
--- a/mime.el
+++ b/mime.el
@@ -83,6 +83,16 @@ current-buffer, and return it.")
                     (list (cons service func)))
          func)))))
 
+(defsubst mime-entity-function (entity service)
+  (mime-find-function service
+                     (mime-entity-representation-type-internal entity)))
+
+(defsubst mime-entity-send (entity service &rest args)
+  (apply (mime-find-function
+         service (mime-entity-representation-type-internal entity))
+        entity
+        args))
+
 (defun mime-open-entity (type location)
   "Open an entity and return it.
 TYPE is representation-type.
@@ -91,10 +101,6 @@ representation-type."
   (funcall (mime-find-function 'open-entity type) location)
   )
 
-(defsubst mime-entity-function (entity service)
-  (mime-find-function service
-                     (mime-entity-representation-type-internal 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))
@@ -152,33 +158,29 @@ ENTITY is used."
 
 (defun mime-entity-buffer (entity)
   (or (mime-entity-buffer-internal entity)
-      (funcall (mime-entity-function entity 'entity-buffer) entity)
-      ))
+      (mime-entity-send entity 'entity-buffer)))
 
 (defun mime-entity-point-min (entity)
-  (funcall (mime-entity-function entity 'entity-point-min) entity)
-  )
+  (mime-entity-send entity 'entity-point-min))
+
 (defun mime-entity-point-max (entity)
-  (funcall (mime-entity-function entity 'entity-point-max) entity)
-  )
+  (mime-entity-send entity 'entity-point-max))
 
 (defun mime-entity-header-start (entity)
   (or (mime-entity-header-start-internal entity)
-      (funcall (mime-entity-function entity 'entity-header-start) entity)
-      ))
-(defsubst mime-entity-header-end (entity)
+      (mime-entity-send entity 'entity-header-start)))
+
+(defun mime-entity-header-end (entity)
   (or (mime-entity-header-end-internal entity)
-      (funcall (mime-entity-function entity 'entity-header-end) entity)
-      ))
+      (mime-entity-send entity 'entity-header-end)))
 
-(defsubst mime-entity-body-start (entity)
+(defun mime-entity-body-start (entity)
   (or (mime-entity-body-start-internal entity)
-      (funcall (mime-entity-function entity 'entity-body-start) entity)
-      ))
-(defsubst mime-entity-body-end (entity)
+      (mime-entity-send entity 'entity-body-start)))
+
+(defun mime-entity-body-end (entity)
   (or (mime-entity-body-end-internal entity)
-      (funcall (mime-entity-function entity 'entity-body-end) entity)
-      ))
+      (mime-entity-send entity 'entity-body-end)))
 
 
 ;;; @ Entity Header
@@ -194,8 +196,8 @@ ENTITY is used."
     (or field-body
        (progn
          (if (setq field-body
-                   (funcall (mime-entity-function entity 'fetch-field)
-                            entity (symbol-name field-name)))
+                   (mime-entity-send entity 'fetch-field
+                                     (symbol-name field-name)))
              (mime-entity-set-original-header-internal
               entity (put-alist field-name field-body header))
            )
@@ -213,14 +215,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)
@@ -285,64 +288,12 @@ ENTITY is used."
          (setq invisible-fields (cdr invisible-fields))
          )
        t)))
-               
-(defun mime-insert-decoded-header (entity
-                                  &optional invisible-fields visible-fields
-                                  code-conversion)
+
+(defun mime-insert-decoded-header (entity &optional invisible-fields
+                                         visible-fields)
   "Insert before point a decoded header of ENTITY."
-  (let ((default-charset
-         (if code-conversion
-             (if (mime-charset-to-coding-system code-conversion)
-                 code-conversion
-               default-mime-charset))))
-    (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 default-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 default-charset))
-                          (insert (eword-decode-unstructured-field-body
-                                   body (1+ len)))
-                          )))
-                 (insert "\n")
-                 )))))))))
+  (mime-entity-send entity 'insert-decoded-header
+                   invisible-fields visible-fields))
 
 
 ;;; @ Entity Attributes
@@ -386,47 +337,19 @@ ENTITY is used."
 ;;;
 
 (defun mime-entity-content (entity)
-  (save-excursion
-    (set-buffer (mime-entity-buffer entity))
-    (mime-decode-string (buffer-substring (mime-entity-body-start entity)
-                                         (mime-entity-body-end entity))
-                       (mime-entity-encoding entity))))
+  (mime-entity-send entity 'entity-content))
 
 (defun mime-write-entity-content (entity filename)
   "Write content of ENTITY into FILENAME."
-  (save-excursion
-    (set-buffer (mime-entity-buffer entity))
-    (let ((encoding (or (mime-entity-encoding entity) "7bit")))
-      (if (and (mime-entity-cooked-p entity)
-              (member encoding '("7bit" "8bit" "binary")))
-         (write-region (mime-entity-body-start entity)
-                       (mime-entity-body-end entity) filename)
-       (mime-write-decoded-region (mime-entity-body-start entity)
-                                  (mime-entity-body-end entity)
-                                  filename encoding)
-       ))))
+  (mime-entity-send entity 'write-entity-content filename))
 
 (defun mime-write-entity (entity filename)
   "Write ENTITY into FILENAME."
-  (save-excursion
-    (set-buffer (mime-entity-buffer entity))
-    (if (mime-entity-cooked-p entity)
-       (write-region (mime-entity-point-min entity)
-                     (mime-entity-point-max entity) filename)
-      (write-region-as-binary (mime-entity-point-min entity)
-                             (mime-entity-point-max entity) filename)
-      )))
+  (mime-entity-send entity 'write-entity filename))
 
 (defun mime-write-entity-body (entity filename)
   "Write body of ENTITY into FILENAME."
-  (save-excursion
-    (set-buffer (mime-entity-buffer entity))
-    (if (mime-entity-cooked-p entity)
-       (write-region (mime-entity-body-start entity)
-                     (mime-entity-body-end entity) filename)
-      (write-region-as-binary (mime-entity-body-start entity)
-                             (mime-entity-body-end entity) filename)
-      )))
+  (mime-entity-send entity 'write-entity-body filename))
 
 
 ;;; @ end