;;; 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
(right "flushright")
(left "flushleft")
(full "flushboth")
- (center "center"))
+ (center "center"))
(PARAMETER (t "param")) ; Argument of preceding annotation
;; The following are not part of the standard:
(FUNCTION (enriched-decode-foreground "x-color")
text/enriched format.
Turning the mode on runs `enriched-mode-hook'.
-More information about Enriched mode is available in the file
+More information about Enriched mode is available in the file
etc/enriched.doc in the Emacs distribution directory.
Commands:
-\\<enriched-mode-map>\\{enriched-mode-map}"
+\\{enriched-mode-map}"
nil " Enriched" nil
(cond ((null enriched-mode)
;; Turn mode off
;; restore old variable values
(while enriched-old-bindings
(set (pop enriched-old-bindings) (pop enriched-old-bindings))))
-
+
((memq 'text/enriched buffer-file-format)
;; Mode already on; do nothing.
nil)
(unjustify-region)
(goto-char from)
(format-replace-strings '(("<" . "<<")))
- (format-insert-annotations
+ (format-insert-annotations
(format-annotate-region from (point-max) enriched-translations
'enriched-make-annotation enriched-ignore))
(goto-char from)
;; 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.
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.
FACE may be a list of faces instead of a single face;
(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))
(delete-char 1)
;; A single < that does not start an annotation is an error,
;; which we note and then ignore.
- (message "Warning: malformed annotation in file at %s"
+ (message "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
+ (name (downcase (buffer-substring
(match-beginning 2) (match-end 2))))
(pos (not (match-beginning 1))))
(list beg end name pos))))
(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.
close and OPEN a list of annotations to open. Each of these lists
has the form `(ANNOTATION PARAM ...)'."
(let ((annotation "x-display")
- (param (prin1-to-string (or old new)))
- close open)
+ (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.
(unless prop
(message "Warning: invalid <x-display> parameter %s" param))
(list start end 'display prop)))
-
-
+
;;; enriched.el ends here