(iso-accents-accent-key): Check iso-accents-enable here.

[gnu-emacs] / lisp / enriched.el

diff --git a/lisp/enriched.el b/lisp/enriched.el
index 8a4d32501f26ad335f6c4fd273665b1babbafb31..b0618b3571c4e56a904c8d63df4c54b49fa48552 100644 (file)
--- a/lisp/enriched.el
+++ b/lisp/enriched.el
@@ -1,7 +1,7 @@
-;;; enriched.el -- read and save files in text/enriched format
-;; Copyright (c) 1994 Free Software Foundation
+;;; enriched.el --- read and save files in text/enriched format
+;; Copyright (c) 1994, 1995 Free Software Foundation, Inc.

 
 

-;; Author: Boris Goldowsky <boris@cs.rochester.edu>
+;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>

 ;; Keywords: wp, faces
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: wp, faces
 
 ;; This file is part of GNU Emacs.


@@ -52,10 +52,6 @@ This can be increased inside text by changing the 'right-margin text property.
 Measured in character widths.  If the screen is narrower than this, it is
 assumed to be 0.")
 
 Measured in character widths.  If the screen is narrower than this, it is
 assumed to be 0.")
 

-(defvar enriched-indent-increment 4
-  "*Number of columns to indent for an <Indent> annotation.
-Should agree with the definition of <Indent> in enriched-annotation-alist.") 
-

 (defvar enriched-fill-after-visiting t
   "If t, fills paragraphs when reading in enriched documents.
 If nil, only fills when you explicitly request it.  If the value is 'ask, then
 (defvar enriched-fill-after-visiting t
   "If t, fills paragraphs when reading in enriched documents.
 If nil, only fills when you explicitly request it.  If the value is 'ask, then


@@ -63,34 +59,6 @@ it will query you whether to fill.
 Filling is never done if the current text-width is the same as the value
 stored in the file.")
 
 Filling is never done if the current text-width is the same as the value
 stored in the file.")
 

-(defvar enriched-default-justification 'left
-  "*Method of justifying text not otherwise specified.
-Can be `left' `right' `both' `center' or `none'.")
-
-(defvar enriched-auto-save-interval 1000
-  "*`Auto-save-interval' to use for `enriched-mode'.
-Auto-saving enriched files is slow, so you may wish to have them happen less
-often.  You can set this to nil to only do auto-saves when you are not
-actively working.")
-
-;;Unimplemented:
-;(defvar enriched-aggressive-auto-fill t
-;  "*If t, try to keep things properly filled and justified always.
-;Set this to nil if you have a slow terminal or prefer to justify on request.
-;The difference between aggressive and non-aggressive is subtle right now, but
-;may become stronger in the future.")
-
-;; Unimplemented:
-; (defvar enriched-keep-ignored-items nil
-;   "*If t, keep track of codes that are not understood.
-; Otherwise they are deleted on reading the file, and not written out.")
-
-;;Unimplemented:
-;(defvar enriched-electric-indentation t
-;  "*If t, newlines and following indentation stick together.
-;Deleting a newline or any part of the indenation will delete the whole
-;stretch.")
-

 ;;;
 ;;; Set up faces & display table
 ;;;
 ;;;
 ;;; Set up faces & display table
 ;;;


@@ -111,46 +79,13 @@ actively working.")
     nil
   (make-face 'excerpt)
   (if window-system
     nil
   (make-face 'excerpt)
   (if window-system

-      (make-face-italic 'excerpt)))
+      (make-face-italic 'excerpt nil t)))

 
 

-;;; The following two faces should not appear on menu.
-(if (boundp 'facemenu-unlisted-faces)
-    (setq facemenu-unlisted-faces 
-         (append '(enriched-code-face enriched-indentation-face)
-                 facemenu-unlisted-faces)))
-
-(if (internal-find-face 'enriched-code-face)
-    nil
-  (make-face 'enriched-code-face)
-  (if window-system
-      (set-face-background 'enriched-code-face 
-                          (if (x-display-color-p)
-                              "LightSteelBlue"
-                            "gray35"))))
-
-(if (internal-find-face 'enriched-indentation-face)
-    nil
-  (make-face 'enriched-indentation-face)
-  (if window-system
-      (set-face-background 'enriched-indentation-face
-                          (if (x-display-color-p)
-                              "DarkSlateBlue" 
-                            "gray25"))))
-
-(defvar enriched-display-table (make-display-table))
+(defconst enriched-display-table (or (copy-sequence standard-display-table)
+                                    (make-display-table)))

 (aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-))
 
 (aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-))
 

-(defvar enriched-hard-newline
-  (let ((s "\n"))
-    (put-text-property 0 1 'hard-newline t s)
-    s)
-  "String used to indicate hard newline in a enriched buffer.
-This is a newline with the `hard-newline' property set.")
-
-(defvar enriched-show-codes nil "See the function of the same name")
-
-(defvar enriched-par-props '(left-margin right-margin justification 
-                                        front-sticky)
+(defconst enriched-par-props '(left-margin right-margin justification)

   "Text-properties that usually apply to whole paragraphs.
 These are set front-sticky everywhere except at hard newlines.")
 
   "Text-properties that usually apply to whole paragraphs.
 These are set front-sticky everywhere except at hard newlines.")
 


@@ -158,30 +93,21 @@ These are set front-sticky everywhere except at hard newlines.")
 ;;; Variables controlling the file format
 ;;;   (bidirectional)
 
 ;;; Variables controlling the file format
 ;;;   (bidirectional)
 

-(defvar enriched-initial-annotation
+(defconst enriched-initial-annotation

   (lambda ()
   (lambda ()

-    (format "<param>-*-enriched-*-width:%d
-</param>" (enriched-text-width)))
+    (format "Content-Type: text/enriched\nText-Width: %d\n\n"
+           (enriched-text-width)))

   "What to insert at the start of a text/enriched 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.")
 
   "What to insert at the start of a text/enriched 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.")
 

-(defvar enriched-annotation-format "<%s%s>"
+(defconst enriched-annotation-format "<%s%s>"

   "General format of enriched-text annotations.")
 
   "General format of enriched-text annotations.")
 

-(defvar enriched-annotation-regexp "<\\(/\\)?\\([-A-za-z0-9]+\\)>"
+(defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-za-z0-9]+\\)>"

   "Regular expression matching enriched-text annotations.")
 
   "Regular expression matching enriched-text annotations.")
 

-(defvar enriched-downcase-annotations t
-  "Set to t if case of annotations is irrelevant.
-In this case all annotations listed in enriched-annotation-list should be
-lowercase, and annotations read from files will be downcased before being
-compared to that list.")
-
-(defvar enriched-list-valued-properties '(face unknown)
-  "List of properties whose values can be lists.")
-
-(defvar enriched-annotation-alist
+(defconst enriched-translations

   '((face          (bold-italic "bold" "italic")
                   (bold        "bold")
                   (italic      "italic")
   '((face          (bold-italic "bold" "italic")
                   (bold        "bold")
                   (italic      "italic")


@@ -190,118 +116,36 @@ compared to that list.")
                   (excerpt     "excerpt")
                   (default     )
                   (nil         enriched-encode-other-face))
                   (excerpt     "excerpt")
                   (default     )
                   (nil         enriched-encode-other-face))

-    (hard-newline  (nil         enriched-encode-hard-newline))

     (left-margin   (4           "indent"))
     (right-margin  (4           "indentright"))
     (justification (none        "nofill")
                   (right       "flushright")
                   (left        "flushleft")
     (left-margin   (4           "indent"))
     (right-margin  (4           "indentright"))
     (justification (none        "nofill")
                   (right       "flushright")
                   (left        "flushleft")

-                  (both        "flushboth")
+                  (full        "flushboth")

                   (center      "center")) 
     (PARAMETER     (t           "param")) ; Argument of preceding annotation
     ;; 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"))
                   (center      "center")) 
     (PARAMETER     (t           "param")) ; Argument of preceding annotation
     ;; 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         enriched-encode-unknown)) ;anything else found
+    (unknown       (nil         format-annotate-value))

 ;   (font-size     (2           "bigger")       ; unimplemented
 ;                 (-2          "smaller"))
 )
   "List of definitions of text/enriched annotations.
 ;   (font-size     (2           "bigger")       ; unimplemented
 ;                 (-2          "smaller"))
 )
   "List of definitions of text/enriched annotations.

-Each element is a list whose car is a PROPERTY, and the following
-elements are VALUES of that property followed by zero or more ANNOTATIONS.
-Whenever the property takes on that value, each of the annotations
-will be inserted into the file.  Only the name of the annotation
-should be specified, it will be formatted by `enriched-make-annotation'.
-At the point that the property stops having that value, the matching
-negated annotation will be inserted (it may actually be closed earlier and
-reopened, if necessary, to keep proper nesting).
-
-Conversely, when annotations are read, they are searched for in this list, and
-the relevant text property is added to the buffer.  The first match found whose
-conditions are satisfied is used.  If enriched-downcase-annotations is true,
-then annotations in this list should be listed in lowercase, and annotations
-read from the file will be downcased.
-
-If the VALUE is numeric, then it is assumed that there is a single annotation
-and each occurrence of it increments the value of the property by that number.
-Thus, given the entry \(left-margin \(4 \"indent\")), `enriched-encode-region'
-will insert two <indent> annotations if the left margin changes from 4 to 12.
-
-If the VALUE is nil, then instead of annotations, a function should be
-specified.  This function is used as a default: it is called for all
-transitions not explicitly listed in the table.  The function is called with
-two arguments, the OLD and NEW values of the property.  It should return a
-list of annotations like `enriched-loc-annotations' does, or may directly
-modify the buffer.  Note that this only works for encoding; there must be some
-other way of decoding the annotations thus produced.
-
-[For future expansion:] If the VALUE is a list, then the property's value will
-be appended to the surrounding value of the property.
-
-For decoding, there are some special symbols that can be used in the
-\"property\" slot.  Annotations listed under the pseudo-property PARAMETER are
-considered to be arguments of the immediately surrounding annotation; the text
-between the opening and closing parameter annotations is deleted from the
-buffer but saved as a string.  The surrounding annotation should be listed
-under the pseudo-property FUNCTION.  Instead of inserting a text-property for
-this annotation, enriched-decode-buffer will call the function listed in the
-VALUE slot, with the first two arguments being the start and end locations and
-the rest of the arguments being any PARAMETERs found in that region.")
-
-;;; This is not needed for text/enriched format, since all annotations are in
-;;; a standard form:
-;(defvar enriched-special-annotations-alist nil
-;  "List of annotations not formatted in the usual way.
-;Each element has the form (ANNOTATION BEGIN END), where
-;ANNOTATION is the annotation's name, which is a symbol (normal
-;annotations are named with strings, special ones with symbols),
-;BEGIN is the literal string to insert as the opening annotation, and
-;END is the literal string to insert as the close.
-;This is used only for encoding.  Typically, each will have an entry in
-;enriched-decode-special-alist to deal with its decoding.")
-
-;;; Encoding variables
-
-(defvar enriched-encode-interesting-regexp "<"
-  "Regexp matching the start of something that may require encoding.
-All text-property changes are also considered \"interesting\".")
-
-(defvar enriched-encode-special-alist
-  '(("<" . (lambda () (insert-and-inherit "<"))))
-  "List of special operations for writing enriched files.
-Each element has the form \(STRING . FUNCTION).
-Whenever one of the strings \(including its properties, if any)
-is found, the corresponding function is called.
-Match data is available to the function.  
-See `enriched-decode-special-alist' for instructions on decoding special
-items.")
-
-(defvar enriched-ignored-ok
-  '(front-sticky rear-nonsticky)
-  "Properties that are not written into enriched files.
-Generally this list should only contain properties that just for enriched's
-internal purposes; other properties that cannot be recorded will generate
-a warning message to the user since information will be lost.")
-
-;;; Decoding variables
-
-(defvar enriched-decode-interesting-regexp "[<\n]"
-  "Regexp matching the start of something that may require decoding.")
+See `format-annotate-region' and `format-deannotate-region' for the definition
+of this structure.")

 
 

-(defvar enriched-decode-special-alist
-  '(("<<" . (lambda () (delete-char 1) (forward-char 1)))
-    ("\n\n" . enriched-decode-hard-newline))
-  "List of special operations for reading enriched files.
-Each element has the form \(STRING . FUNCTION).
-Whenever one of the strings is found, the corresponding function is called,
-with point at the beginning of the match and the match data is available to
-the function.  Should leave point where next search should start.")
+(defconst enriched-ignore
+  '(front-sticky rear-nonsticky hard)
+  "Properties that are OK to ignore when saving text/enriched files.
+Any property that is neither on this list nor dealt with by
+`enriched-translations' will generate a warning.")

 
 ;;; Internal variables
 
 (defvar enriched-mode nil
 
 ;;; Internal variables
 
 (defvar enriched-mode nil

-  "True if `enriched-mode' \(which see) is enabled.")
+  "True if `enriched-mode' is in use.")

 (make-variable-buffer-local 'enriched-mode)
 
 (if (not (assq 'enriched-mode minor-mode-alist))
 (make-variable-buffer-local 'enriched-mode)
 
 (if (not (assq 'enriched-mode minor-mode-alist))


@@ -320,143 +164,19 @@ them and their old values to `enriched-old-bindings'.")
 The value is a list of \(VAR VALUE VAR VALUE...).")
 (make-variable-buffer-local 'enriched-old-bindings)
 
 The value is a list of \(VAR VALUE VAR VALUE...).")
 (make-variable-buffer-local 'enriched-old-bindings)
 

-(defvar enriched-translated nil
-  "True if buffer has already been decoded.")
-(make-variable-buffer-local 'enriched-translated)
-

 (defvar enriched-text-width nil)
 (make-variable-buffer-local 'enriched-text-width)
 
 (defvar enriched-text-width nil)
 (make-variable-buffer-local 'enriched-text-width)
 

-(defvar enriched-ignored-list nil)
-
-(defvar enriched-open-ans nil)
-
-;;;
-;;; Functions defining the format of annotations
-;;;
-
-(defun enriched-make-annotation (name positive)
-  "Format an annotation called NAME.
-If POSITIVE is non-nil, this is the opening annotation, if nil, this is the
-matching close."
-;; Could be used for annotations not following standard form:
-;  (if (symbolp name)
-;      (if positive
-;        (elt (assq name enriched-special-annotations-alist) 1)
-;      (elt (assq name enriched-special-annotations-alist) 2))  )
-  (if (stringp name)
-      (format enriched-annotation-format (if positive "" "/") name)
-    ;; has parameters.
-    (if positive
-       (let ((item (car name))
-             (params (cdr name)))
-         (concat (format enriched-annotation-format "" item)
-                 (mapconcat (lambda (i) (concat "<param>" i "</param>"))
-                            params "")))
-      (format enriched-annotation-format "/" (car name)))))
-
-(defun enriched-annotation-name (a)
-  "Find the name of an ANNOTATION."
-  (save-match-data
-    (if (string-match enriched-annotation-regexp a)
-       (substring a (match-beginning 2) (match-end 2)))))
-
-(defun enriched-annotation-positive-p (a)
-  "Returns t if ANNOTATION is positive (open),
-or nil if it is a closing (negative) annotation."
-  (save-match-data
-    (and (string-match enriched-annotation-regexp a)
-        (not (match-beginning 1)))))
-
-(defun enriched-encode-unknown (old new)
-  "Deals with re-inserting unknown annotations."
-  (cons (if old (list old))
-       (if new (list new))))
-
-(defun enriched-encode-hard-newline (old new)
-  "Deal with encoding `hard-newline' property change."
-  ;; This makes a sequence of N hard newlines into N+1 duplicates of the first
-  ;; one- so all property changes are put off until after all the newlines.
-  (if (and new (enriched-justification))  ; no special processing inside NoFill
-      (let* ((length (skip-chars-forward "\n"))
-            (s (make-string length ?\n)))
-       (backward-delete-char (1- length))
-       (add-text-properties 0 length (text-properties-at (1- (point))) s)
-       (insert s)
-       (backward-char (+ length 1)))))
-
-(defun enriched-decode-hard-newline () 
-  "Deal with newlines while decoding file."
-  ;; We label double newlines as `hard' and single ones as soft even in NoFill
-  ;; regions; otherwise the paragraph functions would not do anything
-  ;; reasonable in NoFill regions.
-  (let ((nofill (equal "nofill" ; find out if we're in NoFill region
-                      (enriched-which-assoc 
-                       '("nofill" "flushleft" "flushright" "center" 
-                         "flushboth")
-                       enriched-open-ans)))
-       (n (skip-chars-forward "\n")))
-    (delete-char (- n))
-    (enriched-insert-hard-newline (if nofill n (1- n)))))
-
-(defun enriched-encode-other-face (old new)
-  "Generate annotations for random face change.
-One annotation each for foreground color, background color, italic, etc."
-  (cons (and old (enriched-face-ans old))
-       (and new (enriched-face-ans new))))
-           
-(defun enriched-face-ans (face)
-  "Return annotations specifying FACE."
-  (cond ((string-match "^fg:" (symbol-name face))
-        (list (list "x-color" (substring (symbol-name face) 3))))
-       ((string-match "^bg:" (symbol-name face))
-        (list (list "x-bg-color" (substring (symbol-name face) 3))))
-       ((let* ((fg (face-foreground face))
-               (bg (face-background face))
-               (props (face-font face t))
-               (ans (cdr (enriched-annotate-change 'face nil props))))
-          (if fg (enriched-push (list "x-color" fg) ans))
-          (if bg (enriched-push (list "x-bg-color" bg) ans))
-          ans))))
-
-(defun enriched-decode-foreground (from to color)
-  (let ((face (intern (concat "fg:" color))))
-    (or (and (fboundp 'facemenu-get-face) (facemenu-get-face face))
-       (progn (enriched-warn "Color \"%s\" not defined" color)
-              (if window-system
-                  (enriched-warn 
-         "    Try M-x set-face-foreground RET %s RET some-other-color" face))))
-    (list from to 'face face)))
-
-(defun enriched-decode-background (from to color)
-  (let ((face (intern (concat "bg:" color))))
-    (or (and (fboundp 'facemenu-get-face) (facemenu-get-face face))
-       (progn
-         (enriched-warn "Color \"%s\" not defined" color)
-         (if window-system
-             (enriched-warn
-         "    Try M-x set-face-background RET %s RET some-other-color" face))))
-    (list from to 'face face)))
-
-;;;
-;;; NOTE: Everything below this point is intended to be independent of the file
-;;; format, which is defined by the variables and functions above.
-;;;
-

 ;;;
 ;;; Define the mode
 ;;;
 
 ;;;
 ;;; Define the mode
 ;;;
 

-(defun enriched-mode (&optional arg notrans)
+;;;###autoload
+(defun enriched-mode (&optional arg)

   "Minor mode for editing text/enriched files.
 These are files with embedded formatting information in the MIME standard
 text/enriched format.
   "Minor mode for editing text/enriched files.
 These are files with embedded formatting information in the MIME standard
 text/enriched format.

-
-Turning the mode on or off interactively will query whether the buffer
-should be translated into or out of text/enriched format immediately.
-Noninteractively translation is done without query unless the optional
-second argument NO-TRANS is non-nil.  
-Turning mode on runs `enriched-mode-hooks'.
+Turning the mode on runs `enriched-mode-hooks'.

 
 More information about enriched-mode is available in the file 
 etc/enriched.doc  in the Emacs distribution directory.
 
 More information about enriched-mode is available in the file 
 etc/enriched.doc  in the Emacs distribution directory.


@@ -470,61 +190,43 @@ Commands:
               (and enriched-mode (null arg)))
           ;; Turn mode off
           (setq enriched-mode nil)
               (and enriched-mode (null arg)))
           ;; Turn mode off
           (setq enriched-mode nil)

-          (if (if (interactive-p)
-                  (y-or-n-p "Translate buffer into text/enriched format?")
-                (not notrans))
-              (progn (enriched-encode-region)
-                     (mapcar (lambda (x)
-                               (remove-text-properties 
-                                (point-min) (point-max)
-                                (list (if (consp x) (car x) x) nil)))
-                             (append enriched-ignored-ok
-                                     enriched-annotation-alist))
-                     (setq enriched-translated nil)))
+          (setq buffer-file-format (delq 'text/enriched buffer-file-format))

           ;; restore old variable values
           (while enriched-old-bindings
             (funcall 'set (car enriched-old-bindings)
                      (car (cdr enriched-old-bindings)))
           ;; restore old variable values
           (while enriched-old-bindings
             (funcall 'set (car enriched-old-bindings)
                      (car (cdr enriched-old-bindings)))

-            (setq enriched-old-bindings (cdr (cdr enriched-old-bindings))))
-          (remove-hook 'write-region-annotate-functions
-                       'enriched-annotate-function t)
-          (remove-hook 'after-change-functions 'enriched-nogrow-hook t))
-         (enriched-mode nil)           ; Mode already on; do nothing.
-         (t                            ; Turn mode on
-          ;; save old variable values before we change them.
-          (setq enriched-mode t
-                enriched-old-bindings 
-                (list 'indent-line-function indent-line-function
-                      'auto-fill-function   auto-fill-function
-                      'buffer-display-table buffer-display-table
-                      'fill-column          fill-column
-                      'auto-save-interval   auto-save-interval
-                      'sentence-end-double-space sentence-end-double-space))
-          (make-local-variable 'auto-fill-function)
-          (make-local-variable 'auto-save-interval)
-          (make-local-variable 'indent-line-function)
-          (make-local-variable 'sentence-end-double-space)
-          (setq buffer-display-table enriched-display-table
-                indent-line-function 'enriched-indent-line
-                auto-fill-function 'enriched-auto-fill-function
-                fill-column 0          ; always run auto-fill-function
-                auto-save-interval enriched-auto-save-interval
-                sentence-end-double-space nil) ; Weird in Center&FlushRight
-          ;; Add hooks
-          (add-hook 'write-region-annotate-functions 
-                    'enriched-annotate-function)
-          (add-hook 'after-change-functions 'enriched-nogrow-hook)
+            (setq enriched-old-bindings (cdr (cdr enriched-old-bindings)))))

 
 

-          (put-text-property (point-min) (point-max)
-                             'front-sticky enriched-par-props)
+         (enriched-mode nil)           ; Mode already on; do nothing.

 
 

-          (if (and (not enriched-translated)
-                   (if (interactive-p) 
-                       (y-or-n-p "Does buffer need to be translated now? ")
-                     (not notrans)))
-              (progn (enriched-decode-region)
-                     (setq enriched-translated t)))
-          (run-hooks 'enriched-mode-hooks)))
+         (t (setq enriched-mode t)     ; Turn mode on
+            (if (not (memq 'text/enriched buffer-file-format))
+                (setq buffer-file-format 
+                      (cons 'text/enriched buffer-file-format)))
+            ;; Save old variable values before we change them.
+            ;; These will be restored if we exit enriched-mode.
+            (setq enriched-old-bindings
+                  (list 'buffer-display-table buffer-display-table
+                        'indent-line-function indent-line-function
+                        'use-hard-newlines    use-hard-newlines
+                        'default-text-properties default-text-properties))
+            (make-local-variable 'indent-line-function)
+            (make-local-variable 'use-hard-newlines)
+            (make-local-variable 'default-text-properties)
+            (setq indent-line-function 'indent-to-left-margin
+                  buffer-display-table  enriched-display-table
+                  use-hard-newlines     t)
+            (let ((sticky (plist-get default-text-properties 'front-sticky))
+                  (p enriched-par-props))
+              (while p
+                (if (not (memq (car p) sticky))
+                    (setq sticky (cons (car p) sticky)))
+                (setq p (cdr p)))
+              (if sticky
+                  (setq default-text-properties
+                        (plist-put default-text-properties
+                                   'front-sticky sticky))))
+            (run-hooks 'enriched-mode-hooks)))

     (set-buffer-modified-p mod)
     (force-mode-line-update)))
 
     (set-buffer-modified-p mod)
     (force-mode-line-update)))
 


@@ -543,543 +245,19 @@ Commands:
          (cons (cons 'enriched-mode enriched-mode-map)
                minor-mode-map-alist)))
 
          (cons (cons 'enriched-mode enriched-mode-map)
                minor-mode-map-alist)))
 

-(define-key enriched-mode-map "\r" 'enriched-newline)
-(define-key enriched-mode-map "\n" 'enriched-newline)
-(define-key enriched-mode-map "\C-a" 'enriched-beginning-of-line)
-(define-key enriched-mode-map "\C-o" 'enriched-open-line)
-(define-key enriched-mode-map "\M-{" 'enriched-backward-paragraph)
-(define-key enriched-mode-map "\M-}" 'enriched-forward-paragraph)
-(define-key enriched-mode-map "\M-q" 'enriched-fill-paragraph)
-(define-key enriched-mode-map "\M-S" 'enriched-set-justification-center)
-(define-key enriched-mode-map "\C-x\t" 'enriched-change-left-margin)
-(define-key enriched-mode-map "\C-c\C-l" 'enriched-set-left-margin)
-(define-key enriched-mode-map "\C-c\C-r" 'enriched-set-right-margin)
-(define-key enriched-mode-map "\C-c\C-s" 'enriched-show-codes)
-(define-key enriched-mode-map "\M-j" 'enriched-justification-menu-map)
-
-;;; These extend the "Face" menu.
-(let ((menu (and window-system (car (where-is-internal facemenu-menu)))))
-  (if (null menu)
-      nil
-    (define-key enriched-mode-map 
-      (apply 'vector (append menu '(Sep-faces))) '("------"))
-    (define-key enriched-mode-map
-      (apply 'vector (append menu '(Justification)))
-      (cons "Justification" 'enriched-justification-menu-map))
-    (define-key enriched-mode-map 
-      (apply 'vector (append menu '(Indentation)))
-      (cons "Indentation" 'enriched-indentation-menu-map))))
-
-;;; The "Indentation" sub-menu:
-
-(defvar enriched-indentation-menu-map (make-sparse-keymap "Indentation")
-  "Submenu for indentation commands.")
-(defalias 'enriched-indentation-menu-map enriched-indentation-menu-map)
-
-(define-key enriched-indentation-menu-map [UnIndentRight]
-  (cons "UnIndentRight" 'enriched-unindent-right))
-(define-key enriched-indentation-menu-map [IndentRight]
-  (cons "IndentRight" 'enriched-indent-right))
-(define-key enriched-indentation-menu-map [Unindent]
-  (cons "UnIndent" 'enriched-unindent))
-(define-key enriched-indentation-menu-map [Indent]
-  (cons "Indent" ' enriched-indent))
-
-;;; The "Justification" sub-menu:
-(defvar enriched-justification-menu-map (make-sparse-keymap "Justification")
-  "Submenu for text justification commands.")
-(defalias 'enriched-justification-menu-map enriched-justification-menu-map)
-
-(define-key enriched-justification-menu-map [?c]
-  (cons "Center" 'enriched-set-justification-center))
-(define-key enriched-justification-menu-map [?b]  
-  (cons "Flush Both" 'enriched-set-justification-both))
-(define-key enriched-justification-menu-map [?r]  
-  (cons "Flush Right" 'enriched-set-justification-right))
-(define-key enriched-justification-menu-map [?l]  
-  (cons "Flush Left" 'enriched-set-justification-left))
-(define-key enriched-justification-menu-map [?u]  
-  (cons "Unfilled" 'enriched-set-nofill))
-
-;;; 
-;;; Interactive Functions
-;;;
-
-(defun enriched-newline (n)
-  "Insert N hard newlines.
-These are newlines that will not be affected by paragraph filling or
-justification; they are used for necessary line breaks or to separate
-paragraphs."
-  (interactive "*p")
-  (enriched-auto-fill-function)
-  (while (> n 0)
-    (enriched-insert-hard-newline 1)
-    (end-of-line 0)
-    (enriched-justify-line)
-    (beginning-of-line 2)
-    (setq n (1- n)))
-  (enriched-indent-line))
-
-(defun enriched-open-line (arg)
-  "Inserts a newline and leave point before it.
-With arg N, inserts N newlines.  Makes sure all lines are properly indented."
-  (interactive "*p")
-  (save-excursion
-    (enriched-newline arg))
-  (enriched-auto-fill-function)
-  (end-of-line))
-
-(defun enriched-beginning-of-line (&optional n)
-  "Move point to the beginning of the text part of the current line.
-This is after all indentation due to left-margin setting or center or right
-justification, but before any literal spaces or tabs used for indentation.
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "p")
-  (beginning-of-line n)
-;  (if (interactive-p) (enriched-justify-line))
-  (goto-char 
-   (or (text-property-any (point) (point-max) 'enriched-indentation nil)
-       (point-max))))
-
-(defun enriched-backward-paragraph (n)
-  "Move backward N paragraphs.
-Hard newlines are considered to be the only paragraph separators."
-  (interactive "p")
-  (enriched-forward-paragraph (- n)))
-
-(defun enriched-forward-paragraph (n)
-  "Move forward N paragraphs.
-Hard newlines are considered to be the only paragraph separators."
-  (interactive "p")
-  (if (> n 0)
-      (while (> n 0)
-       (skip-chars-forward " \t\n")
-       (enriched-end-of-paragraph)
-       (setq n (1- n)))
-    (while (< n 0)
-      (skip-chars-backward " \t\n")
-      (enriched-beginning-of-paragraph)
-      (setq n (1+ n)))
-    (enriched-beginning-of-line)))
-
-(defun enriched-fill-paragraph ()
-  "Make the current paragraph fit between its left and right margins."
-  (interactive)
-  (save-excursion
-    (enriched-fill-region-as-paragraph (enriched-beginning-of-paragraph)
-                                      (enriched-end-of-paragraph))))
-
-(defun enriched-indent (b e)
-  "Make the left margin of the region larger."
-  (interactive "r")
-  (enriched-change-left-margin b e enriched-indent-increment))
-
-(defun enriched-unindent (b e)
-  "Make the left margin of the region smaller."
-  (interactive "r")
-  (enriched-change-left-margin b e (- enriched-indent-increment)))
-
-(defun enriched-indent-right (b e)
-  "Make the right margin of the region larger."
-  (interactive "r")
-  (enriched-change-right-margin b e enriched-indent-increment))
-
-(defun enriched-unindent-right (b e)
-  "Make the right margin of the region smaller."
-  (interactive "r")
-  (enriched-change-right-margin b e (- enriched-indent-increment)))
-
-(defun enriched-set-nofill (b e)
-  "Disable automatic filling in the region.
-Actually applies to all lines ending in the region.
-If mark is not active, applies to the current line."
-  (interactive (enriched-region-pars))
-  (enriched-set-justification b e 'none))
-
-(defun enriched-set-justification-left (b e)
-  "Declare the region to be left-justified.
-This is usually the default, but see `enriched-default-justification'."
-  (interactive (enriched-region-pars))
-  (enriched-set-justification b e 'left))
-
-(defun enriched-set-justification-right (b e)
-  "Declare paragraphs in the region to be right-justified:
-Flush at the right margin and ragged on the left.
-If mark is not active, applies to the current paragraph."
-  (interactive (enriched-region-pars))
-  (enriched-set-justification b e 'right))
-
-(defun enriched-set-justification-both (b e)
-  "Declare the region to be fully justified.
-If mark is not active, applies to the current paragraph."
-  (interactive (enriched-region-pars))
-  (enriched-set-justification b e 'both))
-
-(defun enriched-set-justification-center (b e)
-  "Make each line in the region centered.
-If mark is not active, applies to the current paragraph."
-  (interactive (enriched-region-pars))
-  (enriched-set-justification b e 'center))
+(define-key enriched-mode-map "\C-a" 'beginning-of-line-text)
+(define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent)
+(define-key enriched-mode-map "\C-j" 'reindent-then-newline-and-indent)
+(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
+(define-key enriched-mode-map "\M-S" 'set-justification-center)
+(define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
+(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
+(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)

 
 ;;;
 
 ;;;

-;;; General list/stack manipulation
+;;; Some functions dealing with text-properties, especially indentation

 ;;;
 
 ;;;
 

-(defmacro enriched-push (item stack)
-  "Push ITEM onto STACK.
-STACK should be a symbol whose value is a list."
-  (` (setq (, stack) (cons (, item) (, stack)))))
-
-(defmacro enriched-pop (stack)
-  "Remove and return first item on STACK."
-  (` (let ((pop-item (car (, stack))))
-       (setq (, stack) (cdr (, stack)))
-       pop-item)))
-
-(defun enriched-delq1 (cons list)
-  "Remove the given CONS from LIST by side effect.
-Since CONS could be the first element of LIST, write
-`(setq foo (enriched-delq1 element foo))' to be sure of changing the value
-of `foo'."
-  (if (eq cons list)
-      (cdr list)
-    (let ((p list))
-      (while (not (eq (cdr p) cons))
-       (if (null p) (error "enriched-delq1: Attempt to delete a non-element"))
-       (setq p (cdr p)))
-      ;; Now (cdr p) is the cons to delete
-      (setcdr p (cdr cons))
-      list)))
-    
-(defun enriched-make-list-uniq (list)
-  "Destructively remove duplicates from LIST.
-Compares using `eq'."
-  (let ((l list))
-    (while l
-      (setq l (setcdr l (delq (car l) (cdr l)))))
-    list))
-
-(defun enriched-make-relatively-unique (a b)
-  "Delete common elements of lists A and B, return as pair.
-Compares using `equal'."
-  (let* ((acopy (copy-sequence a))
-        (bcopy (copy-sequence b))
-        (tail acopy))
-    (while tail
-      (let ((dup (member (car tail) bcopy))
-           (next (cdr tail)))
-       (if dup (setq acopy (enriched-delq1 tail acopy)
-                     bcopy (enriched-delq1 dup  bcopy)))
-       (setq tail next)))
-    (cons acopy bcopy)))
-
-(defun enriched-common-tail (a b)
-  "Given two lists that have a common tail, return it.
-Compares with `equal', and returns the part of A that is equal to the
-equivalent part of B.  If even the last items of the two are not equal,
-returns nil."
-  (let ((la (length a))
-       (lb (length b)))
-    ;; Make sure they are the same length
-    (while (> la lb)
-      (setq a (cdr a)
-           la (1- la)))
-    (while (> lb la)
-      (setq b (cdr b)
-           lb (1- lb))))
-  (while (not (equal a b))
-    (setq a (cdr a)
-         b (cdr b)))
-  a)
-
-(defun enriched-which-assoc (items list)
-  "Return which one of ITEMS occurs first as a car of an element of LIST."
-  (let (res)
-    (while list
-      (if (setq res (member (car (car list)) items))
-         (setq res (car res)
-               list nil)
-       (setq list (cdr list))))
-    res))
-       
-(defun enriched-reorder (items order)
-  "Arrange ITEMS to following partial ORDER.
-Elements of ITEMS equal to elements of ORDER will be rearranged to follow the
-ORDER.  Unmatched items will go last."
-  (if order
-      (let ((item (member (car order) items)))
-       (if item
-           (cons (car item) 
-                 (enriched-reorder (enriched-delq1 item items)
-                             (cdr order)))
-         (enriched-reorder items (cdr order))))
-    items))
-
-;;;
-;;; Utility functions
-;;;
-
-(defun enriched-get-face-attribute (attr face &optional frame)
-  "Get an attribute of a face or list of faces.
-ATTRIBUTE should be one of the functions `face-font' `face-foreground',
-`face-background', or `face-underline-p'.  FACE can be a face or a list of
-faces.  If optional argument FRAME is given, report on the face in that frame.
-If FRAME is t, report on the defaults for the face in new frames.  If FRAME is
-omitted or nil, use the selected frame."
-  (cond ((null face) nil)
-       ((or (symbolp face) (internal-facep face)) (funcall attr face frame))
-       ((funcall attr (car face) frame))
-       ((enriched-get-face-attribute attr (cdr face) frame))))
-
-(defun enriched-region-pars ()
-  "Return region expanded to begin and end at paragraph breaks.
-If the region is not active, this is just the current paragraph.
-A paragraph does not count as overlapping the region if only whitespace is
-overlapping.  Return value is a list of two numers, the beginning and end of
-the defined region."
-  (save-excursion
-    (let* ((b (progn (if mark-active (goto-char (region-beginning)))
-                    (enriched-beginning-of-paragraph)))
-          (e (progn (if mark-active (progn (goto-char (region-end))
-                                           (skip-chars-backward " \t\n" b)))
-                    (min (point-max)
-                         (1+ (enriched-end-of-paragraph))))))
-      (list b e))))
-
-(defun enriched-end-of-paragraph ()
-  "Move to the end of the current paragraph.
-Only hard newlines delimit paragraphs.  Returns point."
-  (interactive)
-  (if (not (bolp)) (backward-char 1))
-  (if (enriched-search-forward-with-props enriched-hard-newline nil 1)
-      (backward-char 1))
-  (point))
-
-(defun enriched-beginning-of-paragraph ()
-  "Move to beginning of the current paragraph.
-Only hard newlines delimit paragraphs.  Returns point."
-  (interactive)
-  (if (not (eolp)) (forward-char 1))
-  (if (enriched-search-backward-with-props enriched-hard-newline nil 1)
-      (forward-char 1))
-  (point))
-
-(defun enriched-overlays-overlapping (begin end &optional test)
-  "Return a list of the overlays which overlap the specified region.
-If optional arg TEST is given, it is called with each overlay as its
-argument, and only those for which it is true are returned."
-  (overlay-recenter begin)
-  (let ((res nil)
-       (overlays (cdr (overlay-lists)))) ; includes all ending after BEGIN
-    (while overlays
-      (if (and (< (overlay-start (car overlays)) end)
-              (or (not test)
-                  (funcall test (car overlays))))
-         (enriched-push (car overlays) res))
-      (setq overlays (cdr overlays)))
-    res))
-
-(defun enriched-show-codes (&rest which)
-  "Enable or disable highlighting of special regions.
-With argument null or `none', turns off highlighting.
-If argument is `newline', turns on display of hard newlines.
-If argument is `indent', highlights the automatic indentation at the beginning
-of each line.
-If argument is `margin', highlights all regions with non-standard margins."
-  (interactive
-   (list (intern (completing-read "Show which codes: "
-                                 '(("none") ("newline") ("indent") ("margin"))
-                                 nil t))))
-  (if (null which)
-      (setq enriched-show-codes nil)
-    (setq enriched-show-codes which))
-  ;; First delete current overlays
-  (let* ((ol (overlay-lists))
-        (overlays (append (car ol) (cdr ol))))
-    (while overlays
-      (if (eq (overlay-get (car overlays) 'face) 'enriched-code-face)
-         (delete-overlay (car overlays)))
-      (setq overlays (cdr overlays))))
-  ;; Now add new ones for each thing displayed.
-  (if (null which)
-      (message "Code display off."))
-  (while which
-    (cond ((eq (car which) 'margin)
-          (enriched-show-margin-codes))
-         ((eq (car which) 'indent)
-          (enriched-map-property-regions 'enriched-indentation
-            (lambda (v b e)
-              (if v (enriched-show-region-as-code b e 'indent)))))
-         ((eq (car which) 'newline)
-          (save-excursion
-            (goto-char (point-min))
-            (while (enriched-search-forward-with-props
-                    enriched-hard-newline nil t)
-              (enriched-show-region-as-code (match-beginning 0) (match-end 0)
-                                      'newline)))))
-    (setq which (cdr which))))
-  
-(defun enriched-show-margin-codes (&optional from to)
-  "Highlight regions with nonstandard left-margins.
-See `enriched-show-codes'."
-  (enriched-map-property-regions 'left-margin
-    (lambda (v b e)
-      (if (and v (> v 0))
-         (enriched-show-region-as-code b e 'margin)))
-    from to)
-  (enriched-map-property-regions 'right-margin
-    (lambda (v b e)
-      (if (and v (> v 0))
-         (enriched-show-region-as-code b e 'margin)))
-    from to))
-       
-(defun enriched-show-region-as-code (from to type)
-  "Display region between FROM and TO as a code if TYPE is displayed.
-Displays it only if TYPE is an element of `enriched-show-codes' or is t."
-  (if (or (eq t type) (memq type enriched-show-codes))
-      (let* ((old (enriched-overlays-overlapping 
-                  from to (lambda (o)
-                            (eq 'enriched-code-face 
-                                (overlay-get o 'face)))))
-            (new (if old (move-overlay (car old) from to)
-                   (make-overlay from to))))
-       (overlay-put new 'face 'enriched-code-face)
-       (overlay-put new 'front-nogrow t)
-       (if (eq type 'margin)
-           (overlay-put new 'rear-grow t))
-       (while (setq old (cdr old))
-         (delete-overlay (car old))))))
-
-(defun enriched-nogrow-hook (beg end old-length)
-  "Implement front-nogrow and rear-grow for overlays.
-Normally overlays have opposite inheritance properties than
-text-properties: they will expand to include text inserted at their
-beginning, but not text inserted at their end.  However, 
-if this function is an element of `after-change-functions', then
-overlays with a non-nil value of the `front-nogrow' property will not
-expand to include text that is inserted just in front of them, and
-overlays with a non-nil value of the `rear-grow' property will 
-expand to include text that is inserted just after them."
-  (if (not (zerop old-length))
-      nil ;; not an insertion
-    (let ((overlays (overlays-at end)) o)
-      (while overlays
-       (setq o (car overlays)
-             overlays (cdr overlays))
-       (if (and (overlay-get o 'front-nogrow)
-                (= beg (overlay-start o)))
-           (move-overlay o end (overlay-end o)))))
-    (let ((overlays (overlays-at (1- beg))) o)
-      (while overlays
-       (setq o (car overlays)
-             overlays (cdr overlays))
-       (if (and (overlay-get o 'rear-grow)
-                (= beg (overlay-end o)))
-           (move-overlay o (overlay-start o) end))))))
-
-(defun enriched-warn (&rest args)
-  "Display a warning message.
-Arguments are given to `format' and the result is displayed in a buffer."
-  (save-excursion
-    (let ((buf (current-buffer))
-         (line (1+ (count-lines 1 (point))))
-         (mark (point-marker)))
-      (pop-to-buffer (get-buffer-create "*Enriched Warnings*"))
-      (goto-char (point-max))
-      (insert 
-;       (format "%s:%d: " (if (boundp 'enriched-file) enriched-file
-;                         (buffer-file-name buf))
-;             line)
-       (apply (function format) args)
-       "\n")
-      (pop-to-buffer buf))))
-
-(defun enriched-looking-at-with-props (string)
-  "True if text at point is equal to STRING, including text props.
-This is a literal, not a regexp match.
-The buffer text must include all text properties that STRING has, in
-the same places, but it is allowed to have others that STRING lacks."
-  (let ((buffer-string (buffer-substring (point) (+ (point) (length string)))))
-    (and (string-equal string buffer-string)
-        (enriched-text-properties-include string buffer-string))))
-
-(defun enriched-search-forward-with-props
-  (string &optional bound noerror count)
-  "Search forward for STRING, including its text properties.
-Set point to end of occurrence found, and return point.
-The match found must include all text properties that STRING has, in
-the same places, but it is allowed to have others that STRING lacks.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.  nil is equivalent
-  to (point-max).
-Optional third argument, if t, means if fail just return nil (no error).
-  If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-See also the functions `match-beginning', `match-end' and `replace-match'."
-  (interactive "sSearch for: ")
-  (or bound (setq bound (point-max)))
-  (or count (setq count 1))
-  (let ((start (point))
-       (res t))
-    (while (and res (> count 0))
-      (while (and (setq res (search-forward string bound t))
-                 (not (enriched-text-properties-include
-                       string (buffer-substring (match-beginning 0)
-                                                (match-end 0))))))
-      (setq count (1- count)))
-    (cond (res)
-         ((eq noerror t) (goto-char start) nil)
-         (noerror (goto-char bound) nil)
-         (t (goto-char start)
-            (error "Search failed: %s" string)))))
-
-(defun enriched-search-backward-with-props 
-  (string &optional bound noerror count)
-  "Search backward for STRING, including its text properties.
-Set point to the beginning of occurrence found, and return point.
-The match found must include all text properties that STRING has, in
-the same places, but it is allowed to have others that STRING lacks.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not start before that position.  nil is equivalent
-  to (point-min).
-Optional third argument, if t, means if fail just return nil (no error).
-  If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-See also the functions `match-beginning', `match-end' and `replace-match'."
-  (interactive "sSearch for: ")
-  (or bound (setq bound (point-min)))
-  (or count (setq count 1))
-  (let ((start (point))
-       (res t))
-    (while (and res (> count 0))
-      (while (and (setq res (search-backward string bound t))
-                 (not (enriched-text-properties-include
-                       string (buffer-substring (match-beginning 0)
-                                                (match-end 0))))))
-      (setq count (1- count)))
-    (cond (res)
-         ((eq noerror t) (goto-char start) nil)
-         (noerror (goto-char bound) nil)
-         (t (goto-char start)
-            (error "Search failed: %s" string)))))
-
-(defun enriched-text-properties-include (a b)
-  "True if all of A's text-properties are also properties of B.
-They must match in property name, value, and position.  B must be at least as
-long as A, but comparison is done only up to the length of A."
-  (let ((loc (length a)))
-    (catch 'fail 
-      (while (>= loc 0)
-       (let ((plist (text-properties-at loc a)))
-         (while plist
-           (if (not (equal (car (cdr plist))
-                           (get-text-property loc (car plist) b)))
-               (throw 'fail nil))
-           (setq plist (cdr (cdr plist)))))
-       (setq loc (1- loc)))
-      t)))
-

 (defun enriched-map-property-regions (prop func &optional from to)
   "Apply a function to regions of the buffer based on a text property.
 For each contiguous region of the buffer for which the value of PROPERTY is
 (defun enriched-map-property-regions (prop func &optional from to)
   "Apply a function to regions of the buffer based on a text property.
 For each contiguous region of the buffer for which the value of PROPERTY is


@@ -1106,76 +284,19 @@ the region, and the START and END of each region."
 
 (put 'enriched-map-property-regions 'lisp-indent-hook 1)
 
 
 (put 'enriched-map-property-regions 'lisp-indent-hook 1)
 

-(defun enriched-insert-annotations (list &optional offset)
-  "Apply list of annotations to buffer as write-region would.
-Inserts each element of LIST of buffer annotations at its appropriate place.
-Use second arg OFFSET if the annotations' locations are not
-relative to the beginning of the buffer: annotations will be inserted
-at their location-OFFSET+1 \(ie, the offset is the character number of
-the first character in the buffer)."
-  (if (not offset) 
-      (setq offset 0)
-    (setq offset (1- offset)))
-  (let ((l (reverse list)))
-    (while l
-      (goto-char (- (car (car l)) offset))
-      (insert (cdr (car l)))
-      (setq l (cdr l)))))
-
-;;;
-;;; Indentation, Filling, Justification
-;;;
-
-(defun enriched-insert-hard-newline (n)
-  ;; internal function; use enriched-newline for most purposes.
-  (while (> n 0)
-    (insert-and-inherit ?\n)
-    (add-text-properties (1- (point)) (point) 
-                        (list 'hard-newline t 
-                              'rear-nonsticky '(hard-newline)
-                              'front-sticky nil))
-    (enriched-show-region-as-code (1- (point)) (point) 'newline)
-    (setq n (1- n))))
-
-(defun enriched-left-margin ()
-  "Return the left margin of this line.
-This is defined as the value of the text-property `left-margin' in
-effect at the first character of the line, or the value of the
-variable `left-margin' if this is nil, or 0."
-  (save-excursion
-    (beginning-of-line)
-    (or (get-text-property (point) 'left-margin) 0)))
-
-(defun enriched-fill-column (&optional pos)
-  "Return the fill-column in effect at POS or point.
-This is `enriched-text-width' minus the current `right-margin'
-text-property."
-  (- (enriched-text-width)
-     (or (get-text-property (or pos (point)) 'right-margin) 0)))
-
-(defun enriched-move-to-fill-column ()
-  "Move point to right margin of current line.
-For filling, the line should be broken before this point."
-  ;; Defn: The first point where (enriched-fill-column) <= (current-column)
-  (interactive)
-  (goto-char 
-   (catch 'found
-     (enriched-map-property-regions 'right-margin
-       (lambda (v b e)
-        (goto-char (1- e))
-        (if (<= (enriched-fill-column) (current-column))
-            (progn (move-to-column (enriched-fill-column))
-                   (throw 'found (point)))))
-       (progn (beginning-of-line) (point))
-       (progn (end-of-line) (point)))
-     (end-of-line)
-     (point))))
-
-(defun enriched-line-length ()
-  "Length of text part of current line."
+(defun enriched-insert-indentation (&optional from to)
+  "Indent and justify each line in the region."

   (save-excursion
   (save-excursion

-    (- (progn (end-of-line) (current-column))
-       (progn (enriched-beginning-of-line) (current-column)))))
+    (save-restriction
+      (if to (narrow-to-region (point-min) to))
+      (goto-char (or from (point-min)))
+      (if (not (bolp)) (forward-line 1))
+      (while (not (eobp))
+       (if (eolp)
+           nil ; skip blank lines
+         (indent-to (current-left-margin))
+         (justify-current-line t nil t))
+       (forward-line 1)))))

 
 (defun enriched-text-width ()
   "The width of unindented text in this window, in characters.
 
 (defun enriched-text-width ()
   "The width of unindented text in this window, in characters.


@@ -1187,699 +308,164 @@ This is the width of the window minus `enriched-default-right-margin'."
                  (- ww enriched-default-right-margin)
                ww)))))
 
                  (- ww enriched-default-right-margin)
                ww)))))
 

-(defun enriched-tag-indentation (from to)
-  "Define region to be indentation."
-  (add-text-properties from to '(enriched-indentation t
-                                rear-nonsticky (enriched-indentation))))
-
-(defun enriched-indent-line (&optional column)
-  "Line-indenting primitive for enriched-mode.
-By default, indents current line to `enriched-left-margin'.
-Optional arg COLUMN asks for indentation to that column, eg to indent a
-centered or flushright line."
-  (save-excursion
-    (beginning-of-line)
-    (or column (setq column (enriched-left-margin)))
-    (let ((bol (point)))
-      (if (not (get-text-property (point) 'enriched-indentation))
-         nil ; no current indentation
-       (goto-char (or (text-property-any (point) (point-max)
-                                         'enriched-indentation nil)
-                      (point)))
-       (if (> (current-column) column) ; too far right
-           (delete-region bol (point))))
-      (indent-to column)
-      (if (= bol (point))
-         nil
-       ;; Indentation gets same properties as first real char.
-       (set-text-properties bol (point) (text-properties-at (point)))
-       (enriched-show-region-as-code bol (point) 'indent)
-       (enriched-tag-indentation bol (point))))))
-
-(defun enriched-insert-indentation (&optional from to)
-  "Indent and justify each line in the region."
-  (save-excursion
-    (save-restriction
-      (if to (narrow-to-region (point-min) to))
-      (goto-char (or from (point-min)))
-      (if (not (bolp)) (forward-line 1))
-      (while (not (eobp))
-       (enriched-justify-line)
-       (forward-line 1)))))
-
-(defun enriched-delete-indentation (&optional from to)
-  "Remove indentation and justification from region.
-Does not alter the left-margin and right-margin text properties, so the
-indentation can be reconstructed.  Tries only to remove whitespace that was
-added automatically, not spaces and tabs inserted by user."
-  (save-excursion
-    (save-restriction
-      (if to (narrow-to-region (point-min) to))
-      (if from
-         (progn (goto-char from)
-                (if (not (bolp)) (forward-line 1))
-                (setq from (point))))
-      ;; Remove everything that has the enriched-indentation text
-      ;; property set, unless it is not at the left margin.  In that case, the
-      ;; property must be there by mistake and should be removed.
-      (enriched-map-property-regions 'enriched-indentation
-       (lambda (v b e)
-         (if (null v)
-             nil
-           (goto-char b)
-           (if (bolp)
-               (delete-region b e)
-             (remove-text-properties b e '(enriched-indentation nil
-                                           rear-nonsticky nil)))))
-       from nil)
-      ;; Remove spaces added for FlushBoth.
-      (enriched-map-property-regions 'justification
-       (lambda (v b e)
-         (if (eq v 'both)
-             (enriched-squeeze-spaces b e)))
-       from nil))))
-
-(defun enriched-change-left-margin (from to inc)
-  "Adjust the left-margin property between FROM and TO by INCREMENT.
-If the given region includes the character at the left margin, it is extended
-to include the indentation too."
-  (interactive "*r\np")
-  (if (interactive-p) (setq inc (* inc enriched-indent-increment)))
-  (save-excursion
-    (let ((from (progn (goto-char from)
-                      (if (<= (current-column) (enriched-left-margin))
-                          (beginning-of-line))
-                      (point)))
-         (to   (progn (goto-char to)
-                      (point-marker)))
-         (inhibit-read-only t))
-      (enriched-delete-indentation from to)
-      (enriched-map-property-regions 'left-margin
-       (lambda (v b e)
-         (put-text-property b e 'left-margin
-                            (max 0 (+ inc (or v 0)))))
-       from to)
-      (enriched-fill-region from to)
-      (enriched-show-margin-codes from to))))
-
-(defun enriched-change-right-margin (from to inc)
-  "Adjust the right-margin property between FROM and TO by INCREMENT.
-If the given region includes the character at the left margin, it is extended
-to include the indentation too."
-  (interactive "r\np")
-  (if (interactive-p) (setq inc (* inc enriched-indent-increment)))
-  (save-excursion
-    (let ((inhibit-read-only t))
-      (enriched-map-property-regions 'right-margin
-       (lambda (v b e)
-         (put-text-property b e 'right-margin
-                            (max 0 (+ inc (or v 0)))))
-       from to)
-      (fill-region (progn (goto-char from)
-                         (enriched-beginning-of-paragraph))
-                  (progn (goto-char to)
-                         (enriched-end-of-paragraph)))
-      (enriched-show-margin-codes from to))))
-
-(defun enriched-set-left-margin (from to lm)
-  "Set the left margin of the region to WIDTH.
-If the given region includes the character at the left margin, it is extended
-to include the indentation too."
-  (interactive "r\nNSet left margin to column: ")
-  (if (interactive-p) (setq lm (prefix-numeric-value lm)))
-  (save-excursion
-    (let ((from (progn (goto-char from)
-                      (if (<= (current-column) (enriched-left-margin))
-                          (beginning-of-line))
-                      (point)))
-         (to   (progn (goto-char to)
-                      (point-marker)))
-         (inhibit-read-only t))
-      (enriched-delete-indentation from to)
-      (put-text-property from to 'left-margin lm)
-      (enriched-fill-region from to)
-      (enriched-show-region-as-code from to 'margin))))
-
-(defun enriched-set-right-margin (from to lm)
-  "Set the right margin of the region to WIDTH.
-The right margin is the space left between fill-column and
-`enriched-text-width'. 
-If the given region includes the leftmost character on a line, it is extended
-to include the indentation too."
-  (interactive "r\nNSet left margin to column: ")
-  (if (interactive-p) (setq lm (prefix-numeric-value lm)))
-  (save-excursion
-    (let ((from (progn (goto-char from)
-                      (if (<= (current-column) (enriched-left-margin))
-                          (end-of-line 0))
-                      (point)))
-         (to   (progn (goto-char to)
-                      (point-marker)))
-         (inhibit-read-only t))
-      (enriched-delete-indentation from to)
-      (put-text-property from to 'right-margin lm)
-      (enriched-fill-region from to)
-      (enriched-show-region-as-code from to 'margin))))
-
-(defun enriched-set-justification (b e val)
-  "Set justification of region to new value."
-  (save-restriction
-    (narrow-to-region (point-min) e)
-    (enriched-delete-indentation b (point-max))
-    (put-text-property b (point-max) 'justification val)
-    (enriched-fill-region b (point-max))))
-
-(defun enriched-justification ()
-  "How should we justify at point?
-This returns the value of the text-property `justification' or if that is nil,
-the value of `enriched-default-justification'.  However, it returns nil
-rather than `none' to mean \"don't justify\"."
-  (let ((j (or (get-text-property 
-               (if (and (eolp) (not (bolp))) (1- (point)) (point))
-               'justification)
-              enriched-default-justification)))
-    (if (eq 'none j)
-       nil
-      j)))
-
-(defun enriched-justify-line ()
-  "Indent and/or justify current line.
-Action depends on `justification' text property."
-  (let ((just (enriched-justification)))
-    (if (or (null just) (eq 'left just))
-       (enriched-indent-line)
-      (save-excursion
-       (let ((left-margin (enriched-left-margin))
-             (fill-column (enriched-fill-column))
-             (length      (enriched-line-length)))
-         (cond ((eq 'both just)
-                (enriched-indent-line left-margin)
-                (end-of-line)
-                (if (not (or (get-text-property (point) 'hard-newline)
-                             (= (current-column) fill-column)))
-                    (justify-current-line)))
-               ((eq 'center just)
-                (let* ((space (- fill-column left-margin)))
-                  (if (and (> length space) enriched-verbose)
-                      (enriched-warn "Line too long to center"))
-                  (enriched-indent-line 
-                   (+ left-margin (/ (- space length) 2)))))
-               ((eq 'right just)
-                (end-of-line)
-                (let* ((lmar (- fill-column length)))
-                  (if (and (< lmar 0) enriched-verbose)
-                      (enriched-warn "Line to long to justify"))
-                  (enriched-indent-line lmar)))))))))
-
-(defun enriched-squeeze-spaces (from to)
-  "Remove unnecessary spaces between words.
-This should only be used in FlushBoth regions; otherwise spaces are the
-property of the user and should not be tampered with."
-  (save-excursion
-    (goto-char from)
-    (let ((endmark (make-marker)))
-      (set-marker endmark to)
-      (while (re-search-forward "   *" endmark t)
-       (delete-region
-        (+ (match-beginning 0)
-           (if (save-excursion
-                 (skip-chars-backward " ]})\"'")
-                 (memq (preceding-char) '(?. ?? ?!)))
-               2 1))
-        (match-end 0))))))
-
-(defun enriched-fill-region (from to)
-  "Fill each paragraph in region.
-Whether or not filling or justification is done depends on the text properties
-in effect at each location."
-  (interactive "r")
-  (save-excursion
-    (goto-char to)
-    (let ((to (point-marker)))
-      (goto-char from)
-      (while (< (point) to)
-       (let ((begin (point)))
-         (enriched-end-of-paragraph)
-         (enriched-fill-region-as-paragraph begin (point)))
-       (if (not (eobp))
-           (forward-char 1))))))
-
-(defun enriched-fill-region-as-paragraph (from to)
-  "Make sure region is filled properly between margins.
-Whether or not filling or justification is done depends on the text properties
-in effect at each location."
-  (save-restriction
-    (narrow-to-region (point-min) to)
-    (goto-char from)
-    (let ((just (enriched-justification)))
-      (if (not just)
-         (while (not (eobp))
-           (enriched-indent-line)
-           (forward-line 1))
-       (enriched-delete-indentation from (point-max))
-       (enriched-indent-line)
-       ;; Following 3 lines taken from fill.el:
-       (while (re-search-forward "[.?!][])}\"']*$" nil t)
-         (insert-and-inherit ?\ ))
-       (subst-char-in-region from (point-max) ?\n ?\ )
-       ;; If we are full-justifying, we can commandeer all extra spaces.
-       ;; Remove them before filling.
-       (if (eq 'both just)
-           (enriched-squeeze-spaces from (point-max)))
-       ;; Now call on auto-fill for each different segment of the par.
-       (enriched-map-property-regions 'right-margin
-         (lambda (v b e)
-           (goto-char (1- e))
-           (enriched-auto-fill-function))
-         from (point-max))
-       (goto-char (point-max))
-       (enriched-justify-line)))))
-  
-(defun enriched-auto-fill-function ()
-  "If past `enriched-fill-column', break current line.
-Line so ended will be filled and justified, as appropriate."
-  (if (and (not enriched-mode) enriched-old-bindings)
-      ;; Mode was turned off improperly.
-      (progn (enriched-mode 0)
-            (funcall auto-fill-function))
-    ;; Necessary for FlushRight, etc:
-    (enriched-indent-line) ; standardize left margin
-    (let* ((fill-column (enriched-fill-column))
-          (lmar (save-excursion (enriched-beginning-of-line) (point)))
-          (rmar (save-excursion (end-of-line) (point)))
-          (justify (enriched-justification))
-          (give-up (not justify))) ; don't even start if in a NoFill region.
-      ;; remove inside spaces if FlushBoth
-      (if (eq justify 'both)
-         (enriched-squeeze-spaces lmar rmar))
-      (while (and (not give-up) (> (current-column) fill-column))
-       ;; Determine where to split the line.
-       (setq lmar (save-excursion (enriched-beginning-of-line) (point)))
-       (let ((fill-point 
-              (let ((opoint (point))
-                    bounce
-                    (first t))
-                (save-excursion
-                  (enriched-move-to-fill-column)
-                  ;; Move back to a word boundary.
-                  (while (or first
-                             ;; If this is after period and a single space,
-                             ;; move back once more--we don't want to break
-                             ;; the line there and make it look like a
-                             ;; sentence end.
-                             (and (not (bobp))
-                                  (not bounce)
-                                  sentence-end-double-space
-                                  (save-excursion (forward-char -1)
-                                                  (and (looking-at "\\. ")
-                                                       (not (looking-at "\\.  " ))))))
-                    (setq first nil)
-                    (skip-chars-backward "^ \t\n")
-                    ;; If we are not allowed to break here, move back to
-                    ;; somewhere that may be legal.  If no legal spots, this
-                    ;; will land us at bol.
-                    ;;(if (not (enriched-canbreak))
-                    ;; (goto-char (previous-single-property-change
-                    ;;      (point) 'justification nil lmar)))
-                    ;; If we find nowhere on the line to break it,
-                    ;; break after one word.  Set bounce to t
-                    ;; so we will not keep going in this while loop.
-                    (if (<= (point) lmar)
-                        (progn
-                          (re-search-forward "[ \t]" opoint t)
-                          ;;(while (and (re-search-forward "[ \t]" opoint t)
-                          ;; (not (enriched-canbreak))))
-                          (setq bounce t)))
-                    (skip-chars-backward " \t"))
-                  ;; Let fill-point be set to the place where we end up.
-                  (point)))))
-         ;; If that place is not the beginning of the line,
-         ;; break the line there.
-         (if                           ; and (enriched-canbreak)....
-             (save-excursion
-               (goto-char fill-point)
-               (not (bolp)))
-             (let ((prev-column (current-column)))
-               ;; If point is at the fill-point, do not `save-excursion'.
-               ;; Otherwise, if a comment prefix or fill-prefix is inserted,
-               ;; point will end up before it rather than after it.
-               (if (save-excursion
-                     (skip-chars-backward " \t")
-                     (= (point) fill-point))
-                   (progn
-                     (insert-and-inherit "\n")
-                     (delete-region (point) 
-                                    (progn (skip-chars-forward " ") (point)))
-                     (enriched-indent-line))
-                 (save-excursion
-                   (goto-char fill-point)
-                   (insert-and-inherit "\n")
-                   (delete-region (point) 
-                                  (progn (skip-chars-forward " ") (point)))
-                   (enriched-indent-line)))
-               ;; Now do proper sort of justification of the previous line
-               (save-excursion
-                 (end-of-line 0)
-                 (enriched-justify-line))
-               ;; If making the new line didn't reduce the hpos of
-               ;; the end of the line, then give up now;
-               ;; trying again will not help.
-               (if (>= (current-column) prev-column)
-                   (setq give-up t)))
-           ;; No place to break => stop trying.
-           (setq give-up t))))
-      ;; Check last line too ?
-      )))
-
-(defun enriched-aggressive-auto-fill-function ()
-  "Too slow."
-  (save-excursion
-    (enriched-fill-region (progn (beginning-of-line) (point))
-                         (enriched-end-of-paragraph))))
-

 ;;;
 ;;;

-;;; Writing Files
+;;; Encoding Files

 ;;;
 
 ;;;
 

-(defsubst enriched-open-annotation (name)
-  (insert-and-inherit (enriched-make-annotation name t)))
-
-(defsubst enriched-close-annotation (name)
-  (insert-and-inherit (enriched-make-annotation name nil)))
-
-(defun enriched-annotate-function (start end)
-  "For use on write-region-annotations-functions.
-Makes a new buffer containing the region in text/enriched format."
-  (if enriched-mode
-      (let (;(enriched-file (file-name-nondirectory buffer-file-name))
-           (copy-buf (generate-new-buffer "*Enriched Temp*")))
-       (copy-to-buffer copy-buf start end)
-       (set-buffer copy-buf)
-       (enriched-insert-annotations write-region-annotations-so-far start)
-       (setq write-region-annotations-so-far nil)
-       (enriched-encode-region)))
-  nil)
-
-(defun enriched-encode-region (&optional from to)
-  "Transform buffer into text/enriched format."
+;;;###autoload
+(defun enriched-encode (from to)

   (if enriched-verbose (message "Enriched: encoding document..."))
   (if enriched-verbose (message "Enriched: encoding document..."))

-  (setq enriched-ignored-list enriched-ignored-ok)
-  (save-excursion
-    (save-restriction
-      (if to (narrow-to-region (point-min) to))
-      (enriched-delete-indentation from to)
-      (let ((enriched-open-ans nil)
-           (inhibit-read-only t))
-       (goto-char (or from (point-min)))
-       (insert (if (stringp enriched-initial-annotation)
-                   enriched-initial-annotation
-                 (funcall enriched-initial-annotation)))
-       (while 
-           (let* ((ans (enriched-loc-annotations (point)))
-                  (neg-ans (enriched-reorder (car ans) enriched-open-ans))
-                  (pos-ans (cdr ans)))
-             ;; First do the negative (closing) annotations
-             (while neg-ans
-               (if (not (member (car neg-ans) enriched-open-ans))
-                   (enriched-warn "BUG DETECTED: Closing %s with open list=%s"
-                                  (enriched-pop neg-ans) enriched-open-ans)
-                 (while (not (equal (car neg-ans) (car enriched-open-ans)))
-                   ;; To close anno. N, need to first close ans 1 to N-1,
-                   ;; remembering to re-open them later.
-                   (enriched-push (car enriched-open-ans) pos-ans)
-                   (enriched-close-annotation (enriched-pop enriched-open-ans)))
-                 ;; Now we can safely close this anno & remove from open list 
-                 (enriched-close-annotation (enriched-pop neg-ans))
-                 (enriched-pop enriched-open-ans)))
-             ;; Now deal with positive (opening) annotations
-             (while pos-ans
-               (enriched-push (car pos-ans) enriched-open-ans)
-               (enriched-open-annotation (enriched-pop pos-ans)))
-             (enriched-move-to-next-property-change)))
-
-       ;; Close up shop...
-       (goto-char (point-max))
-       (while enriched-open-ans
-         (enriched-close-annotation (enriched-pop enriched-open-ans)))
-       (if (not (= ?\n (char-after (1- (point)))))
-           (insert ?\n)))
-    (if (and enriched-verbose (> (length enriched-ignored-list)
-                                (length enriched-ignored-ok)))
-       (let ((not-ok nil))
-         (while (not (eq enriched-ignored-list enriched-ignored-ok))
-           (setq not-ok (cons (car enriched-ignored-list) not-ok)
-                 enriched-ignored-list (cdr enriched-ignored-list)))
-         (enriched-warn "Not recorded: %s" not-ok)
-         (sit-for 1))))))
-
-(defun enriched-move-to-next-property-change ()
-  "Advance point to next prop change, dealing with special items on the way.
-Returns the location, or nil."
-  (let ((prop-change (next-property-change (point))))
-    (while (and (< (point) (or prop-change (point-max)))
-               (search-forward enriched-encode-interesting-regexp
-                               prop-change 1))
-      (goto-char (match-beginning 0))
-      (let ((specials enriched-encode-special-alist))
-       (while specials
-         (if (enriched-looking-at-with-props (car (car specials)))
-             (progn (goto-char (match-end 0))
-                    (funcall (cdr (car specials)))
-                    (setq specials nil))
-           (enriched-pop specials)))))
-    prop-change))
-
-(defun enriched-loc-annotations (loc)
-  "Return annotation(s) needed at LOCATION.
-This includes any properties that change between LOC-1 and LOC.
-If LOC is at the beginning of the buffer, will generate annotations for any
-non-nil properties there, plus the enriched-version annotation.
-   Annotations are returned as a list.  The car of the list is the list of
-names of the annotations to close, and the cdr is the list of the names of the
-annotations to open."
-  (let* ((prev-loc (1- loc))
-        (begin (< prev-loc (point-min)))
-        (before-plist (if begin nil (text-properties-at prev-loc)))
-        (after-plist (text-properties-at loc))
-        negatives positives prop props)
-    ;; make list of all property names involved
-    (while before-plist
-      (enriched-push (car before-plist) props)
-      (setq before-plist (cdr (cdr before-plist))))
-    (while after-plist
-      (enriched-push (car after-plist) props)
-      (setq after-plist (cdr (cdr after-plist))))
-    (setq props (enriched-make-list-uniq props))
-
-    (while props
-      (setq prop (enriched-pop props))
-      (if (memq prop enriched-ignored-list)
-         nil  ; If its been ignored before, ignore it now.
-       (let ((before (if begin nil (get-text-property prev-loc prop)))
-             (after (get-text-property loc prop)))
-         (if (equal before after)
-             nil ; no change; ignore
-           (let ((result (enriched-annotate-change prop before after)))
-             (setq negatives (nconc negatives (car result))
-                   positives (nconc positives (cdr result))))))))
-    (cons negatives positives)))
-
-(defun enriched-annotate-change (prop old new)
-  "Return annotations for PROPERTY changing from OLD to NEW.
-These are searched for in `enriched-annotation-list'.
-If NEW does not appear in the list, but there is a default function, then that
-function is called.
-Annotations are returned as a list, as in `enriched-loc-annotations'."
-  ;; If property is numeric, nil means 0
-  (if (or (consp old) (consp new))
-      (let* ((old (if (listp old) old (list old)))
-            (new (if (listp new) new (list new)))
-            (tail (enriched-common-tail old new))
-            close open)
-       (while old
-         (setq close 
-               (append (car (enriched-annotate-change prop (car old) nil))
-                       close)
-               old (cdr old)))
-       (while new
-         (setq open 
-               (append (cdr (enriched-annotate-change prop nil (car new)))
-                       open)
-               new (cdr new)))
-       (enriched-make-relatively-unique close open))
-    (cond ((and (numberp old) (null new))
-          (setq new 0))
-         ((and (numberp new) (null old))
-          (setq old 0)))
-    (let ((prop-alist (cdr (assoc prop enriched-annotation-alist)))
-         default)
-      (cond ((null prop-alist)         ; not found
-            (if (not (memq prop enriched-ignored-list))
-                (enriched-push prop enriched-ignored-list))
-            nil)
+  (save-restriction
+    (narrow-to-region from to)
+    (delete-to-left-margin)
+    (unjustify-region)
+    (goto-char from)
+    (format-replace-strings '(("<" . "<<")))
+    (format-insert-annotations 
+     (format-annotate-region from (point-max) enriched-translations
+                            'enriched-make-annotation enriched-ignore))
+    (goto-char from)
+    (insert (if (stringp enriched-initial-annotation)
+               enriched-initial-annotation
+             (funcall enriched-initial-annotation)))
+    (enriched-map-property-regions 'hard
+      (lambda (v b e)
+       (if (and v (= ?\n (char-after b)))
+           (progn (goto-char b) (insert "\n"))))
+      (point) nil)
+    (if enriched-verbose (message nil))
+    ;; Return new end.
+    (point-max)))

 
 

-           ;; Numerical values: use the difference
-           ((and (numberp old) (numberp new))
-            (let* ((entry (progn
-                            (while (and (car (car prop-alist))
-                                        (not (numberp (car (car prop-alist)))))
-                              (enriched-pop prop-alist))
-                            (car prop-alist)))
-                   (increment (car (car prop-alist)))
-                   (n (ceiling (/ (float (- new old)) (float increment))))
-                   (anno (car (cdr (car prop-alist)))))
-              (if (> n 0)
-                  (cons nil (make-list n anno))
-                (cons (make-list (- n) anno) nil))))
+(defun enriched-make-annotation (name positive)
+  "Format an annotation called NAME.
+If POSITIVE is non-nil, this is the opening annotation, if nil, this is the
+matching close."
+  (cond ((stringp name)
+        (format enriched-annotation-format (if positive "" "/") name))
+       ;; Otherwise it is an annotation with parameters, represented as a list
+       (positive
+        (let ((item (car name))
+              (params (cdr name)))
+          (concat (format enriched-annotation-format "" item)
+                  (mapconcat (lambda (i) (concat "<param>" i "</param>"))
+                             params ""))))
+       (t (format enriched-annotation-format "/" (car name)))))

 
 

-           ;; Standard annotation
-           (t (let ((close (and old (cdr (assoc old prop-alist))))
-                    (open  (and new (cdr (assoc new prop-alist)))))
-                (if (or close open)
-                    (enriched-make-relatively-unique close open)
-                  (let ((default (assoc nil prop-alist)))
-                    (if default
-                        (funcall (car (cdr default)) old new))))))))))
+(defun enriched-encode-other-face (old new)
+  "Generate annotations for random face change.
+One annotation each for foreground color, background color, italic, etc."
+  (cons (and old (enriched-face-ans old))
+       (and new (enriched-face-ans new))))
+           
+(defun enriched-face-ans (face)
+  "Return annotations specifying FACE."
+  (cond ((string-match "^fg:" (symbol-name face))
+        (list (list "x-color" (substring (symbol-name face) 3))))
+       ((string-match "^bg:" (symbol-name face))
+        (list (list "x-bg-color" (substring (symbol-name face) 3))))
+       ((let* ((fg (face-foreground face))
+               (bg (face-background face))
+               (props (face-font face t))
+               (ans (cdr (format-annotate-single-property-change
+                          'face nil props enriched-translations))))
+          (if fg (setq ans (cons (list "x-color" fg) ans)))
+          (if bg (setq ans (cons (list "x-bg-color" bg) ans)))
+          ans))))

 
 ;;;
 
 ;;;

-;;; Reading files
+;;; Decoding files

 ;;;
 
 ;;;
 

-(defun enriched-decode-region (&optional from to)
-  "Decode text/enriched buffer into text with properties.
-This is the primary entry point for decoding."
+;;;###autoload
+(defun enriched-decode (from to)

   (if enriched-verbose (message "Enriched: decoding document..."))
   (save-excursion
     (save-restriction
   (if enriched-verbose (message "Enriched: decoding document..."))
   (save-excursion
     (save-restriction

-      (if to (narrow-to-region (point-min) to))
-      (goto-char (or from (point-min)))
+      (narrow-to-region from to)
+      (goto-char from)

       (let ((file-width (enriched-get-file-width))
       (let ((file-width (enriched-get-file-width))

-           (inhibit-read-only t)
-           enriched-open-ans todo loc unknown-ans)
-
-       (while (enriched-move-to-next-annotation)
-         (let* ((loc (match-beginning 0))
-                (anno (buffer-substring (match-beginning 0) (match-end 0)))
-                (name (enriched-annotation-name anno))
-                (positive (enriched-annotation-positive-p anno)))
-
-           (if enriched-downcase-annotations
-               (setq name (downcase name)))
-
-           (delete-region (match-beginning 0) (match-end 0))
-           (if positive
-               (enriched-push (list name loc) enriched-open-ans)
-             ;; negative...
-             (let* ((top (car enriched-open-ans))
-                    (top-name (car top))
-                    (start (car (cdr top)))
-                    (params (cdr (cdr top)))
-                    (aalist enriched-annotation-alist)
-                    (matched nil))
-               (if (not (equal name top-name))
-                   (error (format "Improper nesting in file: %s != %s"
-                                  name top)))
-               (while aalist
-                 (let ((prop (car (car aalist)))
-                       (alist (cdr (car aalist))))
-                   (while alist
-                     (let ((value (car (car alist)))
-                           (ans (cdr (car alist))))
-                       (if (member name ans)
-                           ;; Check if multiple annotations are satisfied
-                           (if (member 'nil (mapcar 
-                                             (lambda (r)
-                                               (assoc r enriched-open-ans))
-                                             ans))
-                               nil     ; multiple ans not satisfied
-                             ;; Yes, we got it:
-                             (setq alist nil aalist nil matched t
-                                   enriched-open-ans (cdr enriched-open-ans))
-                             (cond 
-                              ((eq prop 'PARAMETER)
-                               ;; This is a parameter of the top open ann.
-                               (let ((nxt (enriched-pop enriched-open-ans)))
-                                 (if nxt
-                                     (enriched-push
-                                      (append 
-                                       nxt 
-                                       (list (buffer-substring start loc)))
-                                      enriched-open-ans))
-                                 (delete-region start loc)))
-                              ((eq prop 'FUNCTION)
-                               (let ((rtn (apply value start loc params)))
-                                 (if rtn (enriched-push rtn todo))))
-                              (t 
-                               ;; Normal property/value pair
-                               (enriched-push (list start loc prop value)
-                                              todo))))))
-                       (enriched-pop alist)))
-                 (enriched-pop aalist))
-               (if matched
-                   nil
-                 ;; Didn't find it
-                 (enriched-pop enriched-open-ans)
-                 (enriched-push (list start loc 'unknown name) todo)
-                 (enriched-push name unknown-ans))))))
-
-       ;; Now actually add the properties
-
-       (while todo
-         (let* ((item (enriched-pop todo))
-                (from (elt item 0))
-                (to   (elt item 1))
-                (prop (elt item 2))
-                (val  (elt item 3)))
-       
-;          (if (and (eq prop 'IGNORE)  ; 'IGNORE' pseudo-property was special
-;                   (eq val t))
-;              (delete-region from to))
-           (put-text-property 
-              from to prop
-              (cond ((numberp val)
-                     (+ val (or (get-text-property from prop) 0)))
-                    ((memq prop enriched-list-valued-properties)
-                     (let ((prev (get-text-property from prop)))
-                       (cons val (if (listp prev) prev (list prev)))))
-                    (t val)))))
-    
+           (use-hard-newlines t))
+       (enriched-remove-header)
+
+       ;; Deal with newlines
+       (goto-char from)
+       (while (search-forward-regexp "\n\n+" nil t)
+         (if (current-justification)
+             (delete-char -1))
+         (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) enriched-translations
+                                 'enriched-next-annotation)
+
+       ;; Fill paragraphs

        (if (or (and file-width         ; possible reasons not to fill:
        (if (or (and file-width         ; possible reasons not to fill:

-                    (= file-width (enriched-text-width)))  ; correct wd.
-               (null enriched-fill-after-visiting)         ; never fill
+                    (= file-width (enriched-text-width))) ; correct wd.
+               (null enriched-fill-after-visiting) ; never fill

                (and (eq 'ask enriched-fill-after-visiting) ; asked & declined
                (and (eq 'ask enriched-fill-after-visiting) ; asked & declined

-                    (not (y-or-n-p "Reformat for current display width? "))))
+                    (not (y-or-n-p "Re-fill for current display width? "))))

            ;; Minimally, we have to insert indentation and justification.
            (enriched-insert-indentation)
            ;; Minimally, we have to insert indentation and justification.
            (enriched-insert-indentation)

-         (sit-for 1)

          (if enriched-verbose (message "Filling paragraphs..."))
          (if enriched-verbose (message "Filling paragraphs..."))

-         (enriched-fill-region (point-min) (point-max))
-         (if enriched-verbose (message nil)))
-    
-       (if enriched-verbose 
-           (progn
-             (message nil)
-             (if unknown-ans
-                 (enriched-warn "Unknown annotations: %s" unknown-ans))))))))
+         (fill-region (point-min) (point-max))))
+      (if enriched-verbose (message nil))
+      (point-max))))
+
+(defun enriched-next-annotation ()
+  "Find and return next text/enriched annotation.
+Any \"<<\" strings encountered are converted to \"<\".
+Return value is \(begin end name positive-p), or nil if none was found."
+  (while (and (search-forward "<" nil 1)
+             (progn (goto-char (match-beginning 0))
+                    (not (looking-at enriched-annotation-regexp))))
+    (forward-char 1)
+    (if (= ?< (char-after (point)))
+       (delete-char 1)
+      ;; A single < that does not start an annotation is an error,
+      ;; which we note and then ignore.
+      (message (format "Warning: malformed annotation in file at %s" 
+                      (1- (point))))))
+  (if (not (eobp))
+      (let* ((beg (match-beginning 0))
+            (end (match-end 0))
+            (name (downcase (buffer-substring 
+                             (match-beginning 2) (match-end 2))))
+            (pos (not (match-beginning 1))))
+       (list beg end name pos))))

 
 (defun enriched-get-file-width ()
   "Look for file width information on this line."
   (save-excursion
 
 (defun enriched-get-file-width ()
   "Look for file width information on this line."
   (save-excursion

-    (if (search-forward "width:" (save-excursion (end-of-line) (point)) t)
+    (if (search-forward "Text-Width: " (+ (point) 1000) t)

        (read (current-buffer)))))
 
        (read (current-buffer)))))
 

-(defun enriched-move-to-next-annotation ()
-  "Advances point to next annotation, dealing with special items on the way.
-Returns t if one was found, otherwise nil."
-  (while (and (re-search-forward enriched-decode-interesting-regexp nil t)
-             (goto-char (match-beginning 0))
-             (not (looking-at enriched-annotation-regexp)))
-      (let ((regexps enriched-decode-special-alist))
-       (while (and regexps
-                   (not (looking-at (car (car regexps)))))
-         (enriched-pop regexps))
-       (if regexps
-           (funcall (cdr (car regexps)))
-         (forward-char 1)))) ; nothing found
-  (not (eobp)))
+(defun enriched-remove-header ()
+  "Remove file-format header at point."
+  (while (looking-at "^[-A-Za-z]+: .*\n")
+    (delete-region (point) (match-end 0)))
+  (if (looking-at "^\n")
+      (delete-char 1)))
+
+(defun enriched-decode-foreground (from to color)
+  (let ((face (intern (concat "fg:" color))))
+    (cond ((internal-find-face face))
+         ((and window-system (facemenu-get-face face)))
+         (window-system
+          (message "Warning: color \"%s\" is not defined." color))
+         ((make-face face)
+          (message "Warning: Color \"%s\" can't be displayed." color)))
+    (list from to 'face face)))
+
+(defun enriched-decode-background (from to color)
+  (let ((face (intern (concat "bg:" color))))
+    (cond ((internal-find-face face))
+         ((and window-system (facemenu-get-face face)))
+         (window-system
+          (message "Warning: color \"%s\" is not defined." color))
+         ((make-face face)
+          (message "Warning: Color \"%s\" can't be displayed." color)))
+    (list from to 'face face)))

 
 ;;; enriched.el ends here
 
 ;;; enriched.el ends here