emacs: lisp/cus-face.el comparison

comparison lisp/cus-face.el @ 25684:e3ed0e86532c

(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.

author	Dave Love <fx@gnu.org>
date	Mon, 13 Sep 1999 13:09:30 +0000
parents	1553432b90d5
children	3251a6750150

comparison

equal deleted inserted replaced

-:d1179efb4e87
+:e3ed0e86532c
 ;;; 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.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 (cond ((eq value 'off) (setq value nil))
 	     ((null value) (setq value 'unspecified)))
 (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))
+	 (cond ((eq underline 'unspecified) nil)
-	       ((null underline) (setq underline 'off)))
+	       ((null underline) 'off)))))
-	 underline)))
 (:overline
 (choice :tag "Overline"
 	     :help-echo "Control text overlining."
 	     (const :tag "*" nil)
 (cond ((eq value 'off) (setq value nil))
 	     ((null value) (setq value 'unspecified)))
 (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))
+	 (cond ((eq overline 'unspecified) nil)
-	       ((null overline) (setq overline 'off)))
+	       ((null overline) 'off)))))
-	 overline)))
 (:strike-through
 (choice :tag "Strike-through"
 	     :help-echo "Control text strike-through."
 	     (const :tag "*" nil)
 	 (cond ((eq value 'unspecified) (setq value nil))
 	       ((null value) (setq value 'off)))
 	 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 "*" t)
-	     (const :tag "Off" off)
+	     (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")
+		   (const :format "" :value :color)
-		   (choice :tag "Shadows"
+		   (choice :tag "Color" (const :tag "*" nil) color)
-			   (const :tag "None" nil)
+		   (const :format "" :value :style)
-			   (const :tag "Raised" raised)
+		   (choice :tag "Style"
-			   (const :tag "Sunken" sunken))))
+			   (const :tag "Raised" released-button)
-(lambda (face value &optional frame)
+			   (const :tag "Sunken" pressed-button)
-(cond ((consp value)
+			   (const :tag "None" nil))))
-	      (let ((width (nth 0 value))
+(lambda (face value &optional frame)
-		    (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)
+	 (if (consp value)
-		(let ((width (plist-get value :width))
+	     (list :line-width (or (plist-get value :line-width) 1)
-		      (color (plist-get value :color))
+		   :color (plist-get value :color)
-		      (shadow (plist-get value :shadow)))
+		   :style (plist-get value :style))
-		  (setq value (list width color shadow))))
+	   value))))
-	       ((eq value 'unspecified)
-		(setq value nil))
-	       ((null value)
-		(setq value 'off)))
-	 value)))
 (:inverse-video
 (choice :tag "Inverse-video"
 	     :help-echo "Control whether text should be in inverse-video."
 	     (const :tag "*" nil)
 (cond ((eq value 'off) (setq value nil))
 	     ((null value) (setq value 'unspecified)))
 (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))
+	 (cond ((eq value 'unspecified)
-	       ((null value) (setq value 'off)))
+		nil)
-	 value)))
+	       ((null value)'off)))))
 (:foreground
 (choice :tag "Foreground"
 	     :help-echo "Set foreground color."
 	     (const :tag "*" nil)
 ;;;###autoload
 (defun custom-set-faces (&rest args)
 "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
 (let ((entry (car args)))
 (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)))
 	;; Old format, a plist of FACE SPEC pairs.
 	(let ((face (nth 0 args))
 ;;; The End.
 (provide 'cus-face)
-;; cus-face.el ends here
+;;; cus-face.el ends here

Mercurial > emacs

comparison lisp/cus-face.el @ 25684:e3ed0e86532c