;;; cus-face.el --- customization support for faces
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
(when (fboundp 'facep)
(unless (facep face)
;; If the user has already created the face, respect that.
- (let ((value (or (get face 'saved-face) spec))
- (frames (frame-list))
- frame)
+ (let ((value (or (get face 'saved-face) spec)))
;; Create global face.
(make-empty-face face)
;; Create frame-local faces
- (while frames
- (setq frame (car frames)
- frames (cdr frames))
+ (dolist (frame (frame-list))
(face-spec-set face value frame)))
;; When making a face after frames already exist
(if (memq window-system '(x w32))
(make-face-x-resource-internal face))))
;; Don't record SPEC until we see it causes no errors.
(put face 'face-defface-spec spec)
+ (push (cons 'defface face) current-load-list)
(when (and doc (null (face-documentation face)))
(set-face-documentation face (purecopy doc)))
(custom-handle-all-keywords face args 'custom-face)
;;; Face attributes.
+;;;###autoload
(defconst custom-face-attributes
'((:family
(string :tag "Font Family"
(const :tag "ultracondensed" ultra-condensed)
(const :tag "ultraexpanded" ultra-expanded)
(const :tag "wide" extra-expanded)))
-
+
(:height
(choice :tag "Height"
:help-echo "Face's font height."
(const :tag "semilight" semi-light)
(const :tag "ultralight" ultra-light)
(const :tag "ultrabold" ultra-bold)))
-
+
(:slant
(choice :tag "Slant"
:help-echo "Font slant."
(const :tag "italic" italic)
(const :tag "oblique" oblique)
(const :tag "normal" normal)))
-
+
(:underline
(choice :tag "Underline"
:help-echo "Control text underlining."
(const :tag "Off" nil)
(const :tag "On" t)
(color :tag "Colored")))
-
+
(:overline
(choice :tag "Overline"
:help-echo "Control text overlining."
(const :tag "Off" nil)
(const :tag "On" t)
(color :tag "Colored")))
-
+
(:strike-through
(choice :tag "Strike-through"
:help-echo "Control text strike-through."
(const :tag "Off" nil)
(const :tag "On" t)
(color :tag "Colored")))
-
+
(:box
;; Fixme: this can probably be done better.
(choice :tag "Box around text"
(nconc (and lwidth `(:line-width ,lwidth))
(and color `(:color ,color))
(and style `(:style ,style)))))))))
-
+
(:inverse-video
(choice :tag "Inverse-video"
:help-echo "Control whether text should be in inverse-video."
(const :tag "Off" nil)
(const :tag "On" t)))
-
+
(:foreground
(color :tag "Foreground"
- :help-echo "Set foreground color."))
-
+ :help-echo "Set foreground color (name or #RRGGBB hex spec)."))
+
(:background
(color :tag "Background"
- :help-echo "Set background color."))
-
+ :help-echo "Set background color (name or #RRGGBB hex spec)."))
+
(:stipple
(choice :tag "Stipple"
:help-echo "Background bit-mask"
(if (and (consp cus-value) (null (cdr cus-value)))
(car cus-value)
cus-value))))
-
+
"Alist of face attributes.
The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER),
(spec (nth 1 entry))
(now (nth 2 entry))
(comment (nth 3 entry)))
+ ;; If FACE is actually an alias, customize the face it
+ ;; is aliased to.
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
(put face 'saved-face spec)
(put face 'saved-face-comment comment)
(custom-push-theme 'theme-face face theme 'set spec)
;; Old format, a plist of FACE SPEC pairs.
(let ((face (nth 0 args))
(spec (nth 1 args)))
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
(put face 'saved-face spec)
(custom-push-theme 'theme-face face theme 'set spec))
(setq args (cdr (cdr args))))))))
-;;;###autoload
-(defun custom-theme-face-value (face theme)
- "Return spec of FACE in THEME if THEME modifies FACE.
-Value is nil otherwise. The association between theme and spec for FACE
-is stored in FACE's property `theme-face'. The appropriate face
-is retrieved using `custom-theme-value'."
- ;; Returns car because the value is stored inside a one element list
- (car-safe (custom-theme-value theme (get face 'theme-face))))
-
-(defun custom-theme-reset-internal-face (face to-theme)
- "Reset FACE to the value defined by TO-THEME.
-If FACE is not defined in TO-THEME, reset FACE to the standard
-value. See `custom-theme-face-value'. The standard value is
-stored in SYMBOL's property `face-defface-spec' by `defface'."
- (let ((spec (custom-theme-face-value face to-theme))
- was-in-theme)
- (setq was-in-theme spec)
- (setq spec (or spec (get face 'face-defface-spec)))
- (when spec
- (put face 'save-face was-in-theme)
- (when (or (get face 'force-face) (facep face))
- (unless (facep face)
- (make-empty-face face))
- (face-spec-set face spec)))
- spec))
-
;;;###autoload
(defun custom-theme-reset-faces (theme &rest args)
- "Reset the value of the face to values previously defined.
-Associate this setting with THEME.
-
-ARGS is a list of lists of the form
+ "Reset the specs in THEME of some faces to their specs in other themes.
+Each of the arguments ARGS has this form:
- (FACE TO-THEME)
+ (FACE FROM-THEME)
-This means reset FACE to its value in TO-THEME."
+This means reset FACE to its value in FROM-THEME."
(custom-check-theme theme)
- (mapcar '(lambda (arg)
- (apply 'custom-theme-reset-internal-face arg)
- (custom-push-theme 'theme-face (car arg) theme 'reset (cadr arg)))
- args))
+ (dolist (arg args)
+ (custom-push-theme 'theme-face (car arg) theme 'reset (cadr arg))))
;;;###autoload
(defun custom-reset-faces (&rest args)
- "Reset the value of the face to values previously saved.
-This is the setting assosiated the `user' theme.
+ "Reset the specs of some faces to their specs in specified themes.
+This creates settings in the `user' theme.
+
+Each of the arguments ARGS has this form:
+
+ (FACE FROM-THEME)
-ARGS is defined as for `custom-theme-reset-faces'"
+This means reset FACE to its value in FROM-THEME."
(apply 'custom-theme-reset-faces 'user args))
;;; The End.
(provide 'cus-face)
+;;; arch-tag: 9a5c4b63-0d27-4c92-a5af-f2c7ed764c2b
;;; cus-face.el ends here