From cccf440687715992f581a5976a8c641861f03e62 Mon Sep 17 00:00:00 2001 From: morioka Date: Wed, 26 May 1999 01:08:12 +0000 Subject: [PATCH] (initialize-instance): Don't initialize slots if they are initialized. (mime-parse-multipart): Run in body-buffer of an entity. (mime-entity-body-start-point): New method. --- mmbuffer.el | 166 +++++++++++++++++++++++++++++++---------------------------- 1 file changed, 87 insertions(+), 79 deletions(-) diff --git a/mmbuffer.el b/mmbuffer.el index 5a203f0..bc703a5 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -41,36 +41,44 @@ (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) @@ -83,61 +91,62 @@ ;;; (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 @@ -200,11 +209,6 @@ )) -(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 @@ -359,6 +363,10 @@ (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) ) -- 1.7.10.4