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