1 ;;; elmo-mime.el --- MIME module for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
38 (require 'elmo) ; elmo-folder-do-each-message-entity
43 (luna-define-class elmo-mime-entity))
45 (luna-define-generic elmo-mime-entity-display-p (entity mime-mode)
46 "Return non-nil if ENTITY is able to display with MIME-MODE.
48 MIME-MODE is a symbol which is one of the following:
49 `mime' (Can display each MIME part)
50 `as-is' (Can display raw message)")
52 (luna-define-generic elmo-mime-entity-reassembled-p (entity)
53 "Return non-nil if ENTITY is reassembled message/partial pieces.")
55 (luna-define-generic elmo-mime-entity-display (entity preview-buffer
59 "Display MIME message ENTITY.
60 PREVIEW-BUFFER is a view buffer.
61 Optional argument ORIGINAL-MAJOR-MODE is major-mode of representation
62 buffer of ENTITY. If it is nil, current `major-mode' is used.
63 If optional argument KEYMAP is specified,
64 use for keymap of representation buffer.")
66 (luna-define-generic elmo-mime-entity-display-as-is (entity
71 "Display MIME message ENTITY as is.
72 PREVIEW-BUFFER is a view buffer.
73 Optional argument ORIGINAL-MAJOR-MODE is major-mode of representation
74 buffer of ENTITY. If it is nil, current `major-mode' is used.
75 If optional argument KEYMAP is specified,
76 use for keymap of representation buffer.")
78 (luna-define-method elmo-mime-entity-display ((entity elmo-mime-entity)
83 (let ((elmo-message-displaying t))
84 (mime-display-message entity
88 original-major-mode)))
90 (defun elmo-mime-entity-fragment-p (entity)
91 (and (not (elmo-mime-entity-reassembled-p entity))
92 (eq (mime-entity-media-type entity) 'message)
93 (eq (mime-entity-media-subtype entity) 'partial)))
96 (luna-define-class mime-elmo-buffer-entity (mime-buffer-entity
99 (luna-define-internal-accessors 'mime-elmo-buffer-entity)
100 (luna-define-class mime-elmo-imap-entity (mime-imap-entity
104 (provide 'mmelmo-imap)
105 (provide 'mmelmo-buffer)
107 (defvar elmo-message-ignored-field-list mime-view-ignored-field-list)
108 (defvar elmo-message-visible-field-list mime-view-visible-field-list)
109 (defvar elmo-message-sorted-field-list nil)
110 (defvar elmo-mime-display-header-analysis t)
112 (defcustom elmo-mime-header-max-column 'fill-column
113 "*Header max column number. Default is `fill-colmn'.
114 If a symbol of variable is specified, use its value in message buffer.
115 If a symbol of function is specified, the function is called and its return
117 :type '(choice (integer :tag "Column Number")
118 (variable :tag "Variable")
119 (function :tag "Function"))
122 (luna-define-method initialize-instance :after ((entity mime-elmo-buffer-entity)
126 (luna-define-method initialize-instance :around ((entity mime-elmo-imap-entity)
128 (luna-call-next-method))
130 ;;; Insert sorted header.
131 (defsubst elmo-mime-insert-header-from-buffer (buffer
133 &optional invisible-fields
136 (let ((the-buf (current-buffer))
137 (max-column (cond ((functionp elmo-mime-header-max-column)
138 (funcall elmo-mime-header-max-column))
139 ((and (symbolp elmo-mime-header-max-column)
140 (boundp elmo-mime-header-max-column))
141 (symbol-value elmo-mime-header-max-column))
143 elmo-mime-header-max-column)))
148 (narrow-to-region start end)
150 (while (re-search-forward std11-field-head-regexp nil t)
151 (let* ((field-start (match-beginning 0))
152 (name-end (match-end 0))
153 (field-name (buffer-substring field-start name-end)))
154 (when (mime-visible-field-p field-name
155 visible-fields invisible-fields)
156 (let* ((field (intern
158 (buffer-substring field-start (1- name-end)))))
159 (field-body (buffer-substring name-end (std11-field-end)))
161 (and elmo-mime-display-header-analysis
162 (inline (mime-find-field-decoder field 'wide)))))
163 (setq vf-alist (cons (list field-name field-body field-decoder)
172 (dolist (re sort-fields)
173 (when (string-match re sf)
175 (when (string-match re df)
180 (let* ((vf (car vf-alist))
181 (field-name (nth 0 vf))
182 (field-body (nth 1 vf))
183 (field-decoder (nth 2 vf)))
185 (insert (or (and field-decoder
187 (funcall field-decoder field-body
188 (string-width field-name)
193 (setq vf-alist (cdr vf-alist)))
194 (run-hooks 'mmelmo-header-inserted-hook))))
196 (luna-define-generic elmo-mime-insert-sorted-header (entity
197 &optional invisible-fields
200 "Insert sorted header fields of the ENTITY.")
202 (luna-define-method elmo-mime-insert-sorted-header ((entity
203 mime-elmo-buffer-entity)
204 &optional invisible-fields
207 (elmo-mime-insert-header-from-buffer
208 (mime-buffer-entity-buffer-internal entity)
209 (mime-buffer-entity-header-start-internal entity)
210 (mime-buffer-entity-header-end-internal entity)
211 invisible-fields visible-fields sorted-fields))
213 (luna-define-method elmo-mime-insert-sorted-header ((entity
214 mime-elmo-imap-entity)
215 &optional invisible-fields
218 (let ((the-buf (current-buffer))
221 (insert (mime-imap-entity-header-string entity))
222 (setq buf (current-buffer)
226 (elmo-mime-insert-header-from-buffer buf p-min p-max
231 (luna-define-method mime-insert-text-content :around
232 ((entity mime-elmo-buffer-entity))
233 (luna-call-next-method)
234 (run-hooks 'elmo-message-text-content-inserted-hook))
236 (luna-define-method mime-insert-text-content :around
237 ((entity mime-elmo-imap-entity))
238 (luna-call-next-method)
239 (run-hooks 'elmo-message-text-content-inserted-hook))
241 (defun elmo-mime-insert-header (entity situation)
242 (elmo-mime-insert-sorted-header
244 elmo-message-ignored-field-list
245 elmo-message-visible-field-list
246 elmo-message-sorted-field-list)
247 (run-hooks 'elmo-message-header-inserted-hook))
249 ;; mime-elmo-buffer-entity
250 (luna-define-method elmo-mime-entity-display-p
251 ((entity mime-elmo-buffer-entity) mime-mode)
255 (luna-define-method elmo-mime-entity-reassembled-p ((entity
256 mime-elmo-buffer-entity))
257 (mime-elmo-buffer-entity-reassembled-internal entity))
259 (luna-define-method elmo-mime-entity-display-as-is ((entity
260 mime-elmo-buffer-entity)
265 (elmo-mime-display-as-is-internal entity
269 original-major-mode))
271 ;; mime-elmo-imap-entity
272 (luna-define-method elmo-mime-entity-display-p
273 ((entity mime-elmo-imap-entity) mime-mode)
274 (not (eq mime-mode 'as-is)))
276 (luna-define-method elmo-mime-entity-display-as-is ((entity
277 mime-elmo-imap-entity)
282 (error "Does not support this method"))
285 (defun elmo-message-mime-entity (folder number rawbuf reassemble
287 ignore-cache unread entire)
288 "Return the mime-entity structure of the message in the FOLDER with NUMBER.
289 RAWBUF is the output buffer for original message.
290 If REASSEMBLE is non-nil and MIME media type of the message is message/partial,
291 the mime-entity is reassembled partial message.
292 If optional argument IGNORE-CACHE is non-nil, existing cache is ignored.
293 If second optional argument UNREAD is non-nil,
294 keep status of the message as unread.
295 If third optional argument ENTIRE is non-nil, fetch entire message at once."
296 (let (id message entity content-type)
298 (setq entity (elmo-message-entity folder number))
299 (setq id (if (setq content-type (elmo-message-entity-field
300 entity 'content-type))
301 (and (string-match "message/partial" content-type)
302 (mime-content-type-parameter
303 (mime-parse-Content-Type content-type) "id"))
304 (and (setq message (elmo-message-mime-entity-internal
306 ignore-cache unread entire))
307 (eq (mime-entity-media-type message) 'message)
308 (eq (mime-entity-media-subtype message) 'partial)
309 (mime-content-type-parameter
310 (mime-entity-content-type message) "id"))))
311 (elmo-message-reassembled-mime-entity
313 (elmo-message-entity-field entity 'subject)
317 (elmo-message-mime-entity-internal
318 folder number rawbuf ignore-cache unread entire))))
321 (defun elmo-message-mime-entity-internal (folder number rawbuf
323 ignore-cache unread entire)
324 (let ((strategy (elmo-find-fetch-strategy folder number
327 (cond ((null strategy) nil)
328 ((eq (elmo-fetch-strategy-entireness strategy) 'section)
331 (luna-make-entity 'mime-elmo-imap-location
335 :strategy strategy)))
337 (with-current-buffer rawbuf
338 (let (buffer-read-only)
340 (elmo-message-fetch folder number strategy unread)))
341 (mime-open-entity 'elmo-buffer rawbuf)))))
344 (defconst elmo-mime-inherit-field-list-from-enclosed
345 '("^Content-.*:" "^Message-Id:" "^Subject:"
346 "^Encrypted.*:" "^MIME-Version:"))
348 (defsubst elmo-mime-make-reassembled-mime-entity (buffer)
349 (let ((entity (mime-open-entity 'elmo-buffer buffer)))
350 (mime-elmo-buffer-entity-set-reassembled-internal entity t)
353 (defun elmo-message-reassembled-mime-entity (folder id rawbuf subject
357 (let ((cache (elmo-file-cache-get (concat "<" id ">")))
359 (if (and (not ignore-cache)
360 (eq (elmo-file-cache-status cache) 'entire))
362 (with-current-buffer rawbuf
363 (let (buffer-read-only)
365 (elmo-file-cache-load (elmo-file-cache-path cache) nil))
366 (elmo-mime-make-reassembled-mime-entity rawbuf))
367 ;; reassemble fragment of the entity
368 (when (setq pieces (elmo-mime-collect-message/partial-pieces
371 (if (string-match "[0-9\n]+" subject)
372 (substring subject 0 (match-beginning 0))
374 ignore-cache unread))
375 (with-current-buffer rawbuf
376 (let (buffer-read-only
377 (outer-header (car pieces))
378 (pieces (sort (cdr pieces) (lambda (l r) (< (car l) (car r)))))
382 (insert (cdr (car pieces)))
383 (setq pieces (cdr pieces)))
384 (let ((case-fold-search t))
386 (std11-narrow-to-header)
387 (goto-char (point-min))
388 (while (re-search-forward std11-field-head-regexp nil t)
389 (let ((field-start (match-beginning 0)))
390 (unless (mime-visible-field-p
391 (buffer-substring field-start (match-end 0))
392 elmo-mime-inherit-field-list-from-enclosed
394 (delete-region field-start (1+ (std11-field-end))))))))
395 (goto-char (point-min))
396 (insert outer-header)
398 (elmo-file-cache-save (elmo-file-cache-path cache) nil)
399 (elmo-mime-make-reassembled-mime-entity rawbuf)))))))
401 (defun elmo-mime-collect-message/partial-pieces (folder id subject-regexp
407 (set-buffer-multibyte nil)
408 (let (total header pieces)
409 (elmo-folder-do-each-message-entity (entity folder)
412 (elmo-message-entity-field entity 'subject))
414 (let* ((message (elmo-message-mime-entity-internal
416 (elmo-message-entity-number entity)
420 (ct (mime-entity-content-type message))
421 (the-id (or (mime-content-type-parameter ct "id") ""))
423 (when (string= (downcase the-id)
425 (setq number (string-to-number
426 (mime-content-type-parameter ct "number")))
427 (setq pieces (cons (cons number (mime-entity-body message))
430 (let ((case-fold-search t))
432 (std11-narrow-to-header)
433 (goto-char (point-min))
434 (while (re-search-forward std11-field-head-regexp nil t)
435 (let ((field-start (match-beginning 0)))
436 (when (mime-visible-field-p
437 (buffer-substring field-start (match-end 0))
439 elmo-mime-inherit-field-list-from-enclosed)
443 field-start (std11-field-end))
446 (setq total (ignore-errors
448 (mime-content-type-parameter ct "total")))))
451 (>= (length pieces) total))
452 (throw 'complete (cons header pieces)))))))))
457 ;; Replacement of mime-display-message.
458 (defun elmo-mime-display-as-is-internal (message
459 &optional preview-buffer
460 mother default-keymap-or-function
461 original-major-mode keymap)
462 (mime-maybe-hide-echo-buffer)
463 (let ((win-conf (current-window-configuration)))
466 (concat "*Preview-" (mime-entity-name message) "*")))
467 (or original-major-mode
468 (setq original-major-mode major-mode))
469 (let ((inhibit-read-only t))
470 (set-buffer (get-buffer-create preview-buffer))
474 (setq mime-mother-buffer mother))
475 (setq mime-preview-original-window-configuration win-conf)
476 (setq major-mode 'mime-view-mode)
477 (setq mode-name "MIME-View")
480 (set-buffer-multibyte nil)
481 (insert (mime-entity-body message))
482 (set-buffer-multibyte t)
483 (decode-coding-region (point-min) (point-max)
484 elmo-mime-display-as-is-coding-system)
485 (goto-char (point-min))
487 (goto-char (point-min))
489 (let ((method (cdr (assq original-major-mode
490 mime-header-presentation-method-alist))))
491 (if (functionp method)
492 (funcall method message nil)))
494 ;; set original major mode for mime-preview-quit
495 (put-text-property (point-min) (point-max)
497 `((major-mode . ,original-major-mode)))
498 (put-text-property (point-min) (point-max)
499 'elmo-as-is-entity message)
502 (if default-keymap-or-function
503 (mime-view-define-keymap default-keymap-or-function)
504 mime-view-mode-default-map)))
505 (goto-char (point-min))
506 (search-forward "\n\n" nil t)
507 (run-hooks 'mime-view-mode-hook)
508 (set-buffer-modified-p nil)
509 (setq buffer-read-only t)
513 (product-provide (provide 'elmo-mime) (require 'elmo-version))
515 ;; elmo-mime.el ends here