tm-rich.el

   1 ;;;
   2 ;;; $Id: tm-rich.el,v 1.1 1994/09/05 14:34:06 morioka Exp morioka $
   3 ;;;
   4
   5 (provide 'tm-rich)
   6
   7 (require 'tm-view)
   8 (require 'assoc)
   9 (require 'hilit19)
  10
  11
  12 (defun mime/get-text/enriched-face (str)
  13   (let ((sym (intern str)))
  14     (if (eq sym 'italic)
  15         'modeline
  16       sym)))
  17
  18 (defun mime/decode-text/enriched-region (beg end)
  19   (interactive "*r")
  20   (save-excursion
  21     (save-restriction
  22       (narrow-to-region beg end)
  23       (goto-char beg)
  24       (let (cmd sym (fb (point)) fe b e)
  25         (while (re-search-forward
  26                 "[ \t\n\r]*<[^<>\n\r \t]+>[ \t\n\r]*" nil t)
  27           (setq cmd (buffer-substring (match-beginning 0) (match-end 0)))
  28           (replace-match "")
  29           (string-match "^[ \t\n\r]*<" cmd)
  30           (setq cmd (substring cmd (match-end 0)))
  31           (string-match ">[ \t\n\r]*$" cmd)
  32           (setq cmd (substring cmd 0 (match-beginning 0)))
  33           (setq sym (mime/get-text/enriched-face cmd))
  34           (cond ((string= cmd "nl")
  35                  (fill-region fb (point) t)
  36                  (insert "\n")
  37                  (setq fb (point))
  38                  )
  39                 ((member sym (face-list))
  40                  (if (not (bolp))
  41                      (insert " ")
  42                    )
  43                  (setq b (point))
  44                  (save-excursion
  45                    (save-restriction
  46                      (if (re-search-forward (concat "[ \t\n\r]*</"
  47                                                     cmd ">[ \t\n\r]*")
  48                                             nil t)
  49                          (progn
  50                            (replace-match " ")
  51                            (setq e (- (point) 1))
  52                            )
  53                        (setq e end)
  54                        )))
  55                  (hilit-unhighlight-region b e)
  56                  (hilit-region-set-face b e sym)
  57                  )))
  58         (fill-region fb (point) t)
  59         ))))
  60
  61 (defun mime/decode-text/enriched-body ()
  62   (interactive)
  63   (save-excursion
  64     (save-restriction
  65       (let ((beg (point-min)) (end (point-max)))
  66         (goto-char (point-min))
  67         (if (search-forward "\n\n" nil t)
  68             (setq beg (match-end 0))
  69           )
  70         (mime/decode-text/enriched-region beg end)
  71         ))))
  72
  73
  74 (aput 'mime/content-filter-alist
  75       "text/enriched" (function mime/decode-text/enriched-body))
  76
  77 (aput 'mime/content-filter-alist
  78       "text/richtext" (function mime/decode-text/enriched-body))