-;;; @ decoder
-;;;
-
-(defun mime/Quoted-Printable-decode-region (beg end)
- (interactive "*r")
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (re-search-forward "=\n" nil t)
- (replace-match "")
- )
- (goto-char (point-min))
- (let (b e str)
- (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
- (setq b (match-beginning 0))
- (setq e (match-end 0))
- (setq str (buffer-substring b e))
- (delete-region b e)
- (insert (mime/Quoted-Printable-decode-string str))
- ))
- )))
-
-(defun mime/Base64-decode-region (beg end)
- (interactive "*r")
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (replace-match "")
- )
- (let ((str (buffer-substring (point-min)(point-max))))
- (delete-region (point-min)(point-max))
- (insert (mime/base64-decode-string str))
- ))))
-
-(defun mime/make-method-args (cal format)
- (mapcar (function
- (lambda (arg)
- (if (stringp arg)
- arg
- (let ((ret (cdr (assoc (eval arg) cal))))
- (if ret
- ret
- "")
- ))
- ))
- format))
-
-(defun mime/start-external-method-region (beg end cal)
- (let ((e end))
- (if (< end (point-max))
- (setq e (+ end 1))
- )
- (save-excursion
- (save-restriction
- (narrow-to-region beg e)
- (goto-char beg)
- (let ((method (cdr (assoc 'method cal)))
- (name (mime/get-name cal))
- )
- (if method
- (let ((file (make-temp-name
- (expand-file-name "TM" mime/tmp-dir)))
- b args)
- (if (nth 1 method)
- (setq b beg)
- (search-forward "\n\n" nil t)
- (setq b (match-end 0))
- )
- (goto-char b)
- (write-region b e file)
- (setq cal (put-alist
- 'name (replace-as-filename name) cal))
- (setq cal (put-alist 'file file cal))
- (setq args (nconc
- (list (car method)
- mime/output-buffer-name (car method)
- )
- (mime/make-method-args cal (cdr (cdr method)))
- ))
- (apply (function start-process) args)
- (mime/show-output-buffer)
- ))))))
- )
-
-(defun mime/decode-message/partial-region (beg end cal)
- (goto-char beg)
- (let* ((root-dir (expand-file-name
- (concat "m-prts-" (user-login-name)) mime/tmp-dir))
- (id (cdr (assoc "id" cal)))
- (number (cdr (assoc "number" cal)))
- (total (cdr (assoc "total" cal)))
- (the-buf (current-buffer))
- file
- (mother mime/preview-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
- (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))
- (progn
- (switch-to-buffer the-buf)
- (throw 'tag nil)
- ))
- (insert-file-contents file)
- (goto-char (point-max))
- (setq i (+ i 1))
- )
- (delete-other-windows)
- (write-file (concat root-dir "/FULL"))
- (setq major-mode 'mime/show-message-mode)
- (mime/viewer-mode mother)
- (pop-to-buffer (current-buffer))
- ))
- )
- (progn
- (delete-other-windows)
- (find-file file)
- (setq major-mode 'mime/show-message-mode)
- (mime/viewer-mode mother)
- (pop-to-buffer (current-buffer))
- ))
- ))
-
-(defun mime/get-content-decoding-alist (al)
- (get-unified-alist mime/content-decoding-condition al)
- )
-
-(defun mime/decode-content-region (beg end)
- (interactive "*r")
- (let (ctl encoding)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (and (goto-char beg)
- (setq ctl (mime/Content-Type))
- (goto-char beg)
- (setq encoding (mime/Content-Transfer-Encoding "7bit"))
- )))
- (if ctl
- (let ((ctype (downcase (car ctl))) method cal ret)
- (setq ctl (cdr ctl))
- (setq cal (nconc (list (cons 'type ctype)
- (cons 'encoding encoding)
- (cons 'major-mode major-mode)
- )
- ctl))
- (if mime/body-decoding-mode
- (setq cal (cons
- (cons 'mode mime/body-decoding-mode)
- cal))
- )
- (setq ret (mime/get-content-decoding-alist cal))
- (setq method (cdr (assoc 'method ret)))
- (cond ((and (symbolp method)
- (fboundp method))
- (funcall method beg end ret)
- )
- ((and (listp method)(stringp (car method)))
- (mime/start-external-method-region beg end ret)
- )
- (t (mime/show-output-buffer
- "No method are specified for %s\n" ctype)
- ))
- ))
- ))
-
-(defun mime/show-output-buffer (&rest forms)
- (let ((the-buf (current-buffer)))
- (if (null (get-buffer-window mime/output-buffer-name))
- (split-window-vertically (/ (* (window-height) 3) 4))
- )
- (pop-to-buffer mime/output-buffer-name)
- (goto-char (point-max))
- (if forms
- (insert (apply (function format) forms))
- )
- (pop-to-buffer the-buf)
- ))
-
-
-;;; @ content filter
-;;;
-
-(defun mime/decode-text/plain (ctl)
- (interactive)
- (save-excursion
- (save-restriction
- (let ((charset (cdr (assoc "charset" (cdr ctl))))
- (encoding
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region (point-min)
- (or (and (search-forward "\n\n" nil t)
- (match-beginning 0))
- (point-max)))
- (goto-char (point-min))
- (mime/Content-Transfer-Encoding "7bit")
- )))
- (beg (point-min)) (end (point-max))
- )
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (setq beg (match-end 0))
- )
- (if (cond ((string= encoding "quoted-printable")
- (mime/Quoted-Printable-decode-region beg end)
- t)
- ((string= encoding "base64")
- (mime/Base64-decode-region beg end)
- t))
- (mime/code-convert-region-to-emacs beg (point-max) charset)
- )
- ))))
-
-