Merge flim-1_13_2_1.

[elisp/flim.git] / mime-parse.el

diff --git a/mime-parse.el b/mime-parse.el
index 7d760c4..5442896 100644 (file)
--- a/mime-parse.el
+++ b/mime-parse.el
@@ -27,6 +27,10 @@
 (require 'mime-def)
 (require 'std11)
 
+(autoload 'mime-entity-body-buffer "mime")
+(autoload 'mime-entity-body-start-point "mime")
+(autoload 'mime-entity-body-end-point "mime")
+
 
 ;;; @ lexical analyzer
 ;;;
@@ -213,70 +217,74 @@ If is is not found, return DEFAULT-ENCODING."
 ;;;
 
 (defun mime-parse-multipart (entity)
-  (goto-char (point-min))
-  (let* ((representation-type
-         (mime-entity-representation-type-internal entity))
-        (content-type (mime-entity-content-type-internal entity))
-        (dash-boundary
-         (concat "--" (mime-content-type-parameter content-type "boundary")))
-        (delimiter       (concat "\n" (regexp-quote dash-boundary)))
-        (close-delimiter (concat delimiter "--[ \t]*$"))
-        (rsep (concat delimiter "[ \t]*\n"))
-        (dc-ctl
-         (if (eq (mime-content-type-subtype content-type) 'digest)
-             (make-mime-content-type 'message 'rfc822)
-           (make-mime-content-type 'text 'plain)
-           ))
-        (header-end (mime-entity-header-end-internal entity))
-        (body-end (mime-entity-body-end-internal entity)))
-    (save-restriction
-      (goto-char body-end)
-      (narrow-to-region header-end
-                       (if (re-search-backward close-delimiter nil t)
-                           (match-beginning 0)
-                         body-end))
-      (goto-char header-end)
-      (if (re-search-forward rsep nil t)
-         (let ((cb (match-end 0))
-               ce ncb ret children
-               (node-id (mime-entity-node-id-internal entity))
-               (i 0))
-           (while (re-search-forward rsep nil t)
-             (setq ce (match-beginning 0))
-             (setq ncb (match-end 0))
+  (with-current-buffer (mime-entity-body-buffer entity)
+    (let* ((representation-type
+           (mime-entity-representation-type-internal entity))
+          (content-type (mime-entity-content-type-internal entity))
+          (dash-boundary
+           (concat "--"
+                   (mime-content-type-parameter content-type "boundary")))
+          (delimiter       (concat "\n" (regexp-quote dash-boundary)))
+          (close-delimiter (concat delimiter "--[ \t]*$"))
+          (rsep (concat delimiter "[ \t]*\n"))
+          (dc-ctl
+           (if (eq (mime-content-type-subtype content-type) 'digest)
+               (make-mime-content-type 'message 'rfc822)
+             (make-mime-content-type 'text 'plain)
+             ))
+          (body-start (mime-entity-body-start-point entity))
+          (body-end (mime-entity-body-end-point entity)))
+      (save-restriction
+       (goto-char body-end)
+       (narrow-to-region body-start
+                         (if (re-search-backward close-delimiter nil t)
+                             (match-beginning 0)
+                           body-end))
+       (goto-char body-start)
+       (if (re-search-forward
+            (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
+            nil t)
+           (let ((cb (match-end 0))
+                 ce ncb ret children
+                 (node-id (mime-entity-node-id-internal entity))
+                 (i 0))
+             (while (re-search-forward rsep nil t)
+               (setq ce (match-beginning 0))
+               (setq ncb (match-end 0))
+               (save-restriction
+                 (narrow-to-region cb ce)
+                 (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 i (1+ i))
+               )
+             (setq ce (point-max))
              (save-restriction
                (narrow-to-region cb ce)
                (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 i (1+ i))
+             (mime-entity-set-children-internal entity (nreverse children))
              )
-           (setq ce (point-max))
-           (save-restriction
-             (narrow-to-region cb ce)
-             (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 'message 'x-broken))
-       nil)
-      )))
+         (mime-entity-set-content-type-internal
+          entity (make-mime-content-type 'message 'x-broken))
+         nil)
+       ))))
 
 (defun mime-parse-encapsulated (entity)
   (mime-entity-set-children-internal
    entity
-   (save-restriction
-     (narrow-to-region (mime-entity-body-start-internal entity)
-                      (mime-entity-body-end-internal entity))
-     (list (mime-parse-message
-           (mime-entity-representation-type-internal entity) nil
-           entity (cons 0 (mime-entity-node-id-internal entity))))
-     )))
+   (with-current-buffer (mime-entity-body-buffer entity)
+     (save-restriction
+       (narrow-to-region (mime-entity-body-start-point entity)
+                        (mime-entity-body-end-point entity))
+       (list (mime-parse-message
+             (mime-entity-representation-type-internal entity) nil
+             entity (cons 0 (mime-entity-node-id-internal entity))))
+       ))))
 
 (defun mime-parse-message (representation-type &optional default-ctl 
                                               parent node-id)
@@ -301,15 +309,16 @@ If is is not found, return DEFAULT-ENCODING."
                                 ))
                             default-ctl))
       )
-    (make-mime-entity-internal representation-type
-                              (current-buffer)
-                              content-type nil parent node-id
-                              nil nil nil nil
-                              nil nil nil nil
-                              nil nil
-                              (current-buffer)
-                              header-start header-end
-                              body-start body-end)
+    (luna-make-entity representation-type
+                     :location (current-buffer)
+                     :content-type content-type
+                     :parent parent
+                     :node-id node-id
+                     :buffer (current-buffer)
+                     :header-start header-start
+                     :header-end header-end
+                     :body-start body-start
+                     :body-end body-end)
     ))
 
 
@@ -323,7 +332,8 @@ If buffer is omitted, it parses current-buffer."
   (save-excursion
     (if buffer (set-buffer buffer))
     (setq mime-message-structure
-         (mime-parse-message (or representation-type 'buffer) nil))
+         (mime-parse-message (or representation-type
+                                 'mime-buffer-entity) nil))
     ))