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.
37 (luna-define-class mime-elmo-buffer-entity (mime-buffer-entity) ())
38 (luna-define-class mime-elmo-imap-entity (mime-imap-entity) ()))
41 (provide 'mmelmo-imap)
42 (provide 'mmelmo-buffer)
44 (defvar elmo-message-ignored-field-list mime-view-ignored-field-list)
45 (defvar elmo-message-visible-field-list mime-view-visible-field-list)
46 (defvar elmo-message-sorted-field-list nil)
48 (defcustom elmo-mime-header-max-column fill-column
49 "*Header max column number. Default is `fill-colmn'.
50 If a symbol of function is specified, the function is called and its return
52 :type '(choice (integer :tag "Column Number")
53 (function :tag "Function"))
56 (luna-define-method initialize-instance :after ((entity mime-elmo-buffer-entity)
60 (luna-define-method initialize-instance :around ((entity mime-elmo-imap-entity)
62 (luna-call-next-method))
64 ;;; Insert sorted header.
65 (defsubst elmo-mime-insert-header-from-buffer (buffer
67 &optional invisible-fields
70 (let ((the-buf (current-buffer))
71 (mode-obj (mime-find-field-presentation-method 'wide))
73 f-b p f-e field-name field field-body
74 vf-alist (sl sort-fields))
78 (narrow-to-region start end)
80 (while (re-search-forward std11-field-head-regexp nil t)
81 (setq f-b (match-beginning 0)
83 field-name (buffer-substring f-b p)
84 f-e (std11-field-end))
85 (when (mime-visible-field-p field-name
86 visible-fields invisible-fields)
88 (capitalize (buffer-substring f-b (1- p))))
89 field-body (buffer-substring p f-e)
90 field-decoder (inline (mime-find-field-decoder-internal
92 (setq vf-alist (append (list
94 (list field-body field-decoder)))
99 (function (lambda (s d)
104 (while (setq re (nth n sl))
106 (and (string-match re sf)
108 (and (string-match re df)
111 (with-current-buffer the-buf
113 (let* ((vf (car vf-alist))
114 (field-name (car vf))
115 (field-body (car (cdr vf)))
116 (field-decoder (car (cdr (cdr vf)))))
118 (insert (if field-decoder
119 (funcall field-decoder field-body
120 (string-width field-name)
121 (if (functionp elmo-mime-header-max-column)
122 (funcall elmo-mime-header-max-column)
123 elmo-mime-header-max-column))
127 (setq vf-alist (cdr vf-alist)))
128 (run-hooks 'mmelmo-header-inserted-hook))))))
130 (luna-define-generic elmo-mime-insert-sorted-header (entity
131 &optional invisible-fields
134 "Insert sorted header fields of the ENTITY.")
136 (luna-define-method elmo-mime-insert-sorted-header ((entity
137 mime-elmo-buffer-entity)
138 &optional invisible-fields
141 (elmo-mime-insert-header-from-buffer
142 (mime-buffer-entity-buffer-internal entity)
143 (mime-buffer-entity-header-start-internal entity)
144 (mime-buffer-entity-header-end-internal entity)
145 invisible-fields visible-fields sorted-fields))
147 (luna-define-method elmo-mime-insert-sorted-header ((entity
148 mime-elmo-imap-entity)
149 &optional invisible-fields
152 (let ((the-buf (current-buffer))
155 (insert (mime-imap-entity-header-string entity))
156 (setq buf (current-buffer)
160 (elmo-mime-insert-header-from-buffer buf p-min p-max
165 (luna-define-method mime-insert-text-content :around
166 ((entity mime-elmo-buffer-entity))
167 (luna-call-next-method)
168 (run-hooks 'elmo-message-text-content-inserted-hook))
170 (luna-define-method mime-insert-text-content :around
171 ((entity mime-elmo-imap-entity))
172 (luna-call-next-method)
173 (run-hooks 'elmo-message-text-content-inserted-hook))
175 (defun elmo-mime-insert-header (entity situation)
176 (elmo-mime-insert-sorted-header
178 elmo-message-ignored-field-list
179 elmo-message-visible-field-list
180 elmo-message-sorted-field-list)
181 (run-hooks 'elmo-message-header-inserted-hook))
183 (defun elmo-make-mime-message-location (folder number strategy rawbuf unread)
184 ;; Return the MIME message location structure.
185 ;; FOLDER is the ELMO folder structure.
186 ;; NUMBER is the number of the message in the FOLDER.
187 ;; STRATEGY is the message fetching strategy.
188 ;; RAWBUF is the output buffer for original message.
189 ;; If second optional argument UNREAD is non-nil, message is not marked
192 (eq (elmo-fetch-strategy-entireness strategy) 'section))
194 'mime-elmo-imap-location
199 (with-current-buffer rawbuf
200 (let (buffer-read-only)
203 (elmo-message-fetch folder number strategy
208 (defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
209 &optional ignore-cache unread keymap)
210 "Display MIME message.
211 A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
212 VIEWBUF is a view buffer and RAWBUF is a raw buffer.
213 ORIGINAL is the major mode of RAWBUF.
214 If optional argument IGNORE-CACHE is specified, existing cache is ignored.
215 If second optional argument UNREAD is specified, message is displayed but
217 Return non-nil if not entire message was fetched."
218 (let (mime-display-header-hook ; Do nothing.
219 (elmo-message-displaying t)
221 (unless (zerop (elmo-folder-length folder))
222 (setq entity (elmo-message-entity folder number)))
223 (setq strategy (if entity (elmo-find-fetch-strategy folder entity
225 (elmo-make-fetch-strategy 'entire)))
226 (mime-display-message
229 (eq (elmo-fetch-strategy-entireness strategy) 'section))
232 (elmo-make-mime-message-location
233 folder number strategy rawbuf unread))
237 (or (elmo-fetch-strategy-use-cache strategy)
238 (eq (elmo-fetch-strategy-entireness strategy)
241 (defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode
242 &optional ignore-cache unread keymap)
243 "Display MIME message.
244 A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
245 VIEWBUF is a view buffer and RAWBUF is a raw buffer.
246 ORIGINAL is the major mode of RAWBUF.
247 If optional argument IGNORE-CACHE is specified, existing cache is ignored.
248 If second optional argument UNREAD is specified, message is displayed but
250 Return non-nil if cache is used."
251 (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder) number))
252 mime-display-header-hook ; Do nothing.
253 cache-file strategy use-cache)
255 (setq cache-file (elmo-file-cache-get
256 (elmo-message-entity-field entity 'message-id)))
257 (setq use-cache (and (elmo-message-use-cache-p folder number)
258 (eq (elmo-file-cache-status cache-file) 'entire))))
259 (setq strategy (elmo-make-fetch-strategy
261 (elmo-message-use-cache-p folder number)
262 (elmo-file-cache-path cache-file)))
263 (elmo-mime-display-as-is-internal
266 (elmo-make-mime-message-location
267 folder number strategy rawbuf unread))
268 viewbuf nil keymap original-mode)
270 (elmo-fetch-strategy-use-cache strategy))))
272 ;; Replacement of mime-display-message.
273 (defun elmo-mime-display-as-is-internal (message
274 &optional preview-buffer
275 mother default-keymap-or-function
276 original-major-mode keymap)
277 (mime-maybe-hide-echo-buffer)
278 (let ((win-conf (current-window-configuration)))
281 (concat "*Preview-" (mime-entity-name message) "*")))
282 (or original-major-mode
283 (setq original-major-mode major-mode))
284 (let ((inhibit-read-only t))
285 (set-buffer (get-buffer-create preview-buffer))
289 (setq mime-mother-buffer mother))
290 (setq mime-preview-original-window-configuration win-conf)
291 (setq major-mode 'mime-view-mode)
292 (setq mode-name "MIME-View")
295 (set-buffer-multibyte nil)
296 (insert (mime-entity-body message))
297 (set-buffer-multibyte t)
298 (decode-coding-region (point-min) (point-max)
299 elmo-mime-display-as-is-coding-system)
300 (goto-char (point-min))
302 (goto-char (point-min))
304 (let ((method (cdr (assq original-major-mode
305 mime-header-presentation-method-alist))))
306 (if (functionp method)
307 (funcall method message nil)))
309 ;; set original major mode for mime-preview-quit
310 (put-text-property (point-min) (point-max)
312 `((major-mode . ,original-major-mode)))
313 (put-text-property (point-min) (point-max)
314 'elmo-as-is-entity message)
317 (if default-keymap-or-function
318 (mime-view-define-keymap default-keymap-or-function)
319 mime-view-mode-default-map)))
320 (goto-char (point-min))
321 (search-forward "\n\n" nil t)
322 (run-hooks 'mime-view-mode-hook)
323 (set-buffer-modified-p nil)
324 (setq buffer-read-only t)
328 (product-provide (provide 'elmo-mime) (require 'elmo-version))
330 ;; elmo-mime.el ends here