1 ;;; cus-face.el -- customization support for faces.
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, faces
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
33 (defalias 'custom-facep
34 (if (fboundp 'facep
) 'facep
35 '(lambda (face) nil
)))
40 (defun custom-declare-face (face spec doc
&rest args
)
41 "Like `defface', but FACE is evaluated as a normal argument."
42 (unless (get face
'face-defface-spec
)
43 (put face
'face-defface-spec spec
)
44 (when (fboundp 'facep
)
46 ;; If the user has already created the face, respect that.
47 (let ((value (or (get face
'saved-face
) spec
))
50 ;; Create global face.
51 (make-empty-face face
)
52 ;; Create frame local faces
54 (setq frame
(car frames
)
56 (face-spec-set face value frame
)))
57 ;; When making a face after frames already exist
58 (if (memq window-system
'(x w32
))
59 (make-face-x-resource-internal face
))))
60 (when (and doc
(null (face-documentation face
)))
61 (set-face-documentation face doc
))
62 (custom-handle-all-keywords face args
'custom-face
)
63 (run-hooks 'custom-define-hook
))
68 (defconst custom-face-attributes
69 '((:bold
(boolean :tag
"Bold"
70 :help-echo
"Control whether a bold font should be used.")
73 (:italic
(boolean :tag
"Italic"
75 Control whether an italic font should be used.")
78 (:underline
(boolean :tag
"Underline"
80 Control whether the text should be underlined.")
83 (:inverse-video
(boolean :tag
"Inverse Video"
85 Control whether the text should be in inverse video.")
86 set-face-inverse-video-p
88 (:foreground
(color :tag
"Foreground"
90 :help-echo
"Set foreground color.")
93 (:background
(color :tag
"Background"
95 :help-echo
"Set background color.")
98 (:stipple
(editable-field :format
"Stipple: %v"
99 :help-echo
"Name of background bitmap file.")
102 "Alist of face attributes.
103 The elements are of the form (KEY TYPE SET GET),
104 where KEY is the name of the attribute,
105 TYPE is a widget type for editing the attribute,
106 SET is a function for setting the attribute value,
107 and GET is a function for getiing the attribute value.
109 The SET function should take three arguments, the face to modify, the
110 value of the attribute, and optionally the frame where the face should
113 The GET function should take two arguments, the face to examine, and
114 optionally the frame where the face should be examined.")
116 (defun custom-face-attributes-get (face frame
)
117 "For FACE on FRAME, return an alternating list describing its attributes.
118 The list has the form (KEYWORD VALUE KEYWORD VALUE...).
119 Each keyword should be listed in `custom-face-attributes'.
120 We include only those attributes that differ from the default face.
122 If FRAME is nil, use the global defaults for FACE."
123 (let ((atts custom-face-attributes
)
130 (let ((answer (funcall get face frame
)))
131 (if (and (not (equal answer
(funcall get
'default frame
)))
132 (widget-apply (nth 1 att
) :match answer
))
133 (setq result
(cons (nth 0 att
) (cons answer result
)))))))
139 (defun custom-set-faces (&rest args
)
140 "Initialize faces according to user preferences.
141 The arguments should be a list where each entry has the form:
145 SPEC is stored as the saved value for FACE.
146 If NOW is present and non-nil, FACE is created now, according to SPEC.
148 See `defface' for the format of SPEC."
150 (let ((entry (car args
)))
152 (let ((face (nth 0 entry
))
155 (put face
'saved-face spec
)
157 (put face
'force-face t
))
158 (when (or now
(facep face
))
159 (make-empty-face face
)
160 (face-spec-set face spec
))
161 (setq args
(cdr args
)))
162 ;; Old format, a plist of FACE SPEC pairs.
163 (let ((face (nth 0 args
))
165 (put face
'saved-face spec
))
166 (setq args
(cdr (cdr args
)))))))
172 ;; cus-face.el ends here