From c9f83ccae961d3a02a0f9e065d3f5f9d78eb90bd Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 2 Mar 1998 13:51:46 +0000 Subject: [PATCH] tm 5.15 --- Makefile | 2 +- tiny-mime.el | 13 +++---- tl-list.el | 9 ++++- tm-mule.el | 19 ++++++++-- tm-nemacs.el | 10 +++++- tm-orig.el | 6 +++- tm-rich.el | 48 +++++++++++++++---------- tm-view.el | 114 +++++++++++++++++++++++++++++++++++++--------------------- 8 files changed, 150 insertions(+), 71 deletions(-) diff --git a/Makefile b/Makefile index 4c2acd4..59f6155 100644 --- a/Makefile +++ b/Makefile @@ -8,7 +8,7 @@ GOMI = $(UTILS) FILES = README.eng Makefile *.el *.c methods \ doc/Makefile doc/*.pln doc/*.ol doc/*.tex -TARFILE = tm5.13.tar +TARFILE = tm5.15.tar all: $(UTILS) $(DVI) diff --git a/tiny-mime.el b/tiny-mime.el index a9b983f..bf2c518 100644 --- a/tiny-mime.el +++ b/tiny-mime.el @@ -21,7 +21,7 @@ ;;; @ version ;;; (defconst mime/RCS-ID - "$Id: tiny-mime.el,v 5.3 1994/10/25 11:51:05 morioka Exp $") + "$Id: tiny-mime.el,v 5.4 1994/10/26 14:45:53 morioka Exp $") (defconst mime/tiny-mime-version (get-version-string mime/RCS-ID)) @@ -43,12 +43,13 @@ (defconst mime/Base64-encoding-and-encoded-text-regexp (concat "\\(B\\)\\?" mime/Base64-encoded-text-regexp)) -(defconst mime/Quoted-Printable-hex-char "[0123456789ABCDEF]") +(defconst mime/Quoted-Printable-hex-char-regexp "[0123456789ABCDEF]") +(defconst mime/Quoted-Printable-octet-regexp + (concat "=" + mime/Quoted-Printable-hex-char-regexp + mime/Quoted-Printable-hex-char-regexp)) (defconst mime/Quoted-Printable-encoded-text-regexp - (concat "\\([^=?_]\\|=" - mime/Quoted-Printable-hex-char - mime/Quoted-Printable-hex-char - "\\)+")) + (concat "\\([^=?_]\\|" mime/Quoted-Printable-octet-regexp "\\)+")) (defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp (concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp)) diff --git a/tl-list.el b/tl-list.el index 5353029..116b3db 100644 --- a/tl-list.el +++ b/tl-list.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tl-list.el,v 1.0 1994/09/15 20:42:29 morioka Exp $ +;;; $Id: tl-list.el,v 1.1 1994/10/26 15:55:34 morioka Exp $ ;;; (provide 'tl-list) @@ -64,7 +64,14 @@ return new alist whose car is the new pair and cdr is . ) alist)))) +(defun set-alist (sym item value) + (if (not (boundp sym)) + (set sym nil) + ) + (set sym (put-alist item value (eval sym))) + ) + ;;; @ field ;;; diff --git a/tm-mule.el b/tm-mule.el index 9f3b177..8f73ecb 100644 --- a/tm-mule.el +++ b/tm-mule.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-mule.el,v 5.0 1994/10/19 23:47:58 morioka Exp $ +;;; $Id: tm-mule.el,v 5.1 1994/10/26 14:43:57 morioka Exp $ ;;; (provide 'tm-mule) @@ -41,6 +41,7 @@ ("ISO-2022-CN" . *iso-2022-ss2-7*) ("ISO-2022-KR" . *iso-2022-kr*) ("EUC-KR" . *euc-kr*) + ("ISO-8859-1" . *ctext*) )) (defvar mime/charset-lc-alist @@ -134,7 +135,19 @@ (defun mime/decode-encoded-text (charset encoding str) (mime/convert-string-to-emacs charset - (cond ((string-match "^B$" encoding) (mime/base64-decode-string str)) - ((string-match "^Q$" encoding) (mime/Quoted-Printable-decode-string str)) + (cond ((string-match "^B$" encoding) + (mime/base64-decode-string str)) + ((string-match "^Q$" encoding) + (mime/Quoted-Printable-decode-string str)) (t (message "unknown encoding %s" encoding) str) ))) + + +(defun mime/code-convert-region-to-emacs (beg end charset) + (if (stringp charset) + (progn + (setq charset (upcase charset)) + (let ((ct (cdr (assoc charset mime/charset-coding-system-alist)))) + (if ct + (code-convert beg end ct *internal*) + ))))) diff --git a/tm-nemacs.el b/tm-nemacs.el index b072053..b95ec98 100644 --- a/tm-nemacs.el +++ b/tm-nemacs.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-nemacs.el,v 5.0 1994/10/19 23:49:23 morioka Exp $ +;;; $Id: tm-nemacs.el,v 5.1 1994/10/26 15:08:12 morioka Exp $ ;;; (provide 'tm-nemacs) @@ -54,3 +54,11 @@ ds (concat "=?" charset "?" encoding "?" str "?=")) )) + +(defun mime/code-convert-region-to-emacs (beg end charset) + (if (stringp charset) + (progn + (setq charset (upcase charset)) + (if (string= charset "ISO-2022-JP") + (convert-region-kanji-code beg end 2 3) + )))) diff --git a/tm-orig.el b/tm-orig.el index 56c27c6..16dd343 100644 --- a/tm-orig.el +++ b/tm-orig.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-orig.el,v 5.1 1994/10/20 00:43:09 morioka Exp $ +;;; $Id: tm-orig.el,v 5.2 1994/10/26 14:44:58 morioka Exp $ ;;; (provide 'tm-orig) @@ -48,3 +48,7 @@ )) (concat "=?" charset "?" encoding "?" str "?=") )) + + +(defun mime/code-convert-region-to-emacs (beg end charset) + ) diff --git a/tm-rich.el b/tm-rich.el index 33246d7..f91a763 100644 --- a/tm-rich.el +++ b/tm-rich.el @@ -1,27 +1,41 @@ ;;; -;;; $Id: tm-rich.el,v 1.1 1994/09/05 14:34:06 morioka Exp morioka $ +;;; $Id: tm-rich.el,v 1.2 1994/10/26 15:57:51 morioka Exp $ ;;; (provide 'tm-rich) (require 'tm-view) -(require 'assoc) -(require 'hilit19) +(if (and (>= (string-to-int emacs-version) 19) window-system) + (progn + (require 'hilit19) -(defun mime/get-text/enriched-face (str) - (let ((sym (intern str))) - (if (eq sym 'italic) - 'modeline - sym))) + (defun mime/set-face-region (b e face) + (let ((sym (intern face))) + (if (eq sym 'italic) + (setq sym 'modeline) + ) + (if (member sym (face-list)) + (progn + (hilit-unhighlight-region b e) + (hilit-region-set-face b e sym) + )) + )) + ) + (defun mime/set-face-region (beg end sym) + ) + ) +(defvar mime/text/enriched-face-list + '("bold" "italic" "fixed" "underline")) + (defun mime/decode-text/enriched-region (beg end) (interactive "*r") (save-excursion (save-restriction (narrow-to-region beg end) (goto-char beg) - (let (cmd sym (fb (point)) fe b e) + (let (cmd (fb (point)) fe b e) (while (re-search-forward "[ \t\n\r]*<[^<>\n\r \t]+>[ \t\n\r]*" nil t) (setq cmd (buffer-substring (match-beginning 0) (match-end 0))) @@ -30,13 +44,12 @@ (setq cmd (substring cmd (match-end 0))) (string-match ">[ \t\n\r]*$" cmd) (setq cmd (substring cmd 0 (match-beginning 0))) - (setq sym (mime/get-text/enriched-face cmd)) (cond ((string= cmd "nl") (fill-region fb (point) t) (insert "\n") (setq fb (point)) ) - ((member sym (face-list)) + ((member (downcase cmd) mime/text/enriched-face-list) (if (not (bolp)) (insert " ") ) @@ -52,13 +65,12 @@ ) (setq e end) ))) - (hilit-unhighlight-region b e) - (hilit-region-set-face b e sym) + (mime/set-face-region b e cmd) ))) (fill-region fb (point) t) )))) -(defun mime/decode-text/enriched-body () +(defun mime/decode-text/enriched (ctl) (interactive) (save-excursion (save-restriction @@ -71,8 +83,8 @@ )))) -(aput 'mime/content-filter-alist - "text/enriched" (function mime/decode-text/enriched-body)) +(set-alist 'mime/content-filter-alist + "text/enriched" (function mime/decode-text/enriched)) -(aput 'mime/content-filter-alist - "text/richtext" (function mime/decode-text/enriched-body)) +(set-alist 'mime/content-filter-alist + "text/richtext" (function mime/decode-text/enriched)) diff --git a/tm-view.el b/tm-view.el index 3b4e023..c9ef502 100644 --- a/tm-view.el +++ b/tm-view.el @@ -20,7 +20,7 @@ ;;; (defconst mime/viewer-RCS-ID - "$Id: tm-view.el,v 5.13 1994/10/19 15:26:16 morioka Exp $") + "$Id: tm-view.el,v 5.15 1994/10/26 16:02:22 morioka Exp $") (defconst mime/viewer-version (get-version-string mime/viewer-RCS-ID)) @@ -79,7 +79,8 @@ "-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 @@ -365,7 +366,7 @@ (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) @@ -464,43 +465,41 @@ ;;; @ 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)) + (while (re-search-forward "_" nil t) + (replace-match " ") + ) + (goto-char (point-min)) + (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t) + (replace-match + (mime/Quoted-Printable-decode-string + (buffer-substring (match-beginning 0)(match-end 0)) + )) + ) + ))) + +(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 @@ -674,6 +673,41 @@ )) +;;; @ 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 ;;; -- 1.7.10.4