Mercurial > hg > xemacs-beta
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."