(require 'mmimap)
(require 'mime-view)
+(eval-when-compile
+ (require 'luna)
+ (require 'elmo) ; elmo-folder-do-each-message-entity
+ (require 'cl))
+
;; MIME-Entity
(eval-and-compile
(luna-define-class elmo-mime-entity))
`mime' (Can display each MIME part)
`as-is' (Can display raw message)")
+(luna-define-generic elmo-mime-entity-reassembled-p (entity)
+ "Return non-nil if ENTITY is reassembled message/partial pieces.")
+
(luna-define-generic elmo-mime-entity-display (entity preview-buffer
&optional
original-major-mode
&optional
original-major-mode
keymap)
- (mime-display-message entity
- preview-buffer
- nil
- keymap
- original-major-mode))
-
+ (let ((elmo-message-displaying t)
+ (default-mime-charset 'x-unknown))
+ (mime-display-message entity
+ preview-buffer
+ nil
+ keymap
+ original-major-mode)))
+
+(defun elmo-mime-entity-fragment-p (entity)
+ (and (not (elmo-mime-entity-reassembled-p entity))
+ (eq (mime-entity-media-type entity) 'message)
+ (eq (mime-entity-media-subtype entity) 'partial)))
(eval-and-compile
(luna-define-class mime-elmo-buffer-entity (mime-buffer-entity
- elmo-mime-entity))
+ elmo-mime-entity)
+ (reassembled))
+ (luna-define-internal-accessors 'mime-elmo-buffer-entity)
(luna-define-class mime-elmo-imap-entity (mime-imap-entity
elmo-mime-entity)))
(defvar elmo-message-sorted-field-list nil)
(defvar elmo-mime-display-header-analysis t)
-(defcustom elmo-mime-header-max-column fill-column
+(defcustom elmo-mime-header-max-column 'fill-column
"*Header max column number. Default is `fill-colmn'.
+If a symbol of variable is specified, use its value in message buffer.
If a symbol of function is specified, the function is called and its return
value is used."
:type '(choice (integer :tag "Column Number")
+ (variable :tag "Variable")
(function :tag "Function"))
:group 'elmo)
visible-fields
sort-fields)
(let ((the-buf (current-buffer))
- (mode-obj (mime-find-field-presentation-method 'wide))
- field-decoder
- f-b p f-e field-name field field-body
- vf-alist (sl sort-fields))
- (save-excursion
- (set-buffer buffer)
+ (max-column (cond ((functionp elmo-mime-header-max-column)
+ (funcall elmo-mime-header-max-column))
+ ((and (symbolp elmo-mime-header-max-column)
+ (boundp elmo-mime-header-max-column))
+ (symbol-value elmo-mime-header-max-column))
+ (t
+ elmo-mime-header-max-column)))
+ vf-alist)
+ (with-current-buffer buffer
(save-restriction
(narrow-to-region start end)
(goto-char start)
(while (re-search-forward std11-field-head-regexp nil t)
- (setq f-b (match-beginning 0)
- p (match-end 0)
- field-name (buffer-substring f-b p)
- f-e (std11-field-end))
- (when (mime-visible-field-p field-name
- visible-fields invisible-fields)
- (setq field (intern
- (capitalize (buffer-substring f-b (1- p))))
- field-body (buffer-substring p f-e)
- field-decoder
- (if elmo-mime-display-header-analysis
- (inline (mime-find-field-decoder-internal
- field mode-obj))
- (inline (lambda (x y z) x))))
- (setq vf-alist (append (list
- (cons field-name
- (list field-body field-decoder)))
- vf-alist))))
- (and vf-alist
- (setq vf-alist
- (sort vf-alist
- (function (lambda (s d)
- (let ((n 0) re
- (sf (car s))
- (df (car d)))
- (catch 'done
- (while (setq re (nth n sl))
- (setq n (1+ n))
- (and (string-match re sf)
- (throw 'done t))
- (and (string-match re df)
- (throw 'done nil)))
- t)))))))
- (with-current-buffer the-buf
- (while vf-alist
- (let* ((vf (car vf-alist))
- (field-name (car vf))
- (field-body (car (cdr vf)))
- (field-decoder (car (cdr (cdr vf)))))
- (insert field-name)
- (insert (if field-decoder
- (funcall field-decoder field-body
- (string-width field-name)
- (if (functionp elmo-mime-header-max-column)
- (funcall elmo-mime-header-max-column)
- elmo-mime-header-max-column))
- ;; Don't decode
- field-body))
- (insert "\n"))
- (setq vf-alist (cdr vf-alist)))
- (run-hooks 'mmelmo-header-inserted-hook))))))
+ (let* ((field-start (match-beginning 0))
+ (name-end (match-end 0))
+ (field-name (buffer-substring field-start name-end)))
+ (when (mime-visible-field-p field-name
+ visible-fields invisible-fields)
+ (let* ((field (intern
+ (capitalize
+ (buffer-substring field-start (1- name-end)))))
+ (field-body (buffer-substring name-end (std11-field-end)))
+ (field-decoder
+ (and elmo-mime-display-header-analysis
+ (inline (mime-find-field-decoder field 'wide)))))
+ (setq vf-alist (cons (list field-name field-body field-decoder)
+ vf-alist)))))))
+ (and vf-alist
+ (setq vf-alist
+ (sort vf-alist
+ (lambda (s d)
+ (let ((sf (car s))
+ (df (car d)))
+ (catch 'done
+ (dolist (re sort-fields)
+ (when (string-match re sf)
+ (throw 'done t))
+ (when (string-match re df)
+ (throw 'done nil)))
+ t)))))))
+ (set-buffer the-buf) ; verbose. remove me.
+ (save-excursion
+ (while vf-alist
+ (let* ((vf (car vf-alist))
+ (field-name (nth 0 vf))
+ (field-body (nth 1 vf))
+ (field-decoder (nth 2 vf)))
+ (insert field-name)
+ (insert (or (and field-decoder
+ (ignore-errors
+ (funcall field-decoder field-body
+ (string-width field-name)
+ max-column)))
+ ;; Don't decode
+ field-body))
+ (insert "\n"))
+ (setq vf-alist (cdr vf-alist)))
+ (run-hooks 'mmelmo-header-inserted-hook))))
(luna-define-generic elmo-mime-insert-sorted-header (entity
&optional invisible-fields
;; 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)
- (error "Don't support this method."))
+ (error "Does not support this method"))
-(defun elmo-message-mime-entity (folder number rawbuf
+(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)))
(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))
+
+
;; Replacement of mime-display-message.
(defun elmo-mime-display-as-is-internal (message
&optional preview-buffer
projects / elisp / wanderlust.git / blobdiff