Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: apel-3_4_4
Fetching contributors…

Cannot retrieve contributors at this time

file 184 lines (156 sloc) 5.621 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
;;; richtext.el -- read and save files in text/richtext format

;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.

;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1995/7/15
;; Version: $Id$
;; Keywords: wp, faces, MIME, multimedia

;; This file is not part of GNU Emacs yet.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(require 'enriched)


;;; @ variables
;;;

(defconst richtext-initial-annotation
  (lambda ()
    (format "Content-Type: text/richtext\nText-Width: %d\n\n"
(enriched-text-width)))
  "What to insert at the start of a text/richtext file.
If this is a string, it is inserted. If it is a list, it should be a lambda
expression, which is evaluated to get the string to insert.")

(defconst richtext-annotation-regexp
  "[ \t\n]*\\(<\\(/\\)?\\([-A-za-z0-9]+\\)>\\)[ \t\n]*"
  "Regular expression matching richtext annotations.")

(defconst richtext-translations
  '((face (bold-italic "bold" "italic")
(bold "bold")
(italic "italic")
(underline "underline")
(fixed "fixed")
(excerpt "excerpt")
(default )
(nil enriched-encode-other-face))
    (invisible (t "comment"))
    (left-margin (4 "indent"))
    (right-margin (4 "indentright"))
    (justification (right "flushright")
(left "flushleft")
(full "flushboth")
(center "center"))
    ;; The following are not part of the standard:
    (FUNCTION (enriched-decode-foreground "x-color")
(enriched-decode-background "x-bg-color"))
    (read-only (t "x-read-only"))
    (unknown (nil format-annotate-value))
; (font-size (2 "bigger") ; unimplemented
; (-2 "smaller"))
)
  "List of definitions of text/richtext annotations.
See `format-annotate-region' and `format-deannotate-region' for the definition
of this structure.")


;;; @ encoder
;;;

;;;###autoload
(defun richtext-encode (from to)
  (if enriched-verbose (message "Richtext: encoding document..."))
  (save-restriction
    (narrow-to-region from to)
    (delete-to-left-margin)
    (unjustify-region)
    (goto-char from)
    (format-replace-strings '(("<" . "<lt>")))
    (format-insert-annotations
     (format-annotate-region from (point-max) richtext-translations
'enriched-make-annotation enriched-ignore))
    (goto-char from)
    (insert (if (stringp enriched-initial-annotation)
richtext-initial-annotation
(funcall richtext-initial-annotation)))
    (enriched-map-property-regions 'hard
      (lambda (v b e)
(goto-char b)
(if (eolp)
(while (search-forward "\n" nil t)
(replace-match "<nl>\n")
)))
      (point) nil)
    (if enriched-verbose (message nil))
    ;; Return new end.
    (point-max)))


;;; @ decoder
;;;

(defun richtext-next-annotation ()
  "Find and return next text/richtext annotation.
Return value is \(begin end name positive-p), or nil if none was found."
  (catch 'tag
    (while (re-search-forward richtext-annotation-regexp nil t)
      (let* ((beg0 (match-beginning 0))
(end0 (match-end 0))
(beg (match-beginning 1))
(end (match-end 1))
(name (downcase (buffer-substring
(match-beginning 3) (match-end 3))))
(pos (not (match-beginning 2)))
)
(cond ((equal name "lt")
(delete-region beg end)
(goto-char beg)
(insert "<")
)
((equal name "comment")
(if pos
(throw 'tag (list beg0 end name pos))
(throw 'tag (list beg end0 name pos))
)
)
(t
(throw 'tag (list beg end name pos))
))
))))

;;;###autoload
(defun richtext-decode (from to)
  (if enriched-verbose (message "Richtext: decoding document..."))
  (save-excursion
    (save-restriction
      (narrow-to-region from to)
      (goto-char from)
      (let ((file-width (enriched-get-file-width))
(use-hard-newlines t))
(enriched-remove-header)

(goto-char from)
(while (re-search-forward "\n\n+" nil t)
(replace-match "\n")
)

;; Deal with newlines
(goto-char from)
(while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t)
(replace-match "\n")
(put-text-property (match-beginning 0) (point) 'hard t)
(put-text-property (match-beginning 0) (point) 'front-sticky nil)
)

;; Translate annotations
(format-deannotate-region from (point-max) richtext-translations
'richtext-next-annotation)

;; Fill paragraphs
(if (and file-width ; possible reasons not to fill:
(= file-width (enriched-text-width))) ; correct wd.
;; Minimally, we have to insert indentation and justification.
(enriched-insert-indentation)
(if enriched-verbose (message "Filling paragraphs..."))
(fill-region (point-min) (point-max))))
      (if enriched-verbose (message nil))
      (point-max))))


;;; @ end
;;;

(provide 'richtext)

;;; richtext.el ends here
Something went wrong with that request. Please try again.