tm-rich.el

   1 ;;;
   2 ;;; $Id: tm-rich.el,v 4.0 1995/03/12 14:31:58 morioka Exp $
   3 ;;;
   4 ;;;          by MORIOKA Tomohiko  <morioka@jaist.ac.jp>
   5 ;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp>
   6 ;;;
   7
   8 (provide 'tm-rich)
   9
  10 (require 'tm-view)
  11
  12
  13 (defvar mime/text/richtext-face-list
  14   '("bold" "italic" "fixed" "underline"))
  15
  16 (defvar mime/text/enriched-face-list
  17   '("bold" "italic" "fixed" "underline"))
  18
  19
  20 (cond ((and (>= (string-to-int emacs-version) 19) window-system)
  21        (require 'hilit19)
  22        (defun mime/set-face-region (b e face)
  23          (let ((sym (intern face)))
  24            (if (eq sym 'italic)
  25                (setq sym 'modeline)
  26              )
  27            (if (member sym (face-list))
  28                (progn
  29                  (hilit-unhighlight-region b e)
  30                  (hilit-region-set-face b e sym)
  31                  ))))
  32        )
  33       ((and (boundp 'NEMACS) NEMACS)
  34        (setq mime/available-face-list
  35              '("bold" "italic" "underline"))
  36        (setq mime/available-face-attribute-alist
  37              '(("bold"      . inversed-region)
  38                ("italic"    . underlined-region)
  39                ("underline" . underlined-region)
  40                ))
  41        (defun mime/set-face-region (beg end sym)
  42          (attribute-add-narrow-attribute
  43           (cdr (assoc sym mime/available-face-attribute-alist))
  44           beg end))
  45        )
  46       (t
  47        (setq mime/text/richtext-face-list
  48              nil)
  49        (defun mime/set-face-region (beg end sym)
  50          )
  51        ))
  52
  53
  54 ;;; @ text/richtext
  55 ;;;
  56
  57 (defun mime/decode-text/richtext-region (beg end)
  58   (interactive "*r")
  59   (save-excursion
  60     (save-restriction
  61       (narrow-to-region beg end)
  62       (while (search-forward "\n" nil t)
  63         (replace-match "")
  64         )
  65       (goto-char beg)
  66       (let (cmd str (fb (point)) fe b e)
  67         (while (re-search-forward "<[^<>\n\r \t]+>" nil t)
  68           (setq b (match-beginning 0))
  69           (setq cmd (buffer-substring (+ b 1)
  70                                       (- (match-end 0) 1)))
  71           (replace-match "")
  72           (cond ((string= cmd "nl")
  73                  (if (= fb b)
  74                      (insert "\n")
  75                    (fill-region fb b t)
  76                    )
  77                  (setq fb (point))
  78                  )
  79                 ((member (downcase cmd) mime/text/richtext-face-list)
  80                  (setq b (point))
  81                  (save-excursion
  82                    (save-restriction
  83                      (if (re-search-forward (concat "</" cmd ">") nil t)
  84                          (progn
  85                            (replace-match "")
  86                            (setq e (point))
  87                            )
  88                        (setq e end)
  89                        )))
  90                  (mime/set-face-region b e cmd)
  91                  )))
  92         (fill-region fb (point-max) t)
  93         (goto-char (point-max))
  94         (if (not (eq (preceding-char) ?\n))
  95             (insert "\n")
  96           )
  97         ))))
  98
  99 (defun mime-viewer/filter-text/richtext (&optional ctype params)
 100   (interactive)
 101   (save-excursion
 102     (save-restriction
 103       (let ((beg (point-min)) (end (point-max)))
 104         (goto-char (point-min))
 105         (if (search-forward "\n\n" nil t)
 106             (setq beg (match-end 0))
 107           )
 108         (mime/decode-text/richtext-region beg end)
 109         ))))
 110
 111
 112 ;;; @ text/enriched
 113 ;;;
 114
 115 (defun mime/decode-text/enriched-region (beg end)
 116   (interactive "*r")
 117   (save-excursion
 118     (save-restriction
 119       (narrow-to-region beg end)
 120       (while (re-search-forward "[\n]+" nil t)
 121         (let ((str (buffer-substring (match-beginning 0)
 122                                      (match-end 0))))
 123           (if (string= str "\n")
 124               (replace-match " ")
 125             (replace-match (substring str 1))
 126             )))
 127       (goto-char beg)
 128       (let (cmd str (fb (point)) fe b e)
 129         (while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t)
 130           (setq b (match-beginning 0))
 131           (setq cmd (buffer-substring b (match-end 0)))
 132           (if (string= cmd "<<")
 133               (replace-match "<")
 134             (replace-match "")
 135             (setq cmd (downcase (substring cmd 1 (- (length cmd) 1))))
 136             )
 137           (cond ((string= cmd "param")
 138                  (setq b (point))
 139                  (save-excursion
 140                    (save-restriction
 141                      (if (search-forward "</param>" nil t)
 142                          (progn
 143                            (replace-match "")
 144                            (setq e (point))
 145                            )
 146                        (setq e end)
 147                        )))
 148                  (delete-region b e)
 149                  )
 150                 ((member cmd mime/text/enriched-face-list)
 151                  (setq b (point))
 152                  (save-excursion
 153                    (save-restriction
 154                      (if (re-search-forward (concat "</" cmd ">") nil t)
 155                          (progn
 156                            (replace-match "")
 157                            (setq e (point))
 158                            )
 159                        (setq e end)
 160                        )))
 161                  (mime/set-face-region b e cmd)
 162                  )))
 163         (goto-char (point-max))
 164         (if (not (eq (preceding-char) ?\n))
 165             (insert "\n")
 166           )
 167         ))))
 168
 169 (defun mime-viewer/filter-text/enriched (&optional ctype params)
 170   (interactive)
 171   (save-excursion
 172     (save-restriction
 173       (let ((beg (point-min)) (end (point-max)))
 174         (goto-char (point-min))
 175         (if (search-forward "\n\n" nil t)
 176             (setq beg (match-end 0))
 177           )
 178         (mime/decode-text/enriched-region beg end)
 179         ))))
 180
 181
 182 ;;; @ setting
 183 ;;;
 184
 185 (set-alist 'mime-viewer/content-filter-alist
 186            "text/richtext" (function mime-viewer/filter-text/richtext))
 187
 188 (set-alist 'mime-viewer/content-filter-alist
 189            "text/enriched" (function mime-viewer/filter-text/enriched))