(custom-face-attributes): Simplify :underline, :overline,

:inverse-video cases.  Fix up :box case (probably needs more work).
Change from Didier Verna:
(custom-set-faces): The arguments can now have a custom comment as
fourth argument.

1 files changed, 34 insertions, 41 deletions

diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 4137161de0c..2b32ce3f522 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,11 +1,11 @@
 ;;; cus-face.el -- customization support for faces.
 ;;
-;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
 ;; Version: Emacs
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (probably obsolete)
 
 ;; This file is part of GNU Emacs.
 
@@ -168,9 +168,8 @@
        (set-face-attribute face frame :underline value))
      (lambda (face &optional frame)
        (let ((underline (face-attribute face :underline frame)))
-	 (cond ((eq underline 'unspecified) (setq underline nil))
-	       ((null underline) (setq underline 'off)))
-	 underline)))
+	 (cond ((eq underline 'unspecified) nil)
+	       ((null underline) 'off)))))
     
     (:overline
      (choice :tag "Overline"
@@ -185,9 +184,8 @@
        (set-face-attribute face frame :overline value))
      (lambda (face &optional frame)
        (let ((overline (face-attribute face :overline frame)))
-	 (cond ((eq overline 'unspecified) (setq overline nil))
-	       ((null overline) (setq overline 'off)))
-	 overline)))
+	 (cond ((eq overline 'unspecified) nil)
+	       ((null overline) 'off)))))
     
     (:strike-through
      (choice :tag "Strike-through"
@@ -207,41 +205,32 @@
 	 value)))
     
     (:box
+     ;; Fixme: this can probably be done better.
      (choice :tag "Box around text"
 	     :help-echo "Control box around text."
-	     (const :tag "*" nil)
-	     (const :tag "Off" off)
+	     (const :tag "*" t)
+	     (const :tag "Off" nil)
 	     (list :tag "Box"
-		   :value (1 "black" nil)
+		   :value (:line-width 2 :color "grey75"
+				       :style released-button)
+		   (const :format "" :value :line-width)
 		   (integer :tag "Width")
-		   (color :tag "Color")
-		   (choice :tag "Shadows"
-			   (const :tag "None" nil)
-			   (const :tag "Raised" raised)
-			   (const :tag "Sunken" sunken))))
+		   (const :format "" :value :color)
+		   (choice :tag "Color" (const :tag "*" nil) color)
+		   (const :format "" :value :style)
+		   (choice :tag "Style"
+			   (const :tag "Raised" released-button)
+			   (const :tag "Sunken" pressed-button)
+			   (const :tag "None" nil))))
      (lambda (face value &optional frame)
-       (cond ((consp value)
-	      (let ((width (nth 0 value))
-		    (color (nth 1 value))
-		    (shadow (nth 2 value)))
-		(setq value (list :width width :color color :shadow shadow))))
-	     ((eq value 'off)
-	      (setq value nil))
-	     ((null value)
-	      (setq value 'unspecified)))
        (set-face-attribute face frame :box value))
      (lambda (face &optional frame)
        (let ((value (face-attribute face :box frame)))
-	 (cond ((consp value)
-		(let ((width (plist-get value :width))
-		      (color (plist-get value :color))
-		      (shadow (plist-get value :shadow)))
-		  (setq value (list width color shadow))))
-	       ((eq value 'unspecified)
-		(setq value nil))
-	       ((null value)
-		(setq value 'off)))
-	 value)))
+	 (if (consp value)
+	     (list :line-width (or (plist-get value :line-width) 1)
+		   :color (plist-get value :color)
+		   :style (plist-get value :style))
+	   value))))
     
     (:inverse-video
      (choice :tag "Inverse-video"
@@ -255,9 +244,9 @@
        (set-face-attribute face frame :inverse-video value))
      (lambda (face &optional frame)
        (let ((value (face-attribute face :inverse-video frame)))
-	 (cond ((eq value 'unspecified) (setq value nil))
-	       ((null value) (setq value 'off)))
-	 value)))
+	 (cond ((eq value 'unspecified)
+		nil)
+	       ((null value)'off)))))
     
     (:foreground
      (choice :tag "Foreground"
@@ -330,10 +319,11 @@ If FRAME is nil, use the global defaults for FACE."
   "Initialize faces according to user preferences.
 The arguments should be a list where each entry has the form:
 
-  (FACE SPEC [NOW])
+  (FACE SPEC [NOW [COMMENT]])
 
 SPEC is stored as the saved value for FACE.
 If NOW is present and non-nil, FACE is created now, according to SPEC.
+COMMENT is a string comment about FACE.
 
 See `defface' for the format of SPEC."
   (while args
@@ -341,11 +331,14 @@ See `defface' for the format of SPEC."
       (if (listp entry)
 	  (let ((face (nth 0 entry))
 		(spec (nth 1 entry))
-		(now (nth 2 entry)))
+		(now (nth 2 entry))
+		(comment (nth 3 entry)))
 	    (put face 'saved-face spec)
+	    (put face 'saved-face-comment comment)
 	    (when now
 	      (put face 'force-face t))
 	    (when (or now (facep face))
+	      (put face 'face-comment comment)
 	      (make-empty-face face)
 	      (face-spec-set face spec))
 	    (setq args (cdr args)))
@@ -359,4 +352,4 @@ See `defface' for the format of SPEC."
 
 (provide 'cus-face)
 
-;; cus-face.el ends here
+;;; cus-face.el ends here