1 ;;; richtext.el -- read and save files in text/richtext format
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Version: $Id: richtext.el,v 3.6 1997/06/28 17:58:34 morioka Exp $
8 ;; Keywords: wp, faces, MIME, multimedia
10 ;; This file is not part of GNU Emacs yet.
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
35 (defconst richtext-initial-annotation
37 (format "Content-Type: text/richtext\nText-Width: %d\n\n"
38 (enriched-text-width)))
39 "What to insert at the start of a text/richtext file.
40 If this is a string, it is inserted. If it is a list, it should be a lambda
41 expression, which is evaluated to get the string to insert.")
43 (defconst richtext-annotation-regexp
44 "[ \t\n]*\\(<\\(/\\)?\\([-A-za-z0-9]+\\)>\\)[ \t\n]*"
45 "Regular expression matching richtext annotations.")
47 (defconst richtext-translations
48 '((face (bold-italic "bold" "italic")
51 (underline "underline")
55 (nil enriched-encode-other-face))
56 (invisible (t "comment"))
57 (left-margin (4 "indent"))
58 (right-margin (4 "indentright"))
59 (justification (right "flushright")
63 ;; The following are not part of the standard:
64 (FUNCTION (enriched-decode-foreground "x-color")
65 (enriched-decode-background "x-bg-color"))
66 (read-only (t "x-read-only"))
67 (unknown (nil format-annotate-value))
68 ; (font-size (2 "bigger") ; unimplemented
71 "List of definitions of text/richtext annotations.
72 See `format-annotate-region' and `format-deannotate-region' for the definition
80 (defun richtext-encode (from to)
81 (if enriched-verbose (message "Richtext: encoding document..."))
83 (narrow-to-region from to)
84 (delete-to-left-margin)
87 (format-replace-strings '(("<" . "<lt>")))
88 (format-insert-annotations
89 (format-annotate-region from (point-max) richtext-translations
90 'enriched-make-annotation enriched-ignore))
92 (insert (if (stringp enriched-initial-annotation)
93 richtext-initial-annotation
94 (funcall richtext-initial-annotation)))
95 (enriched-map-property-regions 'hard
99 (while (search-forward "\n" nil t)
100 (replace-match "<nl>\n")
103 (if enriched-verbose (message nil))
111 (defun richtext-next-annotation ()
112 "Find and return next text/richtext annotation.
113 Return value is \(begin end name positive-p), or nil if none was found."
115 (while (re-search-forward richtext-annotation-regexp nil t)
116 (let* ((beg0 (match-beginning 0))
118 (beg (match-beginning 1))
120 (name (downcase (buffer-substring
121 (match-beginning 3) (match-end 3))))
122 (pos (not (match-beginning 2)))
124 (cond ((equal name "lt")
125 (delete-region beg end)
129 ((equal name "comment")
131 (throw 'tag (list beg0 end name pos))
132 (throw 'tag (list beg end0 name pos))
136 (throw 'tag (list beg end name pos))
141 (defun richtext-decode (from to)
142 (if enriched-verbose (message "Richtext: decoding document..."))
145 (narrow-to-region from to)
147 (let ((file-width (enriched-get-file-width))
148 (use-hard-newlines t))
149 (enriched-remove-header)
152 (while (re-search-forward "\n\n+" nil t)
156 ;; Deal with newlines
158 (while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t)
160 (put-text-property (match-beginning 0) (point) 'hard t)
161 (put-text-property (match-beginning 0) (point) 'front-sticky nil)
164 ;; Translate annotations
165 (format-deannotate-region from (point-max) richtext-translations
166 'richtext-next-annotation)
169 (if (and file-width ; possible reasons not to fill:
170 (= file-width (enriched-text-width))) ; correct wd.
171 ;; Minimally, we have to insert indentation and justification.
172 (enriched-insert-indentation)
173 (if enriched-verbose (message "Filling paragraphs..."))
174 (fill-region (point-min) (point-max))))
175 (if enriched-verbose (message nil))
184 ;;; richtext.el ends here