1 ;;; richtext.el -- read and save files in text/richtext format
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Version: $Id: richtext.el,v 3.3 1996/11/28 19:26:19 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
79 (defun richtext-encode (from to)
80 (if enriched-verbose (message "Richtext: encoding document..."))
82 (narrow-to-region from to)
83 (delete-to-left-margin)
86 (format-replace-strings '(("<" . "<lt>")))
87 (format-insert-annotations
88 (format-annotate-region from (point-max) richtext-translations
89 'enriched-make-annotation enriched-ignore))
91 (insert (if (stringp enriched-initial-annotation)
92 richtext-initial-annotation
93 (funcall richtext-initial-annotation)))
94 (enriched-map-property-regions 'hard
98 (while (search-forward "\n" nil t)
99 (replace-match "<nl>\n")
102 (if enriched-verbose (message nil))
110 (defun richtext-next-annotation ()
111 "Find and return next text/richtext annotation.
112 Return value is \(begin end name positive-p), or nil if none was found."
114 (while (re-search-forward richtext-annotation-regexp nil t)
115 (let* ((beg0 (match-beginning 0))
117 (beg (match-beginning 1))
119 (name (downcase (buffer-substring
120 (match-beginning 3) (match-end 3))))
121 (pos (not (match-beginning 2)))
123 (cond ((equal name "lt")
124 (delete-region beg end)
128 ((equal name "comment")
130 (throw 'tag (list beg0 end name pos))
131 (throw 'tag (list beg end0 name pos))
135 (throw 'tag (list beg end name pos))
139 (defun richtext-decode (from to)
140 (if enriched-verbose (message "Richtext: decoding document..."))
143 (narrow-to-region from to)
145 (let ((file-width (enriched-get-file-width))
146 (use-hard-newlines t))
147 (enriched-remove-header)
150 (while (re-search-forward "\n\n+" nil t)
154 ;; Deal with newlines
156 (while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t)
158 (put-text-property (match-beginning 0) (point) 'hard t)
159 (put-text-property (match-beginning 0) (point) 'front-sticky nil)
162 ;; Translate annotations
163 (format-deannotate-region from (point-max) richtext-translations
164 'richtext-next-annotation)
167 (if (or (and file-width ; possible reasons not to fill:
168 (= file-width (enriched-text-width))) ; correct wd.
169 (null enriched-fill-after-visiting) ; never fill
170 (and (eq 'ask enriched-fill-after-visiting) ; asked & declined
171 (not (y-or-n-p "Re-fill for current display width? "))))
172 ;; Minimally, we have to insert indentation and justification.
173 (enriched-insert-indentation)
174 (if enriched-verbose (message "Filling paragraphs..."))
175 (fill-region (point-min) (point-max))))
176 (if enriched-verbose (message nil))
185 ;;; richtext.el ends here