diff lisp/cus-face.el @ 3027:7efd3a9bbcfb

[xemacs-hg @ 2005-10-25 11:28:23 by ben] support :inherit in cus-face and face cus-face.el, faces.el: Provide a basic implementation of the `inherit' property for faces and the :inherit property in custom. Use the new `specifier-instantiator' function. Update the documentation for various places in faces.el. 'foo -> `foo'.
author ben
date Tue, 25 Oct 2005 11:28:24 +0000
parents 943eaba38521
children 1c2a46ea1f78
line wrap: on
line diff
--- a/lisp/cus-face.el	Tue Oct 25 11:19:58 2005 +0000
+++ b/lisp/cus-face.el	Tue Oct 25 11:28:24 2005 +0000
@@ -8,13 +8,12 @@
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
+;;; Synched with: Not synched.
+
 ;;; Commentary:
 ;;
 ;; See `custom.el'.
 
-;; This file should probably be dissolved, and code moved to faces.el,
-;; like Stallman did.
-
 ;;; Code:
 
 ;; it is now safe to put the `provide' anywhere.  if an error occurs while
@@ -102,7 +101,26 @@
     (:inverse-video (toggle :format "%[Inverse Video%]: %v\n"
 			    :help-echo "\
 Control whether the text should be inverted.  Works only on TTY-s")
-		    set-face-reverse-p face-reverse-p))
+		    set-face-reverse-p face-reverse-p)
+    (:inherit
+     (repeat :tag "Inherit"
+	     :help-echo "List of faces to inherit attributes from."
+	     (face :Tag "Face" default))
+     ;; FSF 21.3
+;      ;; filter to make value suitable for customize
+;      (lambda (real-value)
+;        (cond ((or (null real-value) (eq real-value 'unspecified))
+; 	      nil)
+; 	     ((symbolp real-value)
+; 	      (list real-value))
+; 	     (t
+; 	      real-value)))
+;      ;; filter to make customized-value suitable for storing
+;      (lambda (cus-value)
+;        (if (and (consp cus-value) (null (cdr cus-value)))
+; 	   (car cus-value)
+; 	 cus-value))
+     custom-set-face-inherit custom-face-inherit))
   "Alist of face attributes.
 
 The elements are lists of the form (KEY TYPE SET GET) where:
@@ -199,11 +217,24 @@
 
 (defun custom-face-background-pixmap (face &rest args)
   "Return the name of the background pixmap file used for FACE."
-  (let ((image  (apply 'specifier-instance
-		       (face-background-pixmap face) args)))
+  (let ((image (apply 'specifier-instance
+		      (face-background-pixmap face) args)))
     (and image
 	 (image-instance-file-name image))))
 
+(defun custom-set-face-inherit (face value &optional frame tags)
+  "Set FACE to inherit its properties from another face."
+  (if (listp value) (setq value (car value))) ;; #### Temporary hack!
+  (if (find-face value)
+      (set-face-parent face value frame tags)))
+
+(defun custom-face-inherit (face &rest args)
+  "Return the value (instance) of the `inherit' property for FACE."
+  ;; #### Major, temporary hack!
+  (let ((spec (apply 'specifier-instantiator
+		     (face-font face) args)))
+    (and spec (vector spec) (aref spec 0))))
+
 ;; This consistently fails to dtrt
 ;;(defun custom-set-face-font-size (face size &optional locale tags)
 ;;  "Set the font of FACE to SIZE."