1;;; richtext.el -- read and save files in text/richtext format  -*- lexical-binding: t -*-
2
3;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
4
5;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6;; Created: 1995/7/15
7;; Version: $Id$
8;; Keywords: wp, faces, MIME, multimedia
9
10;; This file is not part of GNU Emacs yet.
11
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.
16
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.
21
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., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Code:
28
29(require 'enriched)
30
31
32;;; @ variables
33;;;
34
35(defconst richtext-initial-annotation
36  (lambda ()
37    (format "Content-Type: text/richtext\nText-Width: %d\n\n"
38	    fill-column))
39  "What to insert at the start of a text/richtext file.
40If this is a string, it is inserted.  If it is a list, it should be a lambda
41expression, which is evaluated to get the string to insert.")
42
43(defconst richtext-annotation-regexp
44  "[ \t\n]*\\(<\\(/\\)?\\([-A-za-z0-9]+\\)>\\)[ \t\n]*"
45  "Regular expression matching richtext annotations.")
46
47(defconst richtext-translations
48  '((face          (bold-italic "bold" "italic")
49		   (bold        "bold")
50		   (italic      "italic")
51		   (underline   "underline")
52		   (fixed       "fixed")
53		   (excerpt     "excerpt")
54		   (default     )
55		   (nil         enriched-encode-other-face))
56    (invisible     (t           "comment"))
57    (left-margin   (4           "indent"))
58    (right-margin  (4           "indentright"))
59    (justification (right       "flushright")
60		   (left        "flushleft")
61		   (full        "flushboth")
62		   (center      "center"))
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
69;		   (-2          "smaller"))
70)
71  "List of definitions of text/richtext annotations.
72See `format-annotate-region' and `format-deannotate-region' for the definition
73of this structure.")
74
75
76;;; @ encoder
77;;;
78
79;;;###autoload
80(defun richtext-encode (from to)
81  (if enriched-verbose (message "Richtext: encoding document..."))
82  (save-restriction
83    (narrow-to-region from to)
84    (delete-to-left-margin)
85    (unjustify-region)
86    (goto-char from)
87    (format-replace-strings '(("<" . "<lt>")))
88    (format-insert-annotations
89     (format-annotate-region from (point-max) richtext-translations
90			     'enriched-make-annotation enriched-ignore))
91    (goto-char from)
92    (insert (if (stringp enriched-initial-annotation)
93		richtext-initial-annotation
94	      (funcall richtext-initial-annotation)))
95    (enriched-map-property-regions 'hard
96      (lambda (_v b _e)
97	(goto-char b)
98	(if (eolp)
99	    (while (search-forward "\n" nil t)
100	      (replace-match "<nl>\n")
101	      )))
102      (point) nil)
103    (if enriched-verbose (message nil))
104    ;; Return new end.
105    (point-max)))
106
107
108;;; @ decoder
109;;;
110
111(defun richtext-next-annotation ()
112  "Find and return next text/richtext annotation.
113Return value is \(begin end name positive-p), or nil if none was found."
114  (catch 'tag
115    (while (re-search-forward richtext-annotation-regexp nil t)
116      (let* ((beg0 (match-beginning 0))
117	     (end0 (match-end 0))
118	     (beg  (match-beginning 1))
119	     (end  (match-end 1))
120	     (name (downcase (buffer-substring
121			      (match-beginning 3) (match-end 3))))
122	     (pos (not (match-beginning 2)))
123	     )
124	(cond ((equal name "lt")
125	       (delete-region beg end)
126	       (goto-char beg)
127	       (insert "<")
128	       )
129	      ((equal name "comment")
130	       (if pos
131		   (throw 'tag (list beg0 end name pos))
132		 (throw 'tag (list beg end0 name pos))
133		 )
134	       )
135	      (t
136	       (throw 'tag (list beg end name pos))
137	       ))
138	))))
139
140;;;###autoload
141(defun richtext-decode (from to)
142  (if enriched-verbose (message "Richtext: decoding document..."))
143  (save-excursion
144    (save-restriction
145      (narrow-to-region from to)
146      (goto-char from)
147      (let ((file-width (enriched-get-file-width))
148	    (use-hard-newlines t))
149	(enriched-remove-header)
150
151	(goto-char from)
152	(while (re-search-forward "\n\n+" nil t)
153	  (replace-match "\n")
154	  )
155
156	;; Deal with newlines
157	(goto-char from)
158	(while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t)
159	  (replace-match "\n")
160	  (put-text-property (match-beginning 0) (point) 'hard t)
161	  (put-text-property (match-beginning 0) (point) 'front-sticky nil)
162	  )
163
164	;; Translate annotations
165	(format-deannotate-region from (point-max) richtext-translations
166				  'richtext-next-annotation)
167
168	;; Fill paragraphs
169	(if (and file-width		; possible reasons not to fill:
170		 (= file-width fill-column)) ; 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))
176      (point-max))))
177
178
179;;; @ end
180;;;
181
182(require 'product)
183(product-provide (provide 'richtext) (require 'apel-ver))
184
185;;; richtext.el ends here
186