+++ /dev/null
-;;;
-;;; $Id: tm-body.el,v 0.16 1994/08/20 12:38:07 morioka Exp $
-;;;
-
-(provide 'tm-body)
-
-(require 'tl-list)
-(require 'tl-header)
-(require 'tiny-mime)
-
-(defun replace-as-filename (str)
- (let ((dest "")
- (i 0)(len (length str))
- chr)
- (while (< i len)
- (setq chr (elt str i))
- (if (or (and (<= ?+ chr)(<= chr ?.))
- (and (<= ?0 chr)(<= chr ?:))
- (= chr ?=)
- (and (<= ?@ chr)(<= chr ?\[))
- (and (<= ?\] chr)(<= chr ?_))
- (and (<= ?a chr)(<= chr ?{))
- (and (<= ?} chr)(<= chr ?~))
- )
- (setq dest (concat dest
- (char-to-string chr)))
- )
- (setq i (+ i 1))
- )
- dest))
-
-(defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
-(defconst mime/token-regexp
- (concat "[^" mime/tspecials "]*"))
-(defconst mime/content-type-subtype-regexp
- (concat mime/token-regexp "/" mime/token-regexp))
-(defconst mime/content-parameter-value-regexp
- (concat "\\("
- message/quoted-string-regexp
- "\\|[^; \t\n]\\)*"))
-
-(defconst mime/output-buffer-name "*MIME-out*")
-(defconst mime/decoding-buffer-name "*MIME-decoding*")
-
-(defvar mime/content-decoding-method-alist
- '(("text/plain" . "tm-plain")
- ("text/x-latex" . "tm-latex")
- ("audio/basic" . "tm-au")
- ("image/gif" . "tm-image")
- ("image/jpeg" . "tm-image")
- ("image/tiff" . "tm-image")
- ("image/x-tiff" . "tm-image")
- ("image/x-xbm" . "tm-image")
- ("image/x-pic" . "tm-image")
- ("video/mpeg" . "tm-mpeg")
- ("application/octet-stream" . "tm-file")
- ))
-
-(defvar mime/use-internal-decoder nil)
-;;; (setq mime/use-internal-decoder t)
-
-(defun mime/decode-body ()
- (interactive)
- (if (get-buffer mime/output-buffer-name)
- (kill-buffer mime/output-buffer-name))
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (let ((ctype (mime/Content-Type "^$"))
- (encoding (mime/Content-Transfer-Encoding "^$" "7bit"))
- )
- (if ctype
- (cond ((equal (car ctype) "multipart/mixed")
- (mime/decode-multipart/mixed ctype encoding)
- )
- ((equal (car ctype) "message/partial")
- (mime/decode-message/partial ctype encoding)
- )
- (t
- (mime/decode-content nil (car ctype) encoding
- (mime/get-name ctype))
- ))
- )))))
-
-(defun mime/decode-multipart/mixed (ctype default-encoding)
- (let ((boundary (cdr (assoc "boundary" (cdr ctype))))
- encoding b)
- (if (eq (elt boundary 0) ?\")
- (setq boundary
- (substring boundary 1 (- (length boundary) 1))
- ))
- (setq boundary (concat "^--" (regexp-quote boundary) "\\(--\\)?$"))
- (while (re-search-forward boundary nil t)
- (goto-char (point-min))
- (setq b (+ (match-end 0) 1))
- (goto-char b)
- (and (setq ctype (mime/Content-Type))
- (setq encoding
- (mime/Content-Transfer-Encoding boundary
- default-encoding))
- (mime/decode-content boundary
- (car ctype) encoding
- (mime/get-name ctype boundary)
- )
- )
- )))
-
-(defun mime/decode-message/partial (ctype default-encoding)
- (let ((root-dir (concat "/tmp/m-prts-" (user-login-name)))
- (id (cdr (assoc "id" (cdr ctype))))
- (number (cdr (assoc "number" (cdr ctype))))
- (total (cdr (assoc "total" (cdr ctype))))
- file
- (the-buf (current-buffer))
- )
- (if (not (file-exists-p root-dir))
- (shell-command (concat "mkdir " root-dir))
- )
- (setq id (replace-as-filename id))
- (setq root-dir (concat root-dir "/" id))
- (if (not (file-exists-p root-dir))
- (shell-command (concat "mkdir " root-dir))
- )
- (setq file (concat root-dir "/FULL"))
- (if (not (file-exists-p file))
- (progn
- (setq file (concat root-dir "/CT"))
- (if (not (file-exists-p file))
- (progn
- (if (get-buffer "*MIME-temp*")
- (kill-buffer "*MIME-temp*")
- )
- (switch-to-buffer "*MIME-temp*")
- (insert (concat total "\n"))
- (write-file file)
- (switch-to-buffer the-buf)
- ))
- (re-search-forward "^$")
- (goto-char (+ (match-end 0) 1))
- (setq file (concat root-dir "/" number))
- (write-region (point)
- (point-max)
- file)
- (if (get-buffer "*MIME-temp*")
- (kill-buffer "*MIME-temp*")
- )
- (switch-to-buffer "*MIME-temp*")
- (let ((i 1)
- (max (string-to-int total))
- )
- (catch 'tag
- (while (<= i max)
- (setq file (concat root-dir "/"
- (int-to-string i)
- ))
- (if (not (file-exists-p file))
- (throw 'tag nil))
- (insert-file-contents file)
- (goto-char (point-max))
- (setq i (+ i 1))
- )
- (write-file (concat root-dir "/FULL"))
- (mime/decode-body)
- (kill-buffer "FULL")
- ))
- (switch-to-buffer the-buf)
- )
- (progn
- (find-file file)
- (mime/decode-body)
- (kill-buffer "FULL")
- ))
- ))
-
-(defun mime/narrow-to-content (boundary)
- (if boundary
- (progn
- (narrow-to-region (point)
- (progn
- (re-search-forward boundary nil t)
- (match-beginning 0)
- ))
- (goto-char (point-min))
- )))
-
-(defun mime/get-name (ctype &optional boundary)
- (save-excursion
- (save-restriction
- (mime/narrow-to-content boundary)
- (replace-as-filename
- (or (cdr (assoc "name" (cdr ctype)))
- (cdr (assoc "x-name" (cdr ctype)))
- (message/get-field-body "Content-Description")
- ""))
- )))
-
-(defun mime/Content-Type (&optional boundary)
- (save-excursion
- (save-restriction
- (mime/narrow-to-content boundary)
- (if (and (re-search-forward "^Content-Type:[ \t]*" nil t)
- (progn
- (narrow-to-region
- (point)
- (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t)
- (match-end 0))
- )
- (goto-char (point-min))
- (re-search-forward mime/content-type-subtype-regexp nil t)
- ))
- (let ((ctype
- (downcase
- (buffer-substring (match-beginning 0) (match-end 0))
- ))
- dest attribute value)
- (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t)
- (re-search-forward mime/token-regexp nil t)
- )
- (setq attribute
- (downcase
- (buffer-substring (match-beginning 0) (match-end 0))
- ))
- (if (and (re-search-forward "=[ \t\n]*" nil t)
- (re-search-forward mime/content-parameter-value-regexp
- nil t)
- )
- (setq dest
- (put-alist attribute
- (buffer-substring (match-beginning 0)
- (match-end 0))
- dest))
- )
- )
- (cons ctype dest)
- )))))
-
-(defun mime/Content-Transfer-Encoding (&optional boundary default-encoding)
- (save-excursion
- (save-restriction
- (mime/narrow-to-content boundary)
- (or
- (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
- (re-search-forward mime/token-regexp nil t)
- )
- (downcase (buffer-substring (match-beginning 0) (match-end 0)))
- )
- default-encoding)
- )))
-
-(defun mime/base64-decode-region (beg end &optional buf filename)
- (let ((the-buf (current-buffer)) ret)
- (if (null buf)
- (setq buf (get-buffer-create mime/decoding-buffer-name))
- )
- (save-excursion
- (save-restriction
- (switch-to-buffer buf)
- (erase-buffer)
- (switch-to-buffer the-buf)
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^"
- mime/Base64-encoded-text-regexp
- "$") nil t)
- (setq ret (mime/base64-decode-string
- (buffer-substring (match-beginning 0)
- (match-end 0)
- )))
- (switch-to-buffer buf)
- (insert ret)
- (switch-to-buffer the-buf)
- )))
- (if filename
- (progn
- (switch-to-buffer buf)
- (let ((kanji-flag nil)
- (mc-flag nil)
- (file-coding-system
- (if (featurep 'mule) *noconv*))
- )
- (write-file filename)
- (kill-buffer buf)
- (switch-to-buffer the-buf)
- )))
- ))
-
-(defun mime/decode-content (boundary ctype encoding name)
- (let ((method (cdr (assoc ctype mime/content-decoding-method-alist))))
- (if method
- (save-excursion
- (save-restriction
- (re-search-forward "^$")
- (goto-char (+ (match-end 0) 1))
- (let ((file (make-temp-name "/tmp/TM"))
- (b (point)) e
- )
- (setq e (if boundary
- (and (re-search-forward boundary nil t)
- (match-beginning 0))
- (point-max)
- ))
- (if (and (string= encoding "base64")
- mime/use-internal-decoder)
- (progn
- (mime/base64-decode-region b e nil file)
- (setq encoding "binary")
- )
- (write-region b e file)
- )
- (start-process method mime/output-buffer-name method file
- ctype (if encoding
- encoding
- "7bit")
- (if mime/body-decoding-mode
- mime/body-decoding-mode
- "decode")
- (replace-as-filename name))
- ))))))
-
-(defun mime/show-body-decoded-result ()
- (interactive)
- (if (get-buffer mime/output-buffer-name)
- (set-window-buffer (get-largest-window)
- mime/output-buffer-name)
- ))
projects / elisp / tm.git / blobdiff