Mercurial > hg > xemacs-beta

comparison lisp/cus-face.el @ 422:95016f13131a r21-2-19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-19
author cvs
date Mon, 13 Aug 2007 11:25:01 +0200
parents 41dbb7a9d5f2
children
comparison
equal deleted inserted replaced
421:fff06e11db74 422:95016f13131a
28 ;;;###autoload 28 ;;;###autoload
29 (defun custom-declare-face (face spec doc &rest args) 29 (defun custom-declare-face (face spec doc &rest args)
30 "Like `defface', but FACE is evaluated as a normal argument." 30 "Like `defface', but FACE is evaluated as a normal argument."
31 ;; (when (fboundp 'pureload) 31 ;; (when (fboundp 'pureload)
32 ;; (error "Attempt to declare a face during dump")) 32 ;; (error "Attempt to declare a face during dump"))
33 ;; #### should we possibly reset force-face here?
33 (unless (get face 'face-defface-spec) 34 (unless (get face 'face-defface-spec)
34 (put face 'face-defface-spec spec) 35 (put face 'face-defface-spec spec)
35 (unless (find-face face) 36 (unless (find-face face)
36 ;; If the user has already created the face, respect that. 37 ;; If the user has already created the face, respect that.
37 (let ((value (or (get face 'saved-face) spec)) 38 (let ((value (or (get face 'saved-face) spec))
67 :help-echo "\ 68 :help-echo "\
68 Text size (e.g. 9pt or 2mm).") 69 Text size (e.g. 9pt or 2mm).")
69 custom-set-face-font-size custom-face-font-size) 70 custom-set-face-font-size custom-face-font-size)
70 (:family (editable-field :format "Font Family: %v" 71 (:family (editable-field :format "Font Family: %v"
71 :help-echo "\ 72 :help-echo "\
72 Name of font family to use (e.g. times).") 73 Name of font family to use (e.g. times).")
73 custom-set-face-font-family custom-face-font-family) 74 custom-set-face-font-family custom-face-font-family)
74 (:background-pixmap (editable-field :format "Background pixmap: %v" 75 (:background-pixmap (editable-field :format "Background pixmap: %v"
75 :help-echo "\ 76 :help-echo "\
76 Name of background pixmap file.") 77 Name of background pixmap file.")
77 set-face-background-pixmap custom-face-background-pixmap) 78 set-face-background-pixmap custom-face-background-pixmap)
238 ;;; Initializing. 239 ;;; Initializing.
239 240
240 ;;;###autoload 241 ;;;###autoload
241 (defun custom-set-faces (&rest args) 242 (defun custom-set-faces (&rest args)
242 "Initialize faces according to user preferences. 243 "Initialize faces according to user preferences.
244 This asociates the setting with the USER theme.
243 The arguments should be a list where each entry has the form: 245 The arguments should be a list where each entry has the form:
244 246
245 (FACE SPEC [NOW]) 247 (FACE SPEC [NOW [COMMENT]])
246 248
247 SPEC will be stored as the saved value for FACE. If NOW is present 249 SPEC will be stored as the saved value for FACE. If NOW is present
248 and non-nil, FACE will also be created according to SPEC. 250 and non-nil, FACE will also be created according to SPEC.
251 COMMENT is a string comment about FACE.
249 252
250 See `defface' for the format of SPEC." 253 See `defface' for the format of SPEC."
251 (while args 254 (apply #'custom-theme-set-faces 'user args))
252 (let ((entry (car args))) 255
253 (if (listp entry) 256 ;;;###autoload
254 (let ((face (nth 0 entry)) 257 (defun custom-theme-set-faces (theme &rest args)
255 (spec (nth 1 entry)) 258 "Initialize faces according to settings specified by args.
256 (now (nth 2 entry))) 259 Records the settings as belonging to THEME.
260
261 See `custom-set-faces' for a description of the arguments ARGS."
262 (custom-check-theme theme)
263 (let ((immediate (get theme 'theme-immediate)))
264 (while args
265 (let ((entry (car args)))
266 (if (listp entry)
267 (let ((face (nth 0 entry))
268 (spec (nth 1 entry))
269 (now (nth 2 entry))
270 (comment (nth 3 entry)))
271 (put face 'saved-face spec)
272 (custom-push-theme 'theme-face face theme 'set spec)
273 (put face 'saved-face-comment comment)
274 (when (or now immediate)
275 (put face 'force-face (if now 'rogue 'immediate)))
276 (when (or now immediate (find-face face))
277 (put face 'face-comment comment)
278 (unless (find-face face)
279 (make-empty-face face))
280 (face-spec-set face spec nil '(custom)))
281 (setq args (cdr args)))
282 ;; Old format, a plist of FACE SPEC pairs.
283 (let ((face (nth 0 args))
284 (spec (nth 1 args)))
257 (put face 'saved-face spec) 285 (put face 'saved-face spec)
258 (when now 286 (custom-push-theme 'theme-face face theme 'set spec))
259 (put face 'force-face t)) 287 (setq args (cdr (cdr args))))))))
260 (when (or now (find-face face)) 288
289 ;;;###autoload
290 (defun custom-theme-face-value (face theme)
291 "Return spec of FACE in THEME if the THEME modifies the
292 FACE. Nil otherwise."
293 (car-safe (custom-theme-value theme (get face 'theme-face))))
294
295 (defun custom-theme-reset-internal-face (face to-theme)
296 (let ((spec (custom-theme-face-value face to-theme))
297 was-in-theme)
298 (setq was-in-theme spec)
299 (setq spec (or spec (get face 'standard-value)))
300 (when spec
301 (put face 'save-face was-in-theme)
302 (when (or (get face 'force-face) (find-face face))
261 (unless (find-face face) 303 (unless (find-face face)
262 (make-empty-face face)) 304 (make-empty-face face))
263 (face-spec-set face spec nil '(custom))) 305 (face-spec-set face spec)))
264 (setq args (cdr args))) 306 spec))
265 ;; Old format, a plist of FACE SPEC pairs. 307
266 (let ((face (nth 0 args)) 308 ;;;###autoload
267 (spec (nth 1 args))) 309 (defun custom-theme-reset-faces (theme &rest args)
268 (put face 'saved-face spec)) 310 (custom-check-theme theme)
269 (setq args (cdr (cdr args))))))) 311 "Reset the value of the face to values previously defined.
312 Assosiate this setting with THEME.
313
314 ARGS is a list of lists of the form
315
316 (face to-theme)
317
318 This means reset face to its value in to-theme."
319 (mapc #'(lambda (arg)
320 (apply #'custom-theme-reset-internal-face arg)
321 (custom-push-theme (car arg) 'theme-face theme 'reset (cadr arg)))
322 args))
323
324 ;;;###autoload
325 (defun custom-reset-faces (&rest args)
326 "Reset the value of the face to values previously defined.
327 Assosiate this setting with the 'user' theme.
328
329 ARGS is defined as for `custom-theme-reset-faces'"
330 (apply #'custom-theme-reset-faces 'user args))
331
270 332
271 ;;; The End. 333 ;;; The End.
272 334
273 (provide 'cus-face) 335 (provide 'cus-face)
274 336