Mercurial > hg > xemacs-beta

comparison lisp/cus-face.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents a4f53d9b3154
children 6240c7796c7a
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
52 (run-hooks 'custom-define-hook)) 52 (run-hooks 'custom-define-hook))
53 face) 53 face)
54 54
55 ;;; Font Attributes. 55 ;;; Font Attributes.
56 56
57 ;; Consider adding the stuff in the XML font model here.
58 (defconst custom-face-attributes 57 (defconst custom-face-attributes
59 '((:foreground (color :tag "Foreground" 58 '((:foreground (color :tag "Foreground"
60 :value "" 59 :value ""
61 :help-echo "Set foreground color.") 60 :help-echo "Set foreground color.")
62 set-face-foreground face-foreground-name) 61 set-face-foreground face-foreground-name)
97 set-face-reverse-p face-reverse-p)) 96 set-face-reverse-p face-reverse-p))
98 "Alist of face attributes. 97 "Alist of face attributes.
99 98
100 The elements are of the form (KEY TYPE SET GET) where KEY is a symbol 99 The elements are of the form (KEY TYPE SET GET) where KEY is a symbol
101 identifying the attribute, TYPE is a widget type for editing the 100 identifying the attribute, TYPE is a widget type for editing the
102 attribute, SET is a function for setting the attribute value, and GET is 101 attibute, SET is a function for setting the attribute value, and GET is a function for getiing the attribute value.
103 a function for getting the attribute value.
104 102
105 The SET function should take three arguments, the face to modify, the 103 The SET function should take three arguments, the face to modify, the
106 value of the attribute, and optionally the frame where the face should 104 value of the attribute, and optionally the frame where the face should
107 be changed. 105 be changed.
108 106
109 The GET function should take two arguments, the face to examine, and 107 The GET function should take two arguments, the face to examine, and
110 optionally the frame where the face should be examined.") 108 optonally the frame where the face should be examined.")
111 109
112 (defun face-custom-attributes-set (face frame &rest atts) 110 (defun face-custom-attributes-set (face frame &rest atts)
113 "For FACE on FRAME set the attributes [KEYWORD VALUE].... 111 "For FACE on FRAME set the attributes [KEYWORD VALUE]....
114 Each keyword should be listed in `custom-face-attributes'. 112 Each keyword should be listed in `custom-face-attributes'.
115 113
146 (when (widget-apply (nth 1 att) :match answer) 144 (when (widget-apply (nth 1 att) :match answer)
147 (setq result (cons (nth 0 att) (cons answer result))))))) 145 (setq result (cons (nth 0 att) (cons answer result)))))))
148 (error nil))) 146 (error nil)))
149 result)) 147 result))
150 148
151 (defsubst custom-face-get-spec (symbol)
152 (or (get symbol 'customized-face)
153 (get symbol 'saved-face)
154 (get symbol 'face-defface-spec)
155 ;; Attempt to construct it.
156 (list (list t (face-custom-attributes-get
157 symbol (selected-frame))))))
158
159 (defun custom-set-face-bold (face value &optional frame) 149 (defun custom-set-face-bold (face value &optional frame)
160 "Set the bold property of FACE to VALUE." 150 "Set the bold property of FACE to VALUE."
161 (if value 151 (if value
162 (make-face-bold face frame) 152 (make-face-bold face frame)
163 (make-face-unbold face frame))) 153 (make-face-unbold face frame)))
222 "Return the name of the font family of FACE." 212 "Return the name of the font family of FACE."
223 (let* ((font (apply 'face-font-name face args)) 213 (let* ((font (apply 'face-font-name face args))
224 ;; Gag 214 ;; Gag
225 (fontobj (font-create-object font))) 215 (fontobj (font-create-object font)))
226 (font-family fontobj))) 216 (font-family fontobj)))
227
228 ;;;###autoload
229 (defun custom-set-face-update-spec (face display plist)
230 "Customize the FACE for display types matching DISPLAY, merging
231 in the new items from PLIST"
232 (let ((spec (face-spec-update-all-matching (custom-face-get-spec face)
233 display plist)))
234 (put face 'customized-face spec)
235 (face-spec-set face spec)))
236 217
237 ;;; Initializing. 218 ;;; Initializing.
238 219
239 ;;;###autoload 220 ;;;###autoload
240 (defun custom-set-faces (&rest args) 221 (defun custom-set-faces (&rest args)