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
161 invisible-fields visible-fields))))
163 (luna-define-method mime-insert-text-content :around
164 ((entity mime-elmo-buffer-entity))
165 (luna-call-next-method)
166 (run-hooks 'elmo-message-text-content-inserted-hook))
168 (luna-define-method mime-insert-text-content :around
169 ((entity mime-elmo-imap-entity))
170 (luna-call-next-method)
171 (run-hooks 'elmo-message-text-content-inserted-hook))
173 (defun elmo-mime-insert-header (entity situation)
174 (elmo-mime-insert-sorted-header
176 elmo-message-ignored-field-list
177 elmo-message-visible-field-list
178 elmo-message-sorted-field-list)
179 (run-hooks 'elmo-message-header-inserted-hook))
181 (defun elmo-make-mime-message-location (folder number strategy rawbuf unread)
182 ;; Return the MIME message location structure.
183 ;; FOLDER is the ELMO folder structure.
184 ;; NUMBER is the number of the message in the FOLDER.
185 ;; STRATEGY is the message fetching strategy.
186 ;; RAWBUF is the output buffer for original message.
187 ;; If second optional argument UNREAD is non-nil, message is not marked
190 (eq (elmo-fetch-strategy-entireness strategy) 'section))
192 'mime-elmo-imap-location
197 (with-current-buffer rawbuf
198 (let (buffer-read-only)
201 (elmo-message-fetch folder number strategy
206 (defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
207 &optional ignore-cache unread)
208 "Display MIME message.
209 A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
210 VIEWBUF is a view buffer and RAWBUF is a raw buffer.
211 ORIGINAL is the major mode of RAWBUF.
212 If optional argument IGNORE-CACHE is specified, existing cache is ignored.
213 If second optional argument UNREAD is specified, message is displayed but
215 Return non-nil if not entire message was fetched."
216 (let (mime-display-header-hook ; Do nothing.
218 (setq entity (elmo-msgdb-overview-get-entity number
221 (setq strategy (elmo-find-fetch-strategy folder entity
223 (mime-display-message
226 (eq (elmo-fetch-strategy-entireness strategy) 'section))
229 (elmo-make-mime-message-location
230 folder number strategy rawbuf unread))
231 viewbuf nil nil original-mode)
233 (or (elmo-fetch-strategy-use-cache strategy)
234 (eq (elmo-fetch-strategy-entireness strategy)
237 (defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode
238 &optional ignore-cache unread)
239 "Display MIME message.
240 A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
241 VIEWBUF is a view buffer and RAWBUF is a raw buffer.
242 ORIGINAL is the major mode of RAWBUF.
243 If optional argument IGNORE-CACHE is specified, existing cache is ignored.
244 If second optional argument UNREAD is specified, message is displayed but
246 Return non-nil if cache is used."
247 (let ((entity (elmo-msgdb-overview-get-entity number
248 (elmo-folder-msgdb folder)))
249 mime-display-header-hook ; Do nothing.
250 cache-file strategy use-cache)
251 (setq cache-file (elmo-file-cache-get
252 (elmo-msgdb-overview-entity-get-id entity)))
253 (setq use-cache (eq (elmo-file-cache-status cache-file) 'entire))
254 (setq strategy (elmo-make-fetch-strategy
255 'entire use-cache (elmo-message-use-cache-p folder number)
256 (elmo-file-cache-path
258 (elmo-mime-display-as-is-internal
261 (elmo-make-mime-message-location
262 folder number strategy rawbuf unread))
263 viewbuf nil nil original-mode)
264 (elmo-fetch-strategy-use-cache strategy)))
266 ;; Replacement of mime-display-message.
267 (defun elmo-mime-display-as-is-internal (message
268 &optional preview-buffer
269 mother default-keymap-or-function
270 original-major-mode keymap)
271 (mime-maybe-hide-echo-buffer)
272 (let ((win-conf (current-window-configuration)))
275 (concat "*Preview-" (mime-entity-name message) "*")))
276 (or original-major-mode
277 (setq original-major-mode major-mode))
278 (let ((inhibit-read-only t))
279 (set-buffer (get-buffer-create preview-buffer))
283 (setq mime-mother-buffer mother))
284 (setq mime-preview-original-window-configuration win-conf)
285 (setq major-mode 'mime-view-mode)
286 (setq mode-name "MIME-View")
289 (set-buffer-multibyte nil)
290 (mime-insert-entity message)
291 (set-buffer-multibyte t)
292 (decode-coding-region (point-min) (point-max) 'undecided)
294 (std11-narrow-to-header)
295 (run-hooks 'elmo-message-header-inserted-hook))
296 ;; set original major mode for mime-preview-quit
297 (put-text-property (point-min) (point-max)
299 `((major-mode . ,original-major-mode)))
302 (if default-keymap-or-function
303 (mime-view-define-keymap default-keymap-or-function)
304 mime-view-mode-default-map)))
306 (next-single-property-change (point-min) 'mime-view-entity)))
309 (goto-char (point-min))
310 (search-forward "\n\n" nil t)))
311 (run-hooks 'mime-view-mode-hook)
312 (set-buffer-modified-p nil)
313 (setq buffer-read-only t)
317 (product-provide (provide 'elmo-mime) (require 'elmo-version))
319 ;; elmo-mime.el ends here