tinyrich.el

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