(initialize-instance): Don't initialize slots if they are initialized.
authormorioka <morioka>
Wed, 26 May 1999 01:08:12 +0000 (01:08 +0000)
committermorioka <morioka>
Wed, 26 May 1999 01:08:12 +0000 (01:08 +0000)
(mime-parse-multipart): Run in body-buffer of an entity.
(mime-entity-body-start-point): New method.

mmbuffer.el

index 5a203f0..bc703a5 100644 (file)
 
 (luna-define-method initialize-instance :after ((entity mime-buffer-entity)
                                                &rest init-args)
-  (mime-buffer-entity-set-buffer-internal
-   entity (mime-entity-location-internal entity))
+  (or (mime-buffer-entity-buffer-internal entity)
+      (mime-buffer-entity-set-buffer-internal
+       entity (mime-entity-location-internal entity)))
   (save-excursion
     (set-buffer (mime-buffer-entity-buffer-internal entity))
-    (setq mime-message-structure entity)
-    (let ((header-start (point-min))
-         header-end
-         body-start
-         (body-end (point-max)))
+    (if (mime-root-entity-p entity)
+       (setq mime-message-structure entity))
+    (let ((header-start
+          (or (mime-buffer-entity-header-start-internal entity)
+              (mime-buffer-entity-set-header-start-internal
+               entity (point-min))))
+         (header-end (mime-buffer-entity-header-end-internal entity))
+         (body-start (mime-buffer-entity-body-start-internal entity))
+         (body-end
+          (or (mime-buffer-entity-body-end-internal entity)
+              (mime-buffer-entity-set-body-end-internal entity (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)
-            )))
+      (unless (and header-end body-start)
+       (if (re-search-forward "^$" body-end 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)))
+       (mime-buffer-entity-set-header-end-internal entity header-end)
+       (mime-buffer-entity-set-body-start-internal entity body-start)
        )
-      (mime-buffer-entity-set-header-start-internal entity header-start)
-      (mime-buffer-entity-set-header-end-internal entity header-end)
-      (mime-buffer-entity-set-body-start-internal entity body-start)
-      (mime-buffer-entity-set-body-end-internal entity body-end)
+      (or (mime-entity-content-type-internal entity)
+         (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)
+                )))
+           ))
       ))
   entity)
 
 ;;;
 
 (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)
-           ))
-        (body-start (mime-buffer-entity-body-start-internal entity))
-        (body-end (mime-buffer-entity-body-end-internal 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))
+  (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))
-             )
-           (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)))
+             (mime-entity-set-children-internal entity (nreverse children))
              )
-           (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
     ))
 
 
-(luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
-  (set-buffer (mime-buffer-entity-buffer-internal entity))
-  (goto-char (mime-buffer-entity-header-start-internal entity))
-  )
-
 (defun mime-visible-field-p (field-name visible-fields invisible-fields)
   (or (catch 'found
        (while visible-fields
   (mime-buffer-entity-buffer-internal entity)
   )
 
+(luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
+  (mime-buffer-entity-body-start-internal entity)
+  )
+
 (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
   (mime-buffer-entity-body-end-internal entity)
   )