tinyrich.el

   1 ;;;
   2 ;;; $Id: tinyrich.el,v 5.0 1995/09/20 14:45:56 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 (defvar mime-viewer/face-list-for-text/enriched
   9   (cond ((and (>= emacs-major-version 19) window-system)
  10          '(bold italic fixed underline)
  11          )
  12         ((and (boundp 'NEMACS) NEMACS)
  13          '("bold" "italic" "underline")
  14          )))
  15
  16 (defun enriched-decode (beg end)
  17   (interactive "*r")
  18   (save-excursion
  19     (save-restriction
  20       (narrow-to-region beg end)
  21       (goto-char beg)
  22       (while (re-search-forward "[ \t]*\\(\n+\\)[ \t]*" nil t)
  23         (let ((str (buffer-substring (match-beginning 1)
  24                                      (match-end 1))))
  25           (if (string= str "\n")
  26               (replace-match " ")
  27             (replace-match (substring str 1))
  28             )))
  29       (goto-char beg)
  30       (let (cmd sym str (fb (point)) fe b e)
  31         (while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t)
  32           (setq b (match-beginning 0))
  33           (setq cmd (buffer-substring b (match-end 0)))
  34           (if (string= cmd "<<")
  35               (replace-match "<")
  36             (replace-match "")
  37             (setq cmd (downcase (substring cmd 1 (- (length cmd) 1))))
  38             )
  39           (setq sym (intern cmd))
  40           (cond ((eq sym 'param)
  41                  (setq b (point))
  42                  (save-excursion
  43                    (save-restriction
  44                      (if (search-forward "</param>" nil t)
  45                          (progn
  46                            (replace-match "")
  47                            (setq e (point))
  48                            )
  49                        (setq e end)
  50                        )))
  51                  (delete-region b e)
  52                  )
  53                 ((memq sym mime-viewer/face-list-for-text/enriched)
  54                  (setq b (point))
  55                  (save-excursion
  56                    (save-restriction
  57                      (if (re-search-forward (concat "</" cmd ">") nil t)
  58                          (progn
  59                            (replace-match "")
  60                            (setq e (point))
  61                            )
  62                        (setq e end)
  63                        )))
  64                  (tm:set-face-region b e sym)
  65                  )))
  66         (goto-char (point-max))
  67         (if (not (eq (preceding-char) ?\n))
  68             (insert "\n")
  69           )
  70         ))))
  71
  72
  73 ;;; @ text/richtext <-> text/enriched converter
  74 ;;;
  75
  76 (defun richtext-to-enriched-region (beg end)
  77   "Convert the region of text/richtext style to text/enriched style."
  78   (save-excursion
  79     (save-restriction
  80       (narrow-to-region beg end)
  81       (goto-char (point-min))
  82       (let (b e i)
  83         (while (re-search-forward "[ \t]*<comment>" nil t)
  84           (setq b (match-beginning 0))
  85           (delete-region b
  86                          (if (re-search-forward "</comment>[ \t]*" nil t)
  87                              (match-end 0)
  88                            (point-max)
  89                            ))
  90           )
  91         (goto-char (point-min))
  92         (while (re-search-forward "\n\n+" nil t)
  93           (replace-match "\n")
  94           )
  95         (goto-char (point-min))
  96         (while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t)
  97           (setq b (match-beginning 0))
  98           (setq e (match-end 0))
  99           (setq i 1)
 100           (while (looking-at "[ \t\n]*<nl>[ \t\n]*")
 101             (setq e (match-end 0))
 102             (setq i (1+ i))
 103             (goto-char e)
 104             )
 105           (delete-region b e)
 106           (while (>= i 0)
 107             (insert "\n")
 108             (setq i (1- i))
 109             ))
 110         (goto-char (point-min))
 111         (while (search-forward "<lt>" nil t)
 112           (replace-match "<<")
 113           )
 114         ))))
 115
 116 (defun enriched-to-richtext-region (beg end)
 117   "Convert the region of text/enriched style to text/richtext style."
 118   (save-excursion
 119     (save-restriction
 120       (goto-char beg)
 121       (and (search-forward "text/enriched")
 122            (replace-match "text/richtext"))
 123       (search-forward "\n\n")
 124       (narrow-to-region (match-end 0) end)
 125       (let (str n)
 126         (goto-char (point-min))
 127         (while (re-search-forward "\n\n+" nil t)
 128           (setq str (buffer-substring (match-beginning 0)
 129                                       (match-end 0)))
 130           (setq n (1- (length str)))
 131           (setq str "")
 132           (while (> n 0)
 133             (setq str (concat str "<nl>\n"))
 134             (setq n (1- n))
 135             )
 136           (replace-match str)
 137           )
 138         (goto-char (point-min))
 139         (while (search-forward "<<" nil t)
 140           (replace-match "<lt>")
 141           )
 142         ))))
 143
 144
 145 ;;; @ encoder and decoder
 146 ;;;
 147
 148 (defun richtext-decode (beg end)
 149   (save-restriction
 150     (narrow-to-region beg end)
 151     (richtext-to-enriched-region beg (point-max))
 152     (enriched-decode beg (point-max))
 153     ))
 154
 155 ;; (defun richtext-encode (beg end)
 156 ;;   (save-restriction
 157 ;;     (narrow-to-region beg end)
 158 ;;     (enriched-encode beg (point-max))
 159 ;;     (enriched-to-richtext-region beg (point-max))
 160 ;;     ))
 161
 162
 163 ;;; @ end
 164 ;;;
 165
 166 (require 'product)
 167 (product-provide (provide 'tinyrich) (require 'apel-ver))
 168
 169 ;; tinyrich.el ends here.