tm-rich.el

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