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 (default-mime-charset 'x-unknown
))
85 (mime-display-message entity
89 original-major-mode
)))
91 (defun elmo-mime-entity-fragment-p (entity)
92 (and (not (elmo-mime-entity-reassembled-p entity
))
93 (eq (mime-entity-media-type entity
) 'message
)
94 (eq (mime-entity-media-subtype entity
) 'partial
)))
97 (luna-define-class mime-elmo-buffer-entity
(mime-buffer-entity
100 (luna-define-internal-accessors 'mime-elmo-buffer-entity
)
101 (luna-define-class mime-elmo-imap-entity
(mime-imap-entity
105 (provide 'mmelmo-imap
)
106 (provide 'mmelmo-buffer
)
108 (defvar elmo-message-ignored-field-list mime-view-ignored-field-list
)
109 (defvar elmo-message-visible-field-list mime-view-visible-field-list
)
110 (defvar elmo-message-sorted-field-list nil
)
111 (defvar elmo-mime-display-header-analysis t
)
113 (defcustom elmo-mime-header-max-column
'fill-column
114 "*Header max column number. Default is `fill-colmn'.
115 If a symbol of variable is specified, use its value in message buffer.
116 If a symbol of function is specified, the function is called and its return
118 :type
'(choice (integer :tag
"Column Number")
119 (variable :tag
"Variable")
120 (function :tag
"Function"))
123 (luna-define-method initialize-instance
:after
((entity mime-elmo-buffer-entity
)
127 (luna-define-method initialize-instance
:around
((entity mime-elmo-imap-entity
)
129 (luna-call-next-method))
131 ;;; Insert sorted header.
132 (defsubst elmo-mime-insert-header-from-buffer
(buffer
134 &optional invisible-fields
137 (let ((the-buf (current-buffer))
138 (max-column (cond ((functionp elmo-mime-header-max-column
)
139 (funcall elmo-mime-header-max-column
))
140 ((and (symbolp elmo-mime-header-max-column
)
141 (boundp elmo-mime-header-max-column
))
142 (symbol-value elmo-mime-header-max-column
))
144 elmo-mime-header-max-column
)))
149 (narrow-to-region start end
)
151 (while (re-search-forward std11-field-head-regexp nil t
)
152 (let* ((field-start (match-beginning 0))
153 (name-end (match-end 0))
154 (field-name (buffer-substring field-start name-end
)))
155 (when (mime-visible-field-p field-name
156 visible-fields invisible-fields
)
157 (let* ((field (intern
159 (buffer-substring field-start
(1- name-end
)))))
160 (field-body (buffer-substring name-end
(std11-field-end)))
162 (and elmo-mime-display-header-analysis
163 (inline (mime-find-field-decoder field
'wide
)))))
164 (setq vf-alist
(cons (list field-name field-body field-decoder
)
173 (dolist (re sort-fields
)
174 (when (string-match re sf
)
176 (when (string-match re df
)
181 (let* ((vf (car vf-alist
))
182 (field-name (nth 0 vf
))
183 (field-body (nth 1 vf
))
184 (field-decoder (nth 2 vf
)))
186 (insert (or (and field-decoder
188 (funcall field-decoder field-body
189 (string-width field-name
)
194 (setq vf-alist
(cdr vf-alist
)))
195 (run-hooks 'mmelmo-header-inserted-hook
))))
197 (luna-define-generic elmo-mime-insert-sorted-header
(entity
198 &optional invisible-fields
201 "Insert sorted header fields of the ENTITY.")
203 (luna-define-method elmo-mime-insert-sorted-header
((entity
204 mime-elmo-buffer-entity
)
205 &optional invisible-fields
208 (elmo-mime-insert-header-from-buffer
209 (mime-buffer-entity-buffer-internal entity
)
210 (mime-buffer-entity-header-start-internal entity
)
211 (mime-buffer-entity-header-end-internal entity
)
212 invisible-fields visible-fields sorted-fields
))
214 (luna-define-method elmo-mime-insert-sorted-header
((entity
215 mime-elmo-imap-entity
)
216 &optional invisible-fields
219 (let ((the-buf (current-buffer))
222 (insert (mime-imap-entity-header-string entity
))
223 (setq buf
(current-buffer)
227 (elmo-mime-insert-header-from-buffer buf p-min p-max
232 (luna-define-method mime-insert-text-content
:around
233 ((entity mime-elmo-buffer-entity
))
234 (luna-call-next-method)
235 (run-hooks 'elmo-message-text-content-inserted-hook
))
237 (luna-define-method mime-insert-text-content
:around
238 ((entity mime-elmo-imap-entity
))
239 (luna-call-next-method)
240 (run-hooks 'elmo-message-text-content-inserted-hook
))
242 (defun elmo-mime-insert-header (entity situation
)
243 (elmo-mime-insert-sorted-header
245 elmo-message-ignored-field-list
246 elmo-message-visible-field-list
247 elmo-message-sorted-field-list
)
248 (run-hooks 'elmo-message-header-inserted-hook
))
250 ;; mime-elmo-buffer-entity
251 (luna-define-method elmo-mime-entity-display-p
252 ((entity mime-elmo-buffer-entity
) mime-mode
)
256 (luna-define-method elmo-mime-entity-reassembled-p
((entity
257 mime-elmo-buffer-entity
))
258 (mime-elmo-buffer-entity-reassembled-internal entity
))
260 (luna-define-method elmo-mime-entity-display-as-is
((entity
261 mime-elmo-buffer-entity
)
266 (elmo-mime-display-as-is-internal entity
270 original-major-mode
))
272 ;; mime-elmo-imap-entity
273 (luna-define-method elmo-mime-entity-display-p
274 ((entity mime-elmo-imap-entity
) mime-mode
)
275 (not (eq mime-mode
'as-is
)))
277 (luna-define-method elmo-mime-entity-display-as-is
((entity
278 mime-elmo-imap-entity
)
283 (error "Does not support this method"))
286 (defun elmo-message-mime-entity (folder number rawbuf reassemble
288 ignore-cache unread entire
)
289 "Return the mime-entity structure of the message in the FOLDER with NUMBER.
290 RAWBUF is the output buffer for original message.
291 If REASSEMBLE is non-nil and MIME media type of the message is message/partial,
292 the mime-entity is reassembled partial message.
293 If optional argument IGNORE-CACHE is non-nil, existing cache is ignored.
294 If second optional argument UNREAD is non-nil,
295 keep status of the message as unread.
296 If third optional argument ENTIRE is non-nil, fetch entire message at once."
297 (let (id message entity content-type
)
299 (setq entity
(elmo-message-entity folder number
))
300 (setq id
(if (setq content-type
(elmo-message-entity-field
301 entity
'content-type
))
302 (and (string-match "message/partial" content-type
)
303 (mime-content-type-parameter
304 (mime-parse-Content-Type content-type
) "id"))
305 (and (setq message
(elmo-message-mime-entity-internal
307 ignore-cache unread entire
))
308 (eq (mime-entity-media-type message
) 'message
)
309 (eq (mime-entity-media-subtype message
) 'partial
)
310 (mime-content-type-parameter
311 (mime-entity-content-type message
) "id"))))
312 (elmo-message-reassembled-mime-entity
314 (elmo-message-entity-field entity
'subject
)
318 (elmo-message-mime-entity-internal
319 folder number rawbuf ignore-cache unread entire
))))
322 (defun elmo-message-mime-entity-internal (folder number rawbuf
324 ignore-cache unread entire
)
325 (let ((strategy (elmo-find-fetch-strategy folder number
328 (cond ((null strategy
) nil
)
329 ((eq (elmo-fetch-strategy-entireness strategy
) 'section
)
332 (luna-make-entity 'mime-elmo-imap-location
336 :strategy strategy
)))
338 (with-current-buffer rawbuf
339 (let (buffer-read-only)
341 (elmo-message-fetch folder number strategy unread
)))
342 (mime-open-entity 'elmo-buffer rawbuf
)))))
345 (defconst elmo-mime-inherit-field-list-from-enclosed
346 '("^Content-.*:" "^Message-Id:" "^Subject:"
347 "^Encrypted.*:" "^MIME-Version:"))
349 (defsubst elmo-mime-make-reassembled-mime-entity
(buffer)
350 (let ((entity (mime-open-entity 'elmo-buffer buffer
)))
351 (mime-elmo-buffer-entity-set-reassembled-internal entity t
)
354 (defun elmo-message-reassembled-mime-entity (folder id rawbuf subject
358 (let ((cache (elmo-file-cache-get (concat "<" id
">")))
360 (if (and (not ignore-cache
)
361 (eq (elmo-file-cache-status cache
) 'entire
))
363 (with-current-buffer rawbuf
364 (let (buffer-read-only)
366 (elmo-file-cache-load (elmo-file-cache-path cache
) nil
))
367 (elmo-mime-make-reassembled-mime-entity rawbuf
))
368 ;; reassemble fragment of the entity
369 (when (setq pieces
(elmo-mime-collect-message/partial-pieces
372 (if (string-match "[0-9\n]+" subject
)
373 (substring subject
0 (match-beginning 0))
375 ignore-cache unread
))
376 (with-current-buffer rawbuf
377 (let (buffer-read-only
378 (outer-header (car pieces
))
379 (pieces (sort (cdr pieces
) (lambda (l r
) (< (car l
) (car r
)))))
383 (insert (cdr (car pieces
)))
384 (setq pieces
(cdr pieces
)))
385 (let ((case-fold-search t
))
387 (std11-narrow-to-header)
388 (goto-char (point-min))
389 (while (re-search-forward std11-field-head-regexp nil t
)
390 (let ((field-start (match-beginning 0)))
391 (unless (mime-visible-field-p
392 (buffer-substring field-start
(match-end 0))
393 elmo-mime-inherit-field-list-from-enclosed
395 (delete-region field-start
(1+ (std11-field-end))))))))
396 (goto-char (point-min))
397 (insert outer-header
)
399 (elmo-file-cache-save (elmo-file-cache-path cache
) nil
)
400 (elmo-mime-make-reassembled-mime-entity rawbuf
)))))))
402 (defun elmo-mime-collect-message/partial-pieces
(folder id subject-regexp
408 (set-buffer-multibyte nil
)
409 (let (total header pieces
)
410 (elmo-folder-do-each-message-entity (entity folder
)
413 (elmo-message-entity-field entity
'subject
))
415 (let* ((message (elmo-message-mime-entity-internal
417 (elmo-message-entity-number entity
)
421 (ct (mime-entity-content-type message
))
422 (the-id (or (mime-content-type-parameter ct
"id") ""))
424 (when (string= (downcase the-id
)
426 (setq number
(string-to-number
427 (mime-content-type-parameter ct
"number")))
428 (setq pieces
(cons (cons number
(mime-entity-body message
))
431 (let ((case-fold-search t
))
433 (std11-narrow-to-header)
434 (goto-char (point-min))
435 (while (re-search-forward std11-field-head-regexp nil t
)
436 (let ((field-start (match-beginning 0)))
437 (when (mime-visible-field-p
438 (buffer-substring field-start
(match-end 0))
440 elmo-mime-inherit-field-list-from-enclosed
)
444 field-start
(std11-field-end))
447 (setq total
(ignore-errors
449 (mime-content-type-parameter ct
"total")))))
452 (>= (length pieces
) total
))
453 (throw 'complete
(cons header pieces
)))))))))
458 ;; Replacement of mime-display-message.
459 (defun elmo-mime-display-as-is-internal (message
460 &optional preview-buffer
461 mother default-keymap-or-function
462 original-major-mode keymap
)
463 (mime-maybe-hide-echo-buffer)
464 (let ((win-conf (current-window-configuration)))
467 (concat "*Preview-" (mime-entity-name message
) "*")))
468 (or original-major-mode
469 (setq original-major-mode major-mode
))
470 (let ((inhibit-read-only t
))
471 (set-buffer (get-buffer-create preview-buffer
))
475 (setq mime-mother-buffer mother
))
476 (setq mime-preview-original-window-configuration win-conf
)
477 (setq major-mode
'mime-view-mode
)
478 (setq mode-name
"MIME-View")
481 (set-buffer-multibyte nil
)
482 (insert (mime-entity-body message
))
483 (set-buffer-multibyte t
)
484 (decode-coding-region (point-min) (point-max)
485 elmo-mime-display-as-is-coding-system
)
486 (goto-char (point-min))
488 (goto-char (point-min))
490 (let ((method (cdr (assq original-major-mode
491 mime-header-presentation-method-alist
))))
492 (if (functionp method
)
493 (funcall method message nil
)))
495 ;; set original major mode for mime-preview-quit
496 (put-text-property (point-min) (point-max)
498 `((major-mode .
,original-major-mode
)))
499 (put-text-property (point-min) (point-max)
500 'elmo-as-is-entity message
)
503 (if default-keymap-or-function
504 (mime-view-define-keymap default-keymap-or-function
)
505 mime-view-mode-default-map
)))
506 (goto-char (point-min))
507 (search-forward "\n\n" nil t
)
508 (run-hooks 'mime-view-mode-hook
)
509 (set-buffer-modified-p nil
)
510 (setq buffer-read-only t
)
514 (product-provide (provide 'elmo-mime
) (require 'elmo-version
))
516 ;; elmo-mime.el ends here