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 (default-mime-button-invisible wl-default-mime-button-invisible
))
86 (mime-display-message entity
90 original-major-mode
)))
92 (defun elmo-mime-entity-fragment-p (entity)
93 (and (not (elmo-mime-entity-reassembled-p entity
))
94 (eq (mime-entity-media-type entity
) 'message
)
95 (eq (mime-entity-media-subtype entity
) 'partial
)))
98 (luna-define-class mime-elmo-buffer-entity
(mime-buffer-entity
101 (luna-define-internal-accessors 'mime-elmo-buffer-entity
)
102 (luna-define-class mime-elmo-imap-entity
(mime-imap-entity
106 (provide 'mmelmo-imap
)
107 (provide 'mmelmo-buffer
)
109 (defvar elmo-message-ignored-field-list mime-view-ignored-field-list
)
110 (defvar elmo-message-visible-field-list mime-view-visible-field-list
)
111 (defvar elmo-message-sorted-field-list nil
)
112 (defvar elmo-mime-display-header-analysis t
)
114 (defcustom elmo-mime-header-max-column
'fill-column
115 "*Header max column number. Default is `fill-colmn'.
116 If a symbol of variable is specified, use its value in message buffer.
117 If a symbol of function is specified, the function is called and its return
119 :type
'(choice (integer :tag
"Column Number")
120 (variable :tag
"Variable")
121 (function :tag
"Function"))
124 (luna-define-method initialize-instance
:after
((entity mime-elmo-buffer-entity
)
128 (luna-define-method initialize-instance
:around
((entity mime-elmo-imap-entity
)
130 (luna-call-next-method))
132 ;;; Insert sorted header.
133 (defsubst elmo-mime-insert-header-from-buffer
(buffer
135 &optional invisible-fields
138 (let ((the-buf (current-buffer))
139 (max-column (cond ((functionp elmo-mime-header-max-column
)
140 (funcall elmo-mime-header-max-column
))
141 ((and (symbolp elmo-mime-header-max-column
)
142 (boundp elmo-mime-header-max-column
))
143 (symbol-value elmo-mime-header-max-column
))
145 elmo-mime-header-max-column
)))
150 (narrow-to-region start end
)
152 (while (re-search-forward std11-field-head-regexp nil t
)
153 (let* ((field-start (match-beginning 0))
154 (name-end (match-end 0))
155 (field-name (buffer-substring field-start name-end
)))
156 (when (mime-visible-field-p field-name
157 visible-fields invisible-fields
)
158 (let* ((field (intern
160 (buffer-substring field-start
(1- name-end
)))))
161 (field-body (buffer-substring name-end
(std11-field-end)))
163 (and elmo-mime-display-header-analysis
164 (inline (mime-find-field-decoder field
'wide
)))))
165 (setq vf-alist
(cons (list field-name field-body field-decoder
)
174 (dolist (re sort-fields
)
175 (when (string-match re sf
)
177 (when (string-match re df
)
182 (let* ((vf (car vf-alist
))
183 (field-name (nth 0 vf
))
184 (field-body (nth 1 vf
))
185 (field-decoder (nth 2 vf
)))
187 (insert (or (and field-decoder
189 (funcall field-decoder field-body
190 (string-width field-name
)
195 (setq vf-alist
(cdr vf-alist
)))
196 (run-hooks 'mmelmo-header-inserted-hook
))))
198 (luna-define-generic elmo-mime-insert-sorted-header
(entity
199 &optional invisible-fields
202 "Insert sorted header fields of the ENTITY.")
204 (luna-define-method elmo-mime-insert-sorted-header
((entity
205 mime-elmo-buffer-entity
)
206 &optional invisible-fields
209 (elmo-mime-insert-header-from-buffer
210 (mime-buffer-entity-buffer-internal entity
)
211 (mime-buffer-entity-header-start-internal entity
)
212 (mime-buffer-entity-header-end-internal entity
)
213 invisible-fields visible-fields sorted-fields
))
215 (luna-define-method elmo-mime-insert-sorted-header
((entity
216 mime-elmo-imap-entity
)
217 &optional invisible-fields
220 (let ((the-buf (current-buffer))
223 (insert (mime-imap-entity-header-string entity
))
224 (setq buf
(current-buffer)
228 (elmo-mime-insert-header-from-buffer buf p-min p-max
233 (luna-define-method mime-insert-text-content
:around
234 ((entity mime-elmo-buffer-entity
))
235 (luna-call-next-method)
236 (run-hooks 'elmo-message-text-content-inserted-hook
))
238 (luna-define-method mime-insert-text-content
:around
239 ((entity mime-elmo-imap-entity
))
240 (luna-call-next-method)
241 (run-hooks 'elmo-message-text-content-inserted-hook
))
243 (defun elmo-mime-insert-header (entity situation
)
244 (elmo-mime-insert-sorted-header
246 elmo-message-ignored-field-list
247 elmo-message-visible-field-list
248 elmo-message-sorted-field-list
)
249 (run-hooks 'elmo-message-header-inserted-hook
))
251 ;; mime-elmo-buffer-entity
252 (luna-define-method elmo-mime-entity-display-p
253 ((entity mime-elmo-buffer-entity
) mime-mode
)
257 (luna-define-method elmo-mime-entity-reassembled-p
((entity
258 mime-elmo-buffer-entity
))
259 (mime-elmo-buffer-entity-reassembled-internal entity
))
261 (luna-define-method elmo-mime-entity-display-as-is
((entity
262 mime-elmo-buffer-entity
)
267 (elmo-mime-display-as-is-internal entity
271 original-major-mode
))
273 ;; mime-elmo-imap-entity
274 (luna-define-method elmo-mime-entity-display-p
275 ((entity mime-elmo-imap-entity
) mime-mode
)
276 (not (eq mime-mode
'as-is
)))
278 (luna-define-method elmo-mime-entity-display-as-is
((entity
279 mime-elmo-imap-entity
)
284 (error "Does not support this method"))
287 (defun elmo-message-mime-entity (folder number rawbuf reassemble
289 ignore-cache unread entire
)
290 "Return the mime-entity structure of the message in the FOLDER with NUMBER.
291 RAWBUF is the output buffer for original message.
292 If REASSEMBLE is non-nil and MIME media type of the message is message/partial,
293 the mime-entity is reassembled partial message.
294 If optional argument IGNORE-CACHE is non-nil, existing cache is ignored.
295 If second optional argument UNREAD is non-nil,
296 keep status of the message as unread.
297 If third optional argument ENTIRE is non-nil, fetch entire message at once."
298 (let (id message entity content-type
)
300 (setq entity
(elmo-message-entity folder number
))
301 (setq id
(if (setq content-type
(elmo-message-entity-field
302 entity
'content-type
))
303 (and (string-match "message/partial" content-type
)
304 (mime-content-type-parameter
305 (mime-parse-Content-Type content-type
) "id"))
306 (and (setq message
(elmo-message-mime-entity-internal
308 ignore-cache unread entire
))
309 (eq (mime-entity-media-type message
) 'message
)
310 (eq (mime-entity-media-subtype message
) 'partial
)
311 (mime-content-type-parameter
312 (mime-entity-content-type message
) "id"))))
313 (elmo-message-reassembled-mime-entity
315 (elmo-message-entity-field entity
'subject
)
319 (elmo-message-mime-entity-internal
320 folder number rawbuf ignore-cache unread entire
))))
323 (defun elmo-message-mime-entity-internal (folder number rawbuf
325 ignore-cache unread entire
)
326 (let ((strategy (elmo-find-fetch-strategy folder number
329 (cond ((null strategy
) nil
)
330 ((eq (elmo-fetch-strategy-entireness strategy
) 'section
)
333 (luna-make-entity 'mime-elmo-imap-location
337 :strategy strategy
)))
339 (with-current-buffer rawbuf
340 (let (buffer-read-only)
342 (elmo-message-fetch folder number strategy unread
)))
343 (mime-open-entity 'elmo-buffer rawbuf
)))))
346 (defconst elmo-mime-inherit-field-list-from-enclosed
347 '("^Content-.*:" "^Message-Id:" "^Subject:"
348 "^Encrypted.*:" "^MIME-Version:"))
350 (defsubst elmo-mime-make-reassembled-mime-entity
(buffer)
351 (let ((entity (mime-open-entity 'elmo-buffer buffer
)))
352 (mime-elmo-buffer-entity-set-reassembled-internal entity t
)
355 (defun elmo-message-reassembled-mime-entity (folder id rawbuf subject
359 (let ((cache (elmo-file-cache-get (concat "<" id
">")))
361 (if (and (not ignore-cache
)
362 (eq (elmo-file-cache-status cache
) 'entire
))
364 (with-current-buffer rawbuf
365 (let (buffer-read-only)
367 (elmo-file-cache-load (elmo-file-cache-path cache
) nil
))
368 (elmo-mime-make-reassembled-mime-entity rawbuf
))
369 ;; reassemble fragment of the entity
370 (when (setq pieces
(elmo-mime-collect-message/partial-pieces
373 (if (string-match "[0-9\n]+" subject
)
374 (substring subject
0 (match-beginning 0))
376 ignore-cache unread
))
377 (with-current-buffer rawbuf
378 (let (buffer-read-only
379 (outer-header (car pieces
))
380 (pieces (sort (cdr pieces
) (lambda (l r
) (< (car l
) (car r
)))))
384 (insert (cdr (car pieces
)))
385 (setq pieces
(cdr pieces
)))
386 (let ((case-fold-search t
))
388 (std11-narrow-to-header)
389 (goto-char (point-min))
390 (while (re-search-forward std11-field-head-regexp nil t
)
391 (let ((field-start (match-beginning 0)))
392 (unless (mime-visible-field-p
393 (buffer-substring field-start
(match-end 0))
394 elmo-mime-inherit-field-list-from-enclosed
396 (delete-region field-start
(1+ (std11-field-end))))))))
397 (goto-char (point-min))
398 (insert outer-header
)
400 (elmo-file-cache-save (elmo-file-cache-path cache
) nil
)
401 (elmo-mime-make-reassembled-mime-entity rawbuf
)))))))
403 (defun elmo-mime-collect-message/partial-pieces
(folder id subject-regexp
409 (set-buffer-multibyte nil
)
410 (let (total header pieces
)
411 (elmo-folder-do-each-message-entity (entity folder
)
414 (elmo-message-entity-field entity
'subject
))
416 (let* ((message (elmo-message-mime-entity-internal
418 (elmo-message-entity-number entity
)
422 (ct (mime-entity-content-type message
))
423 (the-id (or (mime-content-type-parameter ct
"id") ""))
425 (when (string= (downcase the-id
)
427 (setq number
(string-to-number
428 (mime-content-type-parameter ct
"number")))
429 (setq pieces
(cons (cons number
(mime-entity-body message
))
432 (let ((case-fold-search t
))
434 (std11-narrow-to-header)
435 (goto-char (point-min))
436 (while (re-search-forward std11-field-head-regexp nil t
)
437 (let ((field-start (match-beginning 0)))
438 (when (mime-visible-field-p
439 (buffer-substring field-start
(match-end 0))
441 elmo-mime-inherit-field-list-from-enclosed
)
445 field-start
(std11-field-end))
448 (setq total
(ignore-errors
450 (mime-content-type-parameter ct
"total")))))
453 (>= (length pieces
) total
))
454 (throw 'complete
(cons header pieces
)))))))))
459 ;; Replacement of mime-display-message.
460 (defun elmo-mime-display-as-is-internal (message
461 &optional preview-buffer
462 mother default-keymap-or-function
463 original-major-mode keymap
)
464 (mime-maybe-hide-echo-buffer)
465 (let ((win-conf (current-window-configuration)))
468 (concat "*Preview-" (mime-entity-name message
) "*")))
469 (or original-major-mode
470 (setq original-major-mode major-mode
))
471 (let ((inhibit-read-only t
))
472 (set-buffer (get-buffer-create preview-buffer
))
476 (setq mime-mother-buffer mother
))
477 (setq mime-preview-original-window-configuration win-conf
)
478 (setq major-mode
'mime-view-mode
)
479 (setq mode-name
"MIME-View")
482 (set-buffer-multibyte nil
)
483 (insert (mime-entity-body message
))
484 (set-buffer-multibyte t
)
485 (decode-coding-region (point-min) (point-max)
486 elmo-mime-display-as-is-coding-system
)
487 (goto-char (point-min))
489 (goto-char (point-min))
491 (let ((method (cdr (assq original-major-mode
492 mime-header-presentation-method-alist
))))
493 (if (functionp method
)
494 (funcall method message nil
)))
496 ;; set original major mode for mime-preview-quit
497 (put-text-property (point-min) (point-max)
499 `((major-mode .
,original-major-mode
)))
500 (put-text-property (point-min) (point-max)
501 'elmo-as-is-entity message
)
504 (if default-keymap-or-function
505 (mime-view-define-keymap default-keymap-or-function
)
506 mime-view-mode-default-map
)))
507 (goto-char (point-min))
508 (search-forward "\n\n" nil t
)
509 (run-hooks 'mime-view-mode-hook
)
510 (set-buffer-modified-p nil
)
511 (setq buffer-read-only t
)
515 (product-provide (provide 'elmo-mime
) (require 'elmo-version
))
517 ;; elmo-mime.el ends here