Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-face.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children d620409f5eb8
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, faces 6 ;; Keywords: help, faces
7 ;; Version: 1.59 7 ;; Version: 1.63
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;;; Commentary: 10 ;;; Commentary:
11 ;; 11 ;;
12 ;; See `custom.el'. 12 ;; See `custom.el'.
205 ;; This should be allowed, somehow. 205 ;; This should be allowed, somehow.
206 (error "Attempt to declare a face during dump")) 206 (error "Attempt to declare a face during dump"))
207 (unless (get face 'factory-face) 207 (unless (get face 'factory-face)
208 (put face 'factory-face spec) 208 (put face 'factory-face spec)
209 (when (fboundp 'facep) 209 (when (fboundp 'facep)
210 (unless (and (custom-facep face) 210 (unless (custom-facep face)
211 (not (get face 'saved-face)))
212 ;; If the user has already created the face, respect that. 211 ;; If the user has already created the face, respect that.
213 (let ((value (or (get face 'saved-face) spec)) 212 (let ((value (or (get face 'saved-face) spec))
214 (frames (custom-relevant-frames)) 213 (frames (custom-relevant-frames))
215 frame) 214 frame)
216 ;; Create global face. 215 ;; Create global face.
241 (:underline (toggle :format "Underline: %[%v%]\n" 240 (:underline (toggle :format "Underline: %[%v%]\n"
242 :help-echo "\ 241 :help-echo "\
243 Control whether the text should be underlined.") 242 Control whether the text should be underlined.")
244 set-face-underline-p) 243 set-face-underline-p)
245 (:foreground (color :tag "Foreground" 244 (:foreground (color :tag "Foreground"
245 :value "black"
246 :help-echo "Set foreground color.") 246 :help-echo "Set foreground color.")
247 set-face-foreground) 247 set-face-foreground)
248 (:background (color :tag "Background" 248 (:background (color :tag "Background"
249 :value "white"
249 :help-echo "Set background color.") 250 :help-echo "Set background color.")
250 set-face-background) 251 set-face-background)
251 (:invert (const :format "Invert Face\n" 252 (:invert (const :format "Invert Face\n"
252 :sibling-args (:help-echo "\ 253 :sibling-args (:help-echo "\
253 Reverse the foreground and background color. 254 Reverse the foreground and background color.
306 (defun custom-set-face-font-size (face size &rest args) 307 (defun custom-set-face-font-size (face size &rest args)
307 "Set the font of FACE to SIZE" 308 "Set the font of FACE to SIZE"
308 (let* ((font (apply 'face-font-name face args)) 309 (let* ((font (apply 'face-font-name face args))
309 (fontobj (font-create-object font))) 310 (fontobj (font-create-object font)))
310 (set-font-size fontobj size) 311 (set-font-size fontobj size)
311 (apply 'set-face-font face fontobj args))) 312 (apply 'font-set-face-font face fontobj args)))
312 313
313 (defun custom-set-face-font-family (face family &rest args) 314 (defun custom-set-face-font-family (face family &rest args)
314 "Set the font of FACE to FAMILY" 315 "Set the font of FACE to FAMILY"
315 (let* ((font (apply 'face-font-name face args)) 316 (let* ((font (apply 'face-font-name face args))
316 (fontobj (font-create-object font))) 317 (fontobj (font-create-object font)))
317 (set-font-family fontobj family) 318 (set-font-family fontobj family)
318 (apply 'set-face-font face fontobj args))) 319 (apply 'font-set-face-font face fontobj args)))
319 320
320 (nconc custom-face-attributes 321 (nconc custom-face-attributes
321 '((:family (editable-field :format "Font Family: %v" 322 '((:family (editable-field :format "Font Family: %v"
322 :help-echo "\ 323 :help-echo "\
323 Name of font family to use (e.g. times).") 324 Name of font family to use (e.g. times).")
459 (let ((face (nth 0 entry)) 460 (let ((face (nth 0 entry))
460 (spec (nth 1 entry)) 461 (spec (nth 1 entry))
461 (now (nth 2 entry))) 462 (now (nth 2 entry)))
462 (put face 'saved-face spec) 463 (put face 'saved-face spec)
463 (when now 464 (when now
464 (put face 'force-face t) 465 (put face 'force-face t))
466 (when (or now (custom-facep face))
465 (when (fboundp 'copy-face) 467 (when (fboundp 'copy-face)
466 (copy-face 'custom-face-empty face)) 468 (copy-face 'custom-face-empty face))
467 (custom-face-display-set face spec)) 469 (custom-face-display-set face spec))
468 (setq args (cdr args))) 470 (setq args (cdr args)))
469 ;; Old format, a plist of FACE SPEC pairs. 471 ;; Old format, a plist of FACE SPEC pairs.