;;;
-;;; $Id: tm-rich.el,v 1.2 1994/10/26 15:57:51 morioka Exp $
+;;; $Id: tm-rich.el,v 6.0 1995/06/11 10:33:34 morioka Exp $
+;;;
+;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp>
;;;
(provide 'tm-rich)
(require 'tm-view)
-(if (and (>= (string-to-int emacs-version) 19) window-system)
- (progn
- (require 'hilit19)
-
- (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/richtext-face-list
+ '("bold" "italic" "fixed" "underline"))
(defvar mime/text/enriched-face-list
'("bold" "italic" "fixed" "underline"))
-
-(defun mime/decode-text/enriched-region (beg end)
+
+
+(cond ((and (>= (string-to-int emacs-version) 19) window-system)
+ (require 'hilit19)
+ (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)
+ ))))
+ )
+ ((and (boundp 'NEMACS) NEMACS)
+ (setq mime/available-face-list
+ '("bold" "italic" "underline"))
+ (setq mime/available-face-attribute-alist
+ '(("bold" . inversed-region)
+ ("italic" . underlined-region)
+ ("underline" . underlined-region)
+ ))
+ (defun mime/set-face-region (beg end sym)
+ (attribute-add-narrow-attribute
+ (cdr (assoc sym mime/available-face-attribute-alist))
+ beg end))
+ )
+ (t
+ (setq mime/text/richtext-face-list
+ nil)
+ (defun mime/set-face-region (beg end sym)
+ )
+ ))
+
+
+;;; @ text/richtext
+;;;
+
+(defun mime/decode-text/richtext-region (beg end)
(interactive "*r")
(save-excursion
(save-restriction
(narrow-to-region beg end)
+ (while (search-forward "\n" nil t)
+ (replace-match "")
+ )
(goto-char beg)
- (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)))
+ (let (cmd str (fb (point)) fe b e)
+ (while (re-search-forward "<[^<>\n\r \t]+>" nil t)
+ (setq b (match-beginning 0))
+ (setq cmd (buffer-substring (+ b 1)
+ (- (match-end 0) 1)))
(replace-match "")
- (string-match "^[ \t\n\r]*<" cmd)
- (setq cmd (substring cmd (match-end 0)))
- (string-match ">[ \t\n\r]*$" cmd)
- (setq cmd (substring cmd 0 (match-beginning 0)))
(cond ((string= cmd "nl")
- (fill-region fb (point) t)
- (insert "\n")
+ (if (= fb b)
+ (insert "\n")
+ (fill-region fb b t)
+ )
(setq fb (point))
)
- ((member (downcase cmd) mime/text/enriched-face-list)
- (if (not (bolp))
- (insert " ")
- )
+ ((member (downcase cmd) mime/text/richtext-face-list)
(setq b (point))
(save-excursion
(save-restriction
- (if (re-search-forward (concat "[ \t\n\r]*</"
- cmd ">[ \t\n\r]*")
- nil t)
+ (if (re-search-forward (concat "</" cmd ">") nil t)
(progn
- (replace-match " ")
- (setq e (- (point) 1))
+ (replace-match "")
+ (setq e (point))
)
(setq e end)
)))
(mime/set-face-region b e cmd)
)))
- (fill-region fb (point) t)
+ (fill-region fb (point-max) t)
+ (goto-char (point-max))
+ (if (not (eq (preceding-char) ?\n))
+ (insert "\n")
+ )
))))
-(defun mime/decode-text/enriched (ctl)
- (interactive)
+(defun mime-viewer/filter-text/richtext (ctype params encoding)
+ (let* ((mode mime::preview/original-major-mode)
+ (m (assq mode mime-viewer/code-converter-alist))
+ (charset (assoc "charset" params))
+ (beg (point-min))
+ )
+ (if (and m (fboundp (setq m (cdr m))))
+ (funcall m beg (point-max) charset encoding)
+ (mime-viewer/default-code-convert-region beg (point-max)
+ charset encoding)
+ )
+ (mime/decode-text/richtext-region beg (point-max))
+ ))
+
+
+;;; @ text/enriched
+;;;
+
+(defun mime/decode-text/enriched-region (beg end)
+ (interactive "*r")
(save-excursion
(save-restriction
- (let ((beg (point-min)) (end (point-max)))
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (setq beg (match-end 0))
+ (narrow-to-region beg end)
+ (while (re-search-forward "[\n]+" nil t)
+ (let ((str (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (if (string= str "\n")
+ (replace-match " ")
+ (replace-match (substring str 1))
+ )))
+ (goto-char beg)
+ (let (cmd str (fb (point)) fe b e)
+ (while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t)
+ (setq b (match-beginning 0))
+ (setq cmd (buffer-substring b (match-end 0)))
+ (if (string= cmd "<<")
+ (replace-match "<")
+ (replace-match "")
+ (setq cmd (downcase (substring cmd 1 (- (length cmd) 1))))
+ )
+ (cond ((string= cmd "param")
+ (setq b (point))
+ (save-excursion
+ (save-restriction
+ (if (search-forward "</param>" nil t)
+ (progn
+ (replace-match "")
+ (setq e (point))
+ )
+ (setq e end)
+ )))
+ (delete-region b e)
+ )
+ ((member cmd mime/text/enriched-face-list)
+ (setq b (point))
+ (save-excursion
+ (save-restriction
+ (if (re-search-forward (concat "</" cmd ">") nil t)
+ (progn
+ (replace-match "")
+ (setq e (point))
+ )
+ (setq e end)
+ )))
+ (mime/set-face-region b e cmd)
+ )))
+ (goto-char (point-max))
+ (if (not (eq (preceding-char) ?\n))
+ (insert "\n")
)
- (mime/decode-text/enriched-region beg end)
))))
+(defun mime-viewer/filter-text/enriched (ctype params encoding)
+ (let* ((mode mime::preview/original-major-mode)
+ (m (assq mode mime-viewer/code-converter-alist))
+ (charset (assoc "charset" params))
+ (beg (point-min))
+ )
+ (if (and m (fboundp (setq m (cdr m))))
+ (funcall m beg (point-max) charset encoding)
+ (mime/code-convert-region-to-emacs beg (point-max)
+ charset encoding)
+ )
+ (mime/decode-text/enriched-region beg (point-max))
+ ))
+
+
+;;; @ setting
+;;;
-(set-alist 'mime/content-filter-alist
- "text/enriched" (function mime/decode-text/enriched))
+(set-alist 'mime-viewer/content-filter-alist
+ "text/richtext" (function mime-viewer/filter-text/richtext))
-(set-alist 'mime/content-filter-alist
- "text/richtext" (function mime/decode-text/enriched))
+(set-alist 'mime-viewer/content-filter-alist
+ "text/enriched" (function mime-viewer/filter-text/enriched))
projects / elisp / tm.git / blobdiff