richtext.el

   1 ;;;
   2 ;;; richtext.el -- read and save files in text/richtext format
   3 ;;;
   4 ;;; $Id: richtext.el,v 1.4 1995/07/15 17:58:36 morioka Exp $
   5 ;;;
   6
   7 (require 'tl-misc)
   8
   9 (if (or (< emacs-major-version 19)
  10         (and (= emacs-major-version 19)
  11              (< emacs-minor-version 29))
  12         )
  13     (require 'tinyrich)
  14   (require 'enriched)
  15   )
  16
  17
  18 ;;; @ text/richtext <-> text/enriched converter
  19 ;;;
  20
  21 (defun richtext-to-enriched-region (beg end)
  22   "Convert the region of text/richtext style to text/enriched style."
  23   (save-excursion
  24     (save-restriction
  25       (narrow-to-region beg end)
  26       (goto-char (point-min))
  27       (let (b e i)
  28         (while (re-search-forward "[ \t]*<comment>" nil t)
  29           (setq b (match-beginning 0))
  30           (delete-region b
  31                          (if (re-search-forward "</comment>[ \t]*" nil t)
  32                              (match-end 0)
  33                            (point-max)
  34                            ))
  35           )
  36         (goto-char (point-min))
  37         (while (re-search-forward "\n\n+" nil t)
  38           (replace-match "\n")
  39           )
  40         (goto-char (point-min))
  41         (while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t)
  42           (setq b (match-beginning 0))
  43           (setq e (match-end 0))
  44           (setq i 1)
  45           (while (looking-at "[ \t\n]*<nl>[ \t\n]*")
  46             (setq e (match-end 0))
  47             (setq i (1+ i))
  48             (goto-char e)
  49             )
  50           (delete-region b e)
  51           (while (>= i 0)
  52             (insert "\n")
  53             (setq i (1- i))
  54             ))
  55         (goto-char (point-min))
  56         (while (search-forward "<lt>" nil t)
  57           (replace-match "<<")
  58           )
  59         ))))
  60
  61 (defun enriched-to-richtext-region (beg end)
  62   "Convert the region of text/enriched style to text/richtext style."
  63   (save-excursion
  64     (save-restriction
  65       (goto-char beg)
  66       (and (search-forward "text/enriched")
  67            (replace-match "text/richtext"))
  68       (search-forward "\n\n")
  69       (narrow-to-region (match-end 0) end)
  70       (let (str n)
  71         (goto-char (point-min))
  72         (while (re-search-forward "\n\n+" nil t)
  73           (setq str (buffer-substring (match-beginning 0)
  74                                       (match-end 0)))
  75           (setq n (1- (length str)))
  76           (setq str "")
  77           (while (> n 0)
  78             (setq str (concat str "<nl>\n"))
  79             (setq n (1- n))
  80             )
  81           (replace-match str)
  82           )
  83         (goto-char (point-min))
  84         (while (search-forward "<<" nil t)
  85           (replace-match "<lt>")
  86           )
  87         ))))
  88
  89
  90 ;;; @ encoder and decoder
  91 ;;;
  92
  93 (defun richtext-decode (beg end)
  94   (save-restriction
  95     (narrow-to-region beg end)
  96     (richtext-to-enriched-region beg (point-max))
  97     (enriched-decode beg (point-max))
  98     ))
  99
 100 (defun richtext-encode (beg end)
 101   (save-restriction
 102     (narrow-to-region beg end)
 103     (enriched-encode beg (point-max))
 104     (enriched-to-richtext-region beg (point-max))
 105     ))
 106
 107
 108 ;;; @ setup
 109 ;;;
 110
 111 (set-alist 'format-alist
 112            'text/richtext
 113            '("Extended MIME text/richtext format."
 114              "Content-[Tt]ype:[ \t]*text/richtext"
 115              richtext-decode richtext-encode t enriched-mode))
 116
 117
 118 ;;; @ end
 119 ;;;
 120
 121 (provide 'richtext)