*** empty log message ***

[gnu-emacs] / lisp / enriched.el

diff --git a/lisp/enriched.el b/lisp/enriched.el
index dec6c66e4834625e22fef4fce1070209a0735be7..e74cb6b8ba75f056f3f9a80619f3bbdd1eed427c 100644 (file)
--- a/lisp/enriched.el
+++ b/lisp/enriched.el
@@ -1,6 +1,6 @@
 ;;; enriched.el --- read and save files in text/enriched format
 
-;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (c) 1994, 1995, 1996, 2002 Free Software Foundation, Inc.
 
 ;; Author: Boris Goldowsky <boris@gnu.org>
 ;; Keywords: wp, faces
@@ -310,20 +310,21 @@ the region, and the START and END of each region."
     ;; Return new end.
     (point-max)))
 
-(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))
+(defun enriched-make-annotation (internal-ann positive)
+  "Format an annotation INTERNAL-ANN.
+INTERNAL-ANN may be a string, for a flag, or a list of the form (PARAM VALUE).
+If POSITIVE is non-nil, this is the opening annotation;
+if nil, the matching close."
+  (cond ((stringp internal-ann)
+        (format enriched-annotation-format (if positive "" "/") internal-ann))
        ;; Otherwise it is an annotation with parameters, represented as a list
        (positive
-        (let ((item (car name))
-              (params (cdr name)))
+        (let ((item (car internal-ann))
+              (params (cdr internal-ann)))
           (concat (format enriched-annotation-format "" item)
                   (mapconcat (lambda (i) (concat "<param>" i "</param>"))
                              params ""))))
-       (t (format enriched-annotation-format "/" (car name)))))
+       (t (format enriched-annotation-format "/" (car internal-ann)))))
 
 (defun enriched-encode-other-face (old new)
   "Generate annotations for random face change.
@@ -340,12 +341,12 @@ which can be the value of the `face' text property."
         (list (list "x-color" (cdr face))))
        ((and (consp face) (eq (car face) 'background-color))
         (list (list "x-bg-color" (cdr face))))
+       ((and (listp face) (eq (car face) :foreground))
+        (list (list "x-color" (cadr face))))
+       ((and (listp face) (eq (car face) :background))
+        (list (list "x-bg-color" (cadr face))))
        ((listp face)
         (apply 'append (mapcar 'enriched-face-ans face)))
-       ((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-attribute face :foreground))
                (bg (face-attribute face :background))
                (props (face-font face t))
@@ -431,26 +432,16 @@ Return value is \(begin end name positive-p), or nil if none was found."
       (delete-char 1)))
 
 (defun enriched-decode-foreground (from to &optional color)
-  (let ((face (intern (concat "fg:" color))))
-    (cond ((null color)
-          (message "Warning: no color specified for <x-color>"))
-         ((facep face))
-         ((and (display-color-p) (facemenu-get-face face)))
-         ((make-face face)
-          (message "Warning: color `%s' can't be displayed" color)))
-    (list from to 'face face)))
+  (if color
+      (list from to 'face (list ':foreground color))
+    (message "Warning: no color specified for <x-color>")
+    nil))
 
 (defun enriched-decode-background (from to &optional color)
-  (let ((face (intern (concat "bg:" color))))
-    (cond ((null color)
-          (message "Warning: no color specified for <x-bg-color>"))
-         ((facep face))
-         ((and (display-color-p) (facemenu-get-face face)))
-         ((make-face face)
-          (message "Warning: color `%s' can't be displayed" color)))
-    (list from to 'face face)))
-
-
+  (if color
+      (list from to 'face (list ':background color))
+    (message "Warning: no color specified for <x-bg-color>")
+    nil))
 \f
 ;;; Handling the `display' property.
 
@@ -464,9 +455,8 @@ has the form `(ANNOTATION PARAM ...)'."
   (let ((annotation "x-display")
        (param (prin1-to-string (or old new))))
     (if (null old)
-       (list nil (list annotation param))
-      (list (list annotation param)))))
-
+        (cons nil (list (list annotation param)))
+      (cons (list (list annotation param)) nil))))
 
 (defun enriched-decode-display-prop (start end &optional param)
   "Decode a `display' property for text between START and END.