← Back to branch summary

~ubuntu-branches/ubuntu/saucy/wl/saucy-proposed

« back to all changes in this revision

Viewing changes to elmo/elmo-mime.el

  • Committer: Bazaar Package Importer
  • Author(s): Takuo KITAME
  • Date: 2002-02-20 21:51:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020220215116-htmbfdwsdr25nnhm
Tags: upstream-2.8.1
Import upstream version 2.8.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
elmo/elmo-mime.el
 
1
;;; elmo-mime.el --- MIME module for ELMO.
 
2
 
 
3
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
4
 
 
5
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 
6
;; Keywords: mail, net news
 
7
 
 
8
;; This file is part of ELMO (Elisp Library for Message Orchestration).
 
9
 
 
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)
 
13
;; any later version.
 
14
;;
 
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.
 
19
;;
 
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.
 
24
;;
 
25
 
 
26
;;; Commentary:
 
27
;;
 
28
 
 
29
;;; Code:
 
30
;;
 
31
(require 'elmo-vars)
 
32
(require 'mmbuffer)
 
33
(require 'mmimap)
 
34
(require 'mime-view)
 
35
 
 
36
(eval-and-compile
 
37
  (luna-define-class mime-elmo-buffer-entity (mime-buffer-entity) ())
 
38
  (luna-define-class mime-elmo-imap-entity (mime-imap-entity) ()))
 
39
 
 
40
;; Provide backend
 
41
(provide 'mmelmo-imap)
 
42
(provide 'mmelmo-buffer)
 
43
 
 
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)
 
47
 
 
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
 
51
value is used."
 
52
  :type '(choice (integer :tag "Column Number")
 
53
                 (function :tag "Function"))
 
54
  :group 'elmo)
 
55
 
 
56
(defcustom elmo-mime-display-as-is-coding-system (if (boundp 'MULE)
 
57
                                                     '*autoconv* 'undecided)
 
58
  "*Coding system used when message is displayed as is."
 
59
  :type 'symbol
 
60
  :group 'elmo)
 
61
 
 
62
(luna-define-method initialize-instance :after ((entity mime-elmo-buffer-entity)
 
63
                                                &rest init-args)
 
64
  entity)
 
65
 
 
66
(luna-define-method initialize-instance :around ((entity mime-elmo-imap-entity)
 
67
                                                 &rest init-args)
 
68
  (luna-call-next-method))
 
69
 
 
70
;;; Insert sorted header.
 
71
(defsubst elmo-mime-insert-header-from-buffer (buffer
 
72
                                               start end
 
73
                                               &optional invisible-fields
 
74
                                               visible-fields
 
75
                                               sort-fields)
 
76
  (let ((the-buf (current-buffer))
 
77
        (mode-obj (mime-find-field-presentation-method 'wide))
 
78
        field-decoder
 
79
        f-b p f-e field-name field field-body
 
80
        vf-alist (sl sort-fields))
 
81
    (save-excursion
 
82
      (set-buffer buffer)
 
83
      (save-restriction
 
84
        (narrow-to-region start end)
 
85
        (goto-char start)
 
86
        (while (re-search-forward std11-field-head-regexp nil t)
 
87
          (setq f-b (match-beginning 0)
 
88
                p (match-end 0)
 
89
                field-name (buffer-substring f-b p)
 
90
                f-e (std11-field-end))
 
91
          (when (mime-visible-field-p field-name
 
92
                                      visible-fields invisible-fields)
 
93
            (setq field (intern
 
94
                         (capitalize (buffer-substring f-b (1- p))))
 
95
                  field-body (buffer-substring p f-e)
 
96
                  field-decoder (inline (mime-find-field-decoder-internal
 
97
                                         field mode-obj)))
 
98
            (setq vf-alist (append (list
 
99
                                    (cons field-name
 
100
                                          (list field-body field-decoder)))
 
101
                                   vf-alist))))
 
102
        (and vf-alist
 
103
             (setq vf-alist
 
104
                   (sort vf-alist
 
105
                         (function (lambda (s d)
 
106
                                     (let ((n 0) re
 
107
                                           (sf (car s))
 
108
                                           (df (car d)))
 
109
                                       (catch 'done
 
110
                                         (while (setq re (nth n sl))
 
111
                                           (setq n (1+ n))
 
112
                                           (and (string-match re sf)
 
113
                                                (throw 'done t))
 
114
                                           (and (string-match re df)
 
115
                                                (throw 'done nil)))
 
116
                                         t)))))))
 
117
        (with-current-buffer the-buf
 
118
          (while vf-alist
 
119
            (let* ((vf (car vf-alist))
 
120
                   (field-name (car vf))
 
121
                   (field-body (car (cdr vf)))
 
122
                   (field-decoder (car (cdr (cdr vf)))))
 
123
              (insert field-name)
 
124
              (insert (if field-decoder
 
125
                          (funcall field-decoder field-body
 
126
                                   (string-width field-name)
 
127
                                   (if (functionp elmo-mime-header-max-column)
 
128
                                       (funcall elmo-mime-header-max-column)
 
129
                                     elmo-mime-header-max-column))
 
130
                        ;; Don't decode
 
131
                        field-body))
 
132
              (insert "\n"))
 
133
            (setq vf-alist (cdr vf-alist)))
 
134
          (run-hooks 'mmelmo-header-inserted-hook))))))
 
135
 
 
136
(luna-define-generic elmo-mime-insert-sorted-header (entity
 
137
                                                     &optional invisible-fields
 
138
                                                     visible-fields
 
139
                                                     sorted-fields)
 
140
  "Insert sorted header fields of the ENTITY.")
 
141
 
 
142
(luna-define-method elmo-mime-insert-sorted-header ((entity
 
143
                                                     mime-elmo-buffer-entity)
 
144
                                                    &optional invisible-fields
 
145
                                                    visible-fields
 
146
                                                    sorted-fields)
 
147
  (elmo-mime-insert-header-from-buffer
 
148
   (mime-buffer-entity-buffer-internal entity)
 
149
   (mime-buffer-entity-header-start-internal entity)
 
150
   (mime-buffer-entity-header-end-internal entity)
 
151
   invisible-fields visible-fields sorted-fields))
 
152
 
 
153
(luna-define-method elmo-mime-insert-sorted-header ((entity
 
154
                                                     mime-elmo-imap-entity)
 
155
                                                    &optional invisible-fields
 
156
                                                    visible-fields
 
157
                                                    sorted-fields)
 
158
  (let ((the-buf (current-buffer))
 
159
        buf p-min p-max)
 
160
    (with-temp-buffer
 
161
      (insert (mime-imap-entity-header-string entity))
 
162
      (setq buf (current-buffer)
 
163
            p-min (point-min)
 
164
            p-max (point-max))
 
165
      (set-buffer the-buf)
 
166
      (elmo-mime-insert-header-from-buffer buf p-min p-max
 
167
                                           invisible-fields
 
168
                                           visible-fields
 
169
                                           sorted-fields))))
 
170
 
 
171
(luna-define-method mime-insert-text-content :around
 
172
  ((entity mime-elmo-buffer-entity))
 
173
  (luna-call-next-method)
 
174
  (run-hooks 'elmo-message-text-content-inserted-hook))
 
175
 
 
176
(luna-define-method mime-insert-text-content :around
 
177
  ((entity mime-elmo-imap-entity))
 
178
  (luna-call-next-method)
 
179
  (run-hooks 'elmo-message-text-content-inserted-hook))
 
180
 
 
181
(defun elmo-mime-insert-header (entity situation)
 
182
  (elmo-mime-insert-sorted-header
 
183
   entity
 
184
   elmo-message-ignored-field-list
 
185
   elmo-message-visible-field-list
 
186
   elmo-message-sorted-field-list)
 
187
  (run-hooks 'elmo-message-header-inserted-hook))
 
188
 
 
189
(defun elmo-make-mime-message-location (folder number strategy rawbuf unread)
 
190
;; Return the MIME message location structure.
 
191
;; FOLDER is the ELMO folder structure.
 
192
;; NUMBER is the number of the message in the FOLDER.
 
193
;; STRATEGY is the message fetching strategy.
 
194
;; RAWBUF is the output buffer for original message.
 
195
;; If second optional argument UNREAD is non-nil, message is not marked
 
196
;; as read.
 
197
  (if (and strategy
 
198
           (eq (elmo-fetch-strategy-entireness strategy) 'section))
 
199
      (luna-make-entity
 
200
       'mime-elmo-imap-location
 
201
       :folder folder
 
202
       :number number
 
203
       :rawbuf rawbuf
 
204
       :strategy strategy)
 
205
    (with-current-buffer rawbuf
 
206
      (let (buffer-read-only)
 
207
        (erase-buffer)
 
208
        (if strategy
 
209
            (elmo-message-fetch folder number strategy
 
210
                                nil (current-buffer)
 
211
                                unread))))
 
212
    rawbuf))
 
213
 
 
214
(defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
 
215
                                         &optional ignore-cache unread keymap)
 
216
  "Display MIME message. 
 
217
A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
 
218
VIEWBUF is a view buffer and RAWBUF is a raw buffer.
 
219
ORIGINAL is the major mode of RAWBUF.
 
220
If optional argument IGNORE-CACHE is specified, existing cache is ignored.
 
221
If second optional argument UNREAD is specified, message is displayed but
 
222
keep it as unread.
 
223
Return non-nil if not entire message was fetched."
 
224
  (let (mime-display-header-hook ; Do nothing.
 
225
        (elmo-message-displaying t)
 
226
        entity strategy)
 
227
    (setq entity (elmo-msgdb-overview-get-entity number
 
228
                                                 (elmo-folder-msgdb
 
229
                                                  folder)))
 
230
    (setq strategy (elmo-find-fetch-strategy folder entity
 
231
                                             ignore-cache))
 
232
    (mime-display-message
 
233
     (mime-open-entity
 
234
      (if (and strategy
 
235
               (eq (elmo-fetch-strategy-entireness strategy) 'section))
 
236
          'elmo-imap
 
237
        'elmo-buffer)
 
238
      (elmo-make-mime-message-location
 
239
       folder number strategy rawbuf unread))
 
240
     viewbuf nil keymap
 
241
     original-mode)
 
242
    (if strategy
 
243
        (or (elmo-fetch-strategy-use-cache strategy)
 
244
            (eq (elmo-fetch-strategy-entireness strategy)
 
245
                'section)))))
 
246
 
 
247
(defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode
 
248
                                       &optional ignore-cache unread keymap)
 
249
  "Display MIME message. 
 
250
A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
 
251
VIEWBUF is a view buffer and RAWBUF is a raw buffer.
 
252
ORIGINAL is the major mode of RAWBUF.
 
253
If optional argument IGNORE-CACHE is specified, existing cache is ignored.
 
254
If second optional argument UNREAD is specified, message is displayed but
 
255
keep it as unread.
 
256
Return non-nil if cache is used."
 
257
  (let ((entity (elmo-msgdb-overview-get-entity number
 
258
                                                (elmo-folder-msgdb folder)))
 
259
        mime-display-header-hook ; Do nothing.
 
260
        cache-file strategy use-cache)
 
261
    (setq cache-file (elmo-file-cache-get
 
262
                      (elmo-msgdb-overview-entity-get-id entity)))
 
263
    (setq use-cache (eq (elmo-file-cache-status cache-file) 'entire))
 
264
    (setq strategy (elmo-make-fetch-strategy
 
265
                    'entire use-cache (elmo-message-use-cache-p folder number)
 
266
                    (elmo-file-cache-path
 
267
                     cache-file)))
 
268
    (elmo-mime-display-as-is-internal
 
269
     (mime-open-entity
 
270
      'elmo-buffer
 
271
      (elmo-make-mime-message-location
 
272
       folder number strategy rawbuf unread))
 
273
     viewbuf nil keymap original-mode)
 
274
    (elmo-fetch-strategy-use-cache strategy)))
 
275
 
 
276
;; Replacement of mime-display-message.
 
277
(defun elmo-mime-display-as-is-internal (message
 
278
                                         &optional preview-buffer
 
279
                                         mother default-keymap-or-function
 
280
                                         original-major-mode keymap)
 
281
  (mime-maybe-hide-echo-buffer)
 
282
  (let ((win-conf (current-window-configuration)))
 
283
    (or preview-buffer
 
284
        (setq preview-buffer
 
285
              (concat "*Preview-" (mime-entity-name message) "*")))
 
286
    (or original-major-mode
 
287
        (setq original-major-mode major-mode))
 
288
    (let ((inhibit-read-only t))
 
289
      (set-buffer (get-buffer-create preview-buffer))
 
290
      (widen)
 
291
      (erase-buffer)
 
292
      (if mother
 
293
          (setq mime-mother-buffer mother))
 
294
      (setq mime-preview-original-window-configuration win-conf)
 
295
      (setq major-mode 'mime-view-mode)
 
296
      (setq mode-name "MIME-View")
 
297
 
 
298
      ;; Humm...
 
299
      (set-buffer-multibyte nil)
 
300
      (mime-insert-entity message)
 
301
      (set-buffer-multibyte t)
 
302
      (decode-coding-region (point-min) (point-max)
 
303
                            elmo-mime-display-as-is-coding-system)
 
304
      (save-restriction
 
305
        (std11-narrow-to-header)
 
306
        (run-hooks 'elmo-message-header-inserted-hook))
 
307
      ;; set original major mode for mime-preview-quit
 
308
      (put-text-property (point-min) (point-max)
 
309
                         'mime-view-situation
 
310
                         `((major-mode . ,original-major-mode)))
 
311
      (use-local-map
 
312
       (or keymap
 
313
           (if default-keymap-or-function
 
314
               (mime-view-define-keymap default-keymap-or-function)
 
315
             mime-view-mode-default-map)))
 
316
      (let ((point
 
317
             (next-single-property-change (point-min) 'mime-view-entity)))
 
318
        (if point
 
319
            (goto-char point)
 
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)
 
325
      preview-buffer)))
 
326
 
 
327
(require 'product)
 
328
(product-provide (provide 'elmo-mime) (require 'elmo-version))
 
329
 
 
330
;; elmo-mime.el ends here