(provide 'tm-view)
-;;; @ version
-;;;
-
-(defconst mime/viewer-RCS-ID
- "$Id: tm-view.el,v 5.9 1994/10/11 15:14:07 morioka Exp $")
-
-(defconst mime/viewer-version
- (and (string-match "[0-9][0-9.]*" mime/viewer-RCS-ID)
- (substring mime/viewer-RCS-ID (match-beginning 0)(match-end 0))
- ))
-
-
;;; @ require modules
;;;
(require 'tl-list)
(require 'tl-header)
(require 'tiny-mime)
+(require 'tm-misc)
+
+
+;;; @ version
+;;;
+
+(defconst mime/viewer-RCS-ID
+ "$Id: tm-view.el,v 5.19 1994/11/08 11:13:12 morioka Exp $")
+
+(defconst mime/viewer-version (get-version-string mime/viewer-RCS-ID))
;;; @ constants
(defconst mime/content-parameter-value-regexp
(concat "\\("
message/quoted-string-regexp
- "\\|[^; \t\n]\\)*"))
+ "\\|[^; \t\n]*\\)"))
(defconst mime/output-buffer-name "*MIME-out*")
(defconst mime/decoding-buffer-name "*MIME-decoding*")
"-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
))
-(defvar mime/content-filter-alist nil)
+(defvar mime/content-filter-alist
+ '(("text/plain" . mime/decode-text/plain)))
(defvar mime/make-content-subject-function
(function
)))
))
-(defvar mime/tmp-dir "/tmp/")
-
(defvar mime/use-internal-decoder nil)
(defvar mime/body-decoding-mode "play" "MIME body decoding mode")
)
(setq fcl (mime/make-flat-content-list cl))
(if (get-buffer obuf)
- (progn
- (switch-to-buffer obuf)
- (erase-buffer)
- ))
- (let ((r fcl) cell cid ctype beg end e nb ne subj dest)
+ (kill-buffer obuf)
+ )
+ (let ((r fcl) cell cid ctype beg end e nb ne subj dest str)
(while r
(setq cell (car r))
(setq beg (car cell))
(setq subj (mime/get-subject (cdr ctype)))
(let ((f (cdr (assoc (car ctype) mime/content-filter-alist))))
(if (and f (fboundp f))
- (funcall f)
+ (funcall f ctype)
))
(funcall mime/make-content-header-filter cid)
(goto-char nb)
;;; @ decoder
;;;
-(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/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
))
(defun mime/get-content-decoding-alist (al)
- (let ((r mime/content-decoding-condition) ret)
- (catch 'tag
- (while r
- (if (setq ret (nth 1 (assoc-unify (car r) al)))
- (throw 'tag ret)
- )
- (setq r (cdr r))
- ))))
+ (get-unified-alist mime/content-decoding-condition al)
+ )
(defun mime/decode-content-region (beg end)
(interactive "*r")
))
+;;; @ 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)
+ )
+ ))))
+
;;; @ MIME viewer mode
;;;
+(defvar mime/viewer-mode-map nil)
+(if (null mime/viewer-mode-map)
+ (progn
+ (setq mime/viewer-mode-map (make-keymap))
+ (suppress-keymap mime/viewer-mode-map)
+ (define-key mime/viewer-mode-map "u" 'mime/up-content)
+ (define-key mime/viewer-mode-map "p" 'mime/previous-content)
+ (define-key mime/viewer-mode-map "n" 'mime/next-content)
+ (define-key mime/viewer-mode-map " " 'mime/scroll-up-content)
+ (define-key mime/viewer-mode-map "\M- " 'mime/scroll-down-content)
+ (define-key mime/viewer-mode-map "\177" 'mime/scroll-down-content)
+ (define-key mime/viewer-mode-map "\C-m" 'mime/next-line-content)
+ (define-key mime/viewer-mode-map "\C-\M-m" 'mime/previous-line-content)
+ (define-key mime/viewer-mode-map "v" 'mime/play-content)
+ (define-key mime/viewer-mode-map "e" 'mime/extract-content)
+ (define-key mime/viewer-mode-map "\C-c\C-p" 'mime/print-content)
+ (define-key mime/viewer-mode-map "q" 'mime/quit-view-mode)
+ (define-key mime/viewer-mode-map "\C-c\C-x" 'mime/exit-view-mode)
+ ))
+
(defun mime/viewer-mode (&optional mother)
+ "Major mode for viewing MIME message.
+
+u Move to upper content
+p Move to previous content
+n Move to next content
+SPC Scroll up
+M-SPC Scroll down
+DEL Scroll down
+RET Move to next line
+M-RET Move to previous line
+v Decode the content as `play mode'
+e Decode the content as `extract mode'
+C-c C-p Decode the content as `print mode'
+q Quit
+"
(interactive)
(let ((buf (get-buffer mime/output-buffer-name))
(the-buf (current-buffer))
(switch-to-buffer (car ret))
(setq major-mode 'mime/viewer-mode)
(setq mode-name "MIME-View")
-
(make-variable-buffer-local 'mime/viewer-original-major-mode)
(setq mime/viewer-original-major-mode
(if mother
(setq mime/mother-buffer mother)
'mime/show-message-mode)
mode))
- (let ((keymap (current-local-map)))
- (if (null keymap)
- (setq keymap (make-sparse-keymap))
- (setq keymap (copy-keymap keymap))
- )
- (use-local-map keymap)
- (define-key keymap "u" 'mime/up-content)
- (define-key keymap "p" 'mime/previous-content)
- (define-key keymap "n" 'mime/next-content)
- (define-key keymap " " 'mime/scroll-up-content)
- (define-key keymap "\M- " 'mime/scroll-down-content)
- (define-key keymap "\177" 'mime/scroll-down-content)
- (define-key keymap "\C-m" 'mime/next-line-content)
- (define-key keymap "\C-\M-m" 'mime/previous-line-content)
- (define-key keymap "v" 'mime/play-content)
- (define-key keymap "e" 'mime/extract-content)
- (define-key keymap "\C-c\C-p" 'mime/print-content)
- (define-key keymap "\C-c\C-x" 'mime/exit-view-mode)
-
- (make-variable-buffer-local 'mime/preview-flat-content-list)
- (setq mime/preview-flat-content-list (nth 1 ret))
-
- (goto-char
- (let ((ce (nth 1 (car mime/preview-flat-content-list)))
- e)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (setq e (match-end 0))
- (if (<= e ce)
- e
- ce)))
- )))
+ (use-local-map mime/viewer-mode-map)
+ (make-variable-buffer-local 'mime/preview-flat-content-list)
+ (setq mime/preview-flat-content-list (nth 1 ret))
+ (goto-char
+ (let ((ce (nth 1 (car mime/preview-flat-content-list)))
+ e)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (setq e (match-end 0))
+ (if (<= e ce)
+ e
+ ce)))
+ (run-hooks 'mime/viewer-mode-hook)
+ ))
(defun mime/decode-content ()
(interactive)
(switch-to-buffer (nth 2 pc))
(setq cn (mime/get-point-content-number (nth 3 pc)))
(if (eq cn t)
- (if (setq r (assoc major-mode mime/go-to-top-node-method-alist))
- (progn
- (switch-to-buffer the-buf)
- (funcall (cdr r))
- ))
+ (mime/quit-view-mode the-buf (nth 2 pc))
(setq r (mime/get-content-region (butlast cn)))
(switch-to-buffer the-buf)
(catch 'tag
(mime/scroll-down-content 1)
)
+(defun mime/quit-view-mode (&optional the-buf buf)
+ (interactive)
+ (if (null the-buf)
+ (setq the-buf (current-buffer))
+ )
+ (if (null buf)
+ (setq buf (nth 2 (mime/get-point-preview-content (point))))
+ )
+ (let ((r (progn
+ (switch-to-buffer buf)
+ (assoc major-mode mime/go-to-top-node-method-alist)
+ )))
+ (if r
+ (progn
+ (switch-to-buffer the-buf)
+ (funcall (cdr r))
+ ))
+ ))
+
(defun mime/exit-view-mode ()
(interactive)
(kill-buffer (current-buffer))
projects / elisp / tm.git / blobdiff