2 ;;; richtext.el -- read and save files in text/richtext format
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1995 MORIOKA Tomohiko
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
10 ;;; $Id: richtext.el,v 3.0 1995/11/22 11:36:06 morioka Exp $
11 ;;; Keywords: wp, faces, MIME, multimedia
13 ;;; This file is part of GNU Emacs.
15 ;;; GNU Emacs is free software; you can redistribute it and/or modify
16 ;;; it under the terms of the GNU General Public License as published by
17 ;;; the Free Software Foundation; either version 2, or (at your option)
18 ;;; any later version.
20 ;;; GNU Emacs is distributed in the hope that it will be useful,
21 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;;; GNU General Public License for more details.
25 ;;; You should have received a copy of the GNU General Public License
26 ;;; along with GNU Emacs; see the file COPYING. If not, write to
27 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, 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) pc nc)
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))