1 ;;; mmdual.el --- MIME entity module for dual buffers
3 ;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
4 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
5 ;; Licensed to the Free Software Foundation.
7 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
8 ;; Keywords: MIME, multimedia, mail, news
10 ;; This file is part of FLIM (Faithful Library about Internet Message).
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
32 (luna-define-class mime-dual-entity (mime-entity)
36 (luna-define-internal-accessors 'mime-dual-entity)
39 (luna-define-method initialize-instance :after ((entity mime-dual-entity)
42 (setq buf (mime-dual-entity-header-buffer-internal entity))
44 (with-current-buffer buf
45 (if (mime-root-entity-p entity)
46 (setq mime-message-structure entity))
47 (or (mime-entity-content-type-internal entity)
48 (mime-entity-set-content-type-internal
50 (let ((str (std11-fetch-field "Content-Type")))
52 (mime-parse-Content-Type str)
54 (setq buf (mime-dual-entity-body-buffer-internal entity))
56 (with-current-buffer buf
57 (if (mime-root-entity-p entity)
58 (setq mime-message-structure entity))))
61 (luna-define-method mime-entity-name ((entity mime-dual-entity))
62 (buffer-name (mime-dual-entity-header-buffer-internal entity))
66 (defun mime-visible-field-p (field-name visible-fields invisible-fields)
69 (let ((regexp (car visible-fields)))
70 (if (string-match regexp field-name)
73 (setq visible-fields (cdr visible-fields))
76 (while invisible-fields
77 (let ((regexp (car invisible-fields)))
78 (if (string-match regexp field-name)
81 (setq invisible-fields (cdr invisible-fields))
85 (defun mime-insert-header-from-buffer (buffer start end
86 &optional invisible-fields
88 (let ((the-buf (current-buffer))
89 (mode-obj (mime-find-field-presentation-method 'wide))
91 f-b p f-e field-name len field field-body)
95 (narrow-to-region start end)
97 (while (re-search-forward std11-field-head-regexp nil t)
98 (setq f-b (match-beginning 0)
100 field-name (buffer-substring f-b p)
101 len (string-width field-name)
102 f-e (std11-field-end))
103 (when (mime-visible-field-p field-name
104 visible-fields invisible-fields)
106 (capitalize (buffer-substring f-b (1- p))))
107 field-body (buffer-substring p f-e)
108 field-decoder (inline (mime-find-field-decoder-internal
110 (with-current-buffer the-buf
112 (insert (if field-decoder
113 (funcall field-decoder field-body len)
119 (luna-define-method mime-insert-header ((entity mime-dual-entity)
120 &optional invisible-fields
122 (let* ((buf (mime-dual-entity-header-buffer-internal entity))
123 header-start header-end)
124 (with-current-buffer buf
125 (setq header-start (point-min)
126 header-end (point-max)))
127 (mime-insert-header-from-buffer buf header-start header-end
128 invisible-fields visible-fields)
131 (luna-define-method mime-entity-content ((entity mime-dual-entity))
133 (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
135 (mime-entity-encoding entity)))
137 (luna-define-method mime-entity-fetch-field :around
138 ((entity mime-dual-entity) field-name)
139 (or (luna-call-next-method)
140 (with-current-buffer (mime-dual-entity-header-buffer-internal entity)
141 (let ((ret (std11-fetch-field field-name)))
143 (or (symbolp field-name)
145 (intern (capitalize (capitalize field-name)))))
146 (mime-entity-set-original-header-internal
148 (put-alist field-name ret
149 (mime-entity-original-header-internal entity)))
152 (luna-define-method mime-insert-entity-content ((entity mime-dual-entity))
155 (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
156 (buffer-substring (point-min)(point-max)))
157 (mime-entity-encoding entity))))
159 (luna-define-method mime-write-entity-content ((entity mime-dual-entity)
161 (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
162 (mime-write-decoded-region (point-min)
165 (or (mime-entity-encoding entity) "7bit"))))
167 (luna-define-method mime-insert-entity ((entity mime-dual-entity))
169 (setq buf (mime-dual-entity-header-buffer-internal entity))
171 (insert-buffer (mime-dual-entity-header-buffer-internal entity))
172 (setq buf (mime-dual-entity-body-buffer-internal entity))
175 (insert-buffer buf)))))
177 (luna-define-method mime-write-entity ((entity mime-dual-entity) filename)
179 (setq buf (mime-dual-entity-header-buffer-internal entity))
181 (error "No header buffer.")
182 (with-current-buffer buf
183 (write-region-as-raw-text-CRLF
184 (point-min)(point-max) filename))
185 (setq buf (mime-dual-entity-body-buffer-internal entity))
189 (write-region-as-raw-text-CRLF
190 (point-min)(point-max)
192 (with-current-buffer buf
193 (write-region-as-raw-text-CRLF
194 (point-min)(point-max)
195 filename 'append))))))
197 (luna-define-method mime-write-entity-body ((entity mime-dual-entity) filename)
198 (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
199 (write-region-as-binary (point-min)(point-max)
206 (luna-define-method mime-entity-header-buffer ((entity mime-dual-entity))
207 (mime-dual-entity-header-buffer-internal entity))
209 (luna-define-method mime-entity-body-buffer ((entity mime-dual-entity))
210 (mime-dual-entity-body-buffer-internal entity))
212 (luna-define-method mime-entity-buffer ((entity mime-dual-entity))
213 (message "mime-dual-entity does not have mime-entity-buffer.")
216 (luna-define-method mime-entity-body-start-point ((entity mime-dual-entity))
217 (with-current-buffer (mime-entity-body-buffer entity)
220 (luna-define-method mime-entity-body-end-point ((entity mime-dual-entity))
221 (with-current-buffer (mime-entity-body-buffer entity)
224 (luna-define-method mime-entity-point-min ((entity mime-dual-entity))
225 (message "mime-dual-entity does not have mime-entity-point-min.")
228 (luna-define-method mime-entity-point-max ((entity mime-dual-entity))
229 (message "mime-dual-entity does not have mime-entity-point-max.")
232 (luna-define-method mime-goto-header-start-point ((entity mime-dual-entity))
233 (set-buffer (mime-dual-entity-header-buffer-internal entity))
234 (goto-char (point-min)))
236 (luna-define-method mime-goto-body-start-point ((entity mime-dual-entity))
237 (set-buffer (mime-dual-entity-body-buffer-internal entity))
238 (goto-char (point-min)))
240 (luna-define-method mime-goto-body-end-point ((entity mime-dual-entity))
241 (set-buffer (mime-dual-entity-body-buffer-internal entity))
242 (goto-char (point-max)))
250 ;;; mmdual.el ends here