tm-rich.el

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