2 ;;; $Id: tm-body.el,v 0.16 1994/08/20 12:38:07 morioka Exp $
11 (defun replace-as-filename (str)
13 (i 0)(len (length str))
16 (setq chr (elt str i))
17 (if (or (and (<= ?+ chr)(<= chr ?.))
18 (and (<= ?0 chr)(<= chr ?:))
20 (and (<= ?@ chr)(<= chr ?\[))
21 (and (<= ?\] chr)(<= chr ?_))
22 (and (<= ?a chr)(<= chr ?{))
23 (and (<= ?} chr)(<= chr ?~))
25 (setq dest (concat dest
26 (char-to-string chr)))
32 (defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
33 (defconst mime/token-regexp
34 (concat "[^" mime/tspecials "]*"))
35 (defconst mime/content-type-subtype-regexp
36 (concat mime/token-regexp "/" mime/token-regexp))
37 (defconst mime/content-parameter-value-regexp
39 message/quoted-string-regexp
42 (defconst mime/output-buffer-name "*MIME-out*")
43 (defconst mime/decoding-buffer-name "*MIME-decoding*")
45 (defvar mime/content-decoding-method-alist
46 '(("text/plain" . "tm-plain")
47 ("text/x-latex" . "tm-latex")
48 ("audio/basic" . "tm-au")
49 ("image/gif" . "tm-image")
50 ("image/jpeg" . "tm-image")
51 ("image/tiff" . "tm-image")
52 ("image/x-tiff" . "tm-image")
53 ("image/x-xbm" . "tm-image")
54 ("image/x-pic" . "tm-image")
55 ("video/mpeg" . "tm-mpeg")
56 ("application/octet-stream" . "tm-file")
59 (defvar mime/use-internal-decoder nil)
60 ;;; (setq mime/use-internal-decoder t)
62 (defun mime/decode-body ()
64 (if (get-buffer mime/output-buffer-name)
65 (kill-buffer mime/output-buffer-name))
68 (goto-char (point-min))
69 (let ((ctype (mime/Content-Type "^$"))
70 (encoding (mime/Content-Transfer-Encoding "^$" "7bit"))
73 (cond ((equal (car ctype) "multipart/mixed")
74 (mime/decode-multipart/mixed ctype encoding)
76 ((equal (car ctype) "message/partial")
77 (mime/decode-message/partial ctype encoding)
80 (mime/decode-content nil (car ctype) encoding
81 (mime/get-name ctype))
85 (defun mime/decode-multipart/mixed (ctype default-encoding)
86 (let ((boundary (cdr (assoc "boundary" (cdr ctype))))
88 (if (eq (elt boundary 0) ?\")
90 (substring boundary 1 (- (length boundary) 1))
92 (setq boundary (concat "^--" (regexp-quote boundary) "\\(--\\)?$"))
93 (while (re-search-forward boundary nil t)
94 (goto-char (point-min))
95 (setq b (+ (match-end 0) 1))
97 (and (setq ctype (mime/Content-Type))
99 (mime/Content-Transfer-Encoding boundary
101 (mime/decode-content boundary
103 (mime/get-name ctype boundary)
108 (defun mime/decode-message/partial (ctype default-encoding)
109 (let ((root-dir (concat "/tmp/m-prts-" (user-login-name)))
110 (id (cdr (assoc "id" (cdr ctype))))
111 (number (cdr (assoc "number" (cdr ctype))))
112 (total (cdr (assoc "total" (cdr ctype))))
114 (the-buf (current-buffer))
116 (if (not (file-exists-p root-dir))
117 (shell-command (concat "mkdir " root-dir))
119 (setq id (replace-as-filename id))
120 (setq root-dir (concat root-dir "/" id))
121 (if (not (file-exists-p root-dir))
122 (shell-command (concat "mkdir " root-dir))
124 (setq file (concat root-dir "/FULL"))
125 (if (not (file-exists-p file))
127 (setq file (concat root-dir "/CT"))
128 (if (not (file-exists-p file))
130 (if (get-buffer "*MIME-temp*")
131 (kill-buffer "*MIME-temp*")
133 (switch-to-buffer "*MIME-temp*")
134 (insert (concat total "\n"))
136 (switch-to-buffer the-buf)
138 (re-search-forward "^$")
139 (goto-char (+ (match-end 0) 1))
140 (setq file (concat root-dir "/" number))
141 (write-region (point)
144 (if (get-buffer "*MIME-temp*")
145 (kill-buffer "*MIME-temp*")
147 (switch-to-buffer "*MIME-temp*")
149 (max (string-to-int total))
153 (setq file (concat root-dir "/"
156 (if (not (file-exists-p file))
158 (insert-file-contents file)
159 (goto-char (point-max))
162 (write-file (concat root-dir "/FULL"))
166 (switch-to-buffer the-buf)
175 (defun mime/narrow-to-content (boundary)
178 (narrow-to-region (point)
180 (re-search-forward boundary nil t)
183 (goto-char (point-min))
186 (defun mime/get-name (ctype &optional boundary)
189 (mime/narrow-to-content boundary)
191 (or (cdr (assoc "name" (cdr ctype)))
192 (cdr (assoc "x-name" (cdr ctype)))
193 (message/get-field-body "Content-Description")
197 (defun mime/Content-Type (&optional boundary)
200 (mime/narrow-to-content boundary)
201 (if (and (re-search-forward "^Content-Type:[ \t]*" nil t)
205 (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t)
208 (goto-char (point-min))
209 (re-search-forward mime/content-type-subtype-regexp nil t)
213 (buffer-substring (match-beginning 0) (match-end 0))
215 dest attribute value)
216 (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t)
217 (re-search-forward mime/token-regexp nil t)
221 (buffer-substring (match-beginning 0) (match-end 0))
223 (if (and (re-search-forward "=[ \t\n]*" nil t)
224 (re-search-forward mime/content-parameter-value-regexp
229 (buffer-substring (match-beginning 0)
237 (defun mime/Content-Transfer-Encoding (&optional boundary default-encoding)
240 (mime/narrow-to-content boundary)
242 (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
243 (re-search-forward mime/token-regexp nil t)
245 (downcase (buffer-substring (match-beginning 0) (match-end 0)))
250 (defun mime/base64-decode-region (beg end &optional buf filename)
251 (let ((the-buf (current-buffer)) ret)
253 (setq buf (get-buffer-create mime/decoding-buffer-name))
257 (switch-to-buffer buf)
259 (switch-to-buffer the-buf)
260 (narrow-to-region beg end)
261 (goto-char (point-min))
262 (while (re-search-forward
264 mime/Base64-encoded-text-regexp
266 (setq ret (mime/base64-decode-string
267 (buffer-substring (match-beginning 0)
270 (switch-to-buffer buf)
272 (switch-to-buffer the-buf)
276 (switch-to-buffer buf)
277 (let ((kanji-flag nil)
280 (if (featurep 'mule) *noconv*))
282 (write-file filename)
284 (switch-to-buffer the-buf)
288 (defun mime/decode-content (boundary ctype encoding name)
289 (let ((method (cdr (assoc ctype mime/content-decoding-method-alist))))
293 (re-search-forward "^$")
294 (goto-char (+ (match-end 0) 1))
295 (let ((file (make-temp-name "/tmp/TM"))
299 (and (re-search-forward boundary nil t)
303 (if (and (string= encoding "base64")
304 mime/use-internal-decoder)
306 (mime/base64-decode-region b e nil file)
307 (setq encoding "binary")
309 (write-region b e file)
311 (start-process method mime/output-buffer-name method file
315 (if mime/body-decoding-mode
316 mime/body-decoding-mode
318 (replace-as-filename name))
321 (defun mime/show-body-decoded-result ()
323 (if (get-buffer mime/output-buffer-name)
324 (set-window-buffer (get-largest-window)
325 mime/output-buffer-name)