-(defun elmo-make-mime-message-location (folder number strategy rawbuf unread)
-;; Return the MIME message location structure.
-;; FOLDER is the ELMO folder structure.
-;; NUMBER is the number of the message in the FOLDER.
-;; STRATEGY is the message fetching strategy.
-;; RAWBUF is the output buffer for original message.
-;; If second optional argument UNREAD is non-nil, message is not marked
-;; as read.
- (if (and strategy
- (eq (elmo-fetch-strategy-entireness strategy) 'section))
- (luna-make-entity
- 'mime-elmo-imap-location
- :folder folder
- :number number
- :rawbuf rawbuf
- :strategy strategy)
- (with-current-buffer rawbuf
- (let (buffer-read-only)
- (erase-buffer)
- (if strategy
- (elmo-message-fetch folder number strategy
- nil (current-buffer)
- unread))))
- rawbuf))
-
-(defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
- &optional ignore-cache unread keymap)
- "Display MIME message.
-A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
-VIEWBUF is a view buffer and RAWBUF is a raw buffer.
-ORIGINAL is the major mode of RAWBUF.
-If optional argument IGNORE-CACHE is specified, existing cache is ignored.
-If second optional argument UNREAD is specified, message is displayed but
-keep it as unread.
-Return non-nil if not entire message was fetched."
- (let (mime-display-header-hook ; Do nothing.
- (elmo-message-displaying t)
- entity strategy)
- (unless (zerop (elmo-folder-length folder))
- (setq entity (elmo-message-entity folder number)))
- (setq strategy (if entity (elmo-find-fetch-strategy folder entity
- ignore-cache)
- (elmo-make-fetch-strategy 'entire)))
- (mime-display-message
- (mime-open-entity
- (if (and strategy
- (eq (elmo-fetch-strategy-entireness strategy) 'section))
- 'elmo-imap
- 'elmo-buffer)
- (elmo-make-mime-message-location
- folder number strategy rawbuf unread))
- viewbuf nil keymap
- original-mode)
- (if strategy
- (or (elmo-fetch-strategy-use-cache strategy)
- (eq (elmo-fetch-strategy-entireness strategy)
- 'section)))))
-
-(defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode
- &optional ignore-cache unread keymap)
- "Display MIME message.
-A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
-VIEWBUF is a view buffer and RAWBUF is a raw buffer.
-ORIGINAL is the major mode of RAWBUF.
-If optional argument IGNORE-CACHE is specified, existing cache is ignored.
-If second optional argument UNREAD is specified, message is displayed but
-keep it as unread.
-Return non-nil if cache is used."
- (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder) number))
- mime-display-header-hook ; Do nothing.
- cache-file strategy use-cache)
- (when entity
- (setq cache-file (elmo-file-cache-get
- (elmo-message-entity-field entity 'message-id)))
- (setq use-cache (and (elmo-message-use-cache-p folder number)
- (eq (elmo-file-cache-status cache-file) 'entire))))
- (setq strategy (elmo-make-fetch-strategy
- 'entire use-cache
- (elmo-message-use-cache-p folder number)
- (elmo-file-cache-path cache-file)))
- (elmo-mime-display-as-is-internal
- (mime-open-entity
- 'elmo-buffer
- (elmo-make-mime-message-location
- folder number strategy rawbuf unread))
- viewbuf nil keymap original-mode)
- (when strategy
- (elmo-fetch-strategy-use-cache strategy))))
+;; mime-elmo-buffer-entity
+(luna-define-method elmo-mime-entity-display-p
+ ((entity mime-elmo-buffer-entity) mime-mode)
+ ;; always return t.
+ t)
+
+(luna-define-method elmo-mime-entity-reassembled-p ((entity
+ mime-elmo-buffer-entity))
+ (mime-elmo-buffer-entity-reassembled-internal entity))
+
+(luna-define-method elmo-mime-entity-display-as-is ((entity
+ mime-elmo-buffer-entity)
+ preview-buffer
+ &optional
+ original-major-mode
+ keymap)
+ (elmo-mime-display-as-is-internal entity
+ preview-buffer
+ nil
+ keymap
+ original-major-mode))
+
+;; mime-elmo-imap-entity
+(luna-define-method elmo-mime-entity-display-p
+ ((entity mime-elmo-imap-entity) mime-mode)
+ (not (eq mime-mode 'as-is)))
+
+(luna-define-method elmo-mime-entity-display-as-is ((entity
+ mime-elmo-imap-entity)
+ preview-buffer
+ &optional
+ original-major-mode
+ keymap)
+ (error "Does not support this method"))
+
+
+(defun elmo-message-mime-entity (folder number rawbuf reassemble
+ &optional
+ ignore-cache unread entire)
+ "Return the mime-entity structure of the message in the FOLDER with NUMBER.
+RAWBUF is the output buffer for original message.
+If REASSEMBLE is non-nil and MIME media type of the message is message/partial,
+the mime-entity is reassembled partial message.
+If optional argument IGNORE-CACHE is non-nil, existing cache is ignored.
+If second optional argument UNREAD is non-nil,
+keep status of the message as unread.
+If third optional argument ENTIRE is non-nil, fetch entire message at once."
+ (let (id message entity content-type)
+ (or (and reassemble
+ (setq entity (elmo-message-entity folder number))
+ (setq id (if (setq content-type (elmo-message-entity-field
+ entity 'content-type))
+ (and (string-match "message/partial" content-type)
+ (mime-content-type-parameter
+ (mime-parse-Content-Type content-type) "id"))
+ (and (setq message (elmo-message-mime-entity-internal
+ folder number rawbuf
+ ignore-cache unread entire))
+ (eq (mime-entity-media-type message) 'message)
+ (eq (mime-entity-media-subtype message) 'partial)
+ (mime-content-type-parameter
+ (mime-entity-content-type message) "id"))))
+ (elmo-message-reassembled-mime-entity
+ folder id rawbuf
+ (elmo-message-entity-field entity 'subject)
+ ignore-cache
+ unread))
+ message
+ (elmo-message-mime-entity-internal
+ folder number rawbuf ignore-cache unread entire))))
+
+
+(defun elmo-message-mime-entity-internal (folder number rawbuf
+ &optional
+ ignore-cache unread entire)
+ (let ((strategy (elmo-find-fetch-strategy folder number
+ ignore-cache
+ entire)))
+ (cond ((null strategy) nil)
+ ((eq (elmo-fetch-strategy-entireness strategy) 'section)
+ (mime-open-entity
+ 'elmo-imap
+ (luna-make-entity 'mime-elmo-imap-location
+ :folder folder
+ :number number
+ :rawbuf rawbuf
+ :strategy strategy)))
+ (t
+ (with-current-buffer rawbuf
+ (let (buffer-read-only)
+ (erase-buffer)
+ (elmo-message-fetch folder number strategy unread)))
+ (mime-open-entity 'elmo-buffer rawbuf)))))
+
+
+(defconst elmo-mime-inherit-field-list-from-enclosed
+ '("^Content-.*:" "^Message-Id:" "^Subject:"
+ "^Encrypted.*:" "^MIME-Version:"))
+
+(defsubst elmo-mime-make-reassembled-mime-entity (buffer)
+ (let ((entity (mime-open-entity 'elmo-buffer buffer)))
+ (mime-elmo-buffer-entity-set-reassembled-internal entity t)
+ entity))
+
+(defun elmo-message-reassembled-mime-entity (folder id rawbuf subject
+ &optional
+ ignore-cache
+ unread)
+ (let ((cache (elmo-file-cache-get (concat "<" id ">")))
+ pieces)
+ (if (and (not ignore-cache)
+ (eq (elmo-file-cache-status cache) 'entire))
+ ;; use cache
+ (with-current-buffer rawbuf
+ (let (buffer-read-only)
+ (erase-buffer)
+ (elmo-file-cache-load (elmo-file-cache-path cache) nil))
+ (elmo-mime-make-reassembled-mime-entity rawbuf))
+ ;; reassemble fragment of the entity
+ (when (setq pieces (elmo-mime-collect-message/partial-pieces
+ folder id
+ (regexp-quote
+ (if (string-match "[0-9\n]+" subject)
+ (substring subject 0 (match-beginning 0))
+ subject))
+ ignore-cache unread))
+ (with-current-buffer rawbuf
+ (let (buffer-read-only
+ (outer-header (car pieces))
+ (pieces (sort (cdr pieces) (lambda (l r) (< (car l) (car r)))))
+ contents entity)
+ (erase-buffer)
+ (while pieces
+ (insert (cdr (car pieces)))
+ (setq pieces (cdr pieces)))
+ (let ((case-fold-search t))
+ (save-restriction
+ (std11-narrow-to-header)
+ (goto-char (point-min))
+ (while (re-search-forward std11-field-head-regexp nil t)
+ (let ((field-start (match-beginning 0)))
+ (unless (mime-visible-field-p
+ (buffer-substring field-start (match-end 0))
+ elmo-mime-inherit-field-list-from-enclosed
+ '(".*"))
+ (delete-region field-start (1+ (std11-field-end))))))))
+ (goto-char (point-min))
+ (insert outer-header)
+ ;; save cache
+ (elmo-file-cache-save (elmo-file-cache-path cache) nil)
+ (elmo-mime-make-reassembled-mime-entity rawbuf)))))))
+
+(defun elmo-mime-collect-message/partial-pieces (folder id subject-regexp
+ &optional
+ ignore-cache
+ unread)
+ (catch 'complete
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let (total header pieces)
+ (elmo-folder-do-each-message-entity (entity folder)
+ (when (string-match
+ subject-regexp
+ (elmo-message-entity-field entity 'subject))
+ (erase-buffer)
+ (let* ((message (elmo-message-mime-entity-internal
+ folder
+ (elmo-message-entity-number entity)
+ (current-buffer)
+ ignore-cache
+ unread))
+ (ct (mime-entity-content-type message))
+ (the-id (or (mime-content-type-parameter ct "id") ""))
+ number)
+ (when (string= (downcase the-id)
+ (downcase id))
+ (setq number (string-to-number
+ (mime-content-type-parameter ct "number")))
+ (setq pieces (cons (cons number (mime-entity-body message))
+ pieces))
+ (when (= number 1)
+ (let ((case-fold-search t))
+ (save-restriction
+ (std11-narrow-to-header)
+ (goto-char (point-min))
+ (while (re-search-forward std11-field-head-regexp nil t)
+ (let ((field-start (match-beginning 0)))
+ (when (mime-visible-field-p
+ (buffer-substring field-start (match-end 0))
+ nil
+ elmo-mime-inherit-field-list-from-enclosed)
+ (setq header (concat
+ header
+ (buffer-substring
+ field-start (std11-field-end))
+ "\n"))))))))
+ (unless total
+ (setq total (ignore-errors
+ (string-to-number
+ (mime-content-type-parameter ct "total")))))
+ (when (and total
+ (> total 0)
+ (>= (length pieces) total))
+ (throw 'complete (cons header pieces)))))))))
+ ;; return value
+ nil))
+