tinyrich.el

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