;;; faces.el --- Lisp faces
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
example, if `:slant' appears before `:height', font selection first
tries to find a font with a suitable slant, even if this results in
a font height that isn't optimal."
- :tag "Font selection order."
+ :tag "Font selection order"
:type '(list symbol symbol symbol symbol)
:group 'font-selection
:set #'(lambda (symbol value)
Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
ALTERNATIVE2 etc."
- :tag "Alternative font families to try."
+ :tag "Alternative font families to try"
:type '(repeat (repeat string))
:group 'font-selection
:set #'(lambda (symbol value)
If fonts of registry REGISTRY can be loaded, font selection
tries to find a best matching font among all fonts of registry
REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
- :tag "Alternative font registries to try."
+ :tag "Alternative font registries to try"
:type '(repeat (repeat string))
:version "21.1"
:group 'font-selection
If NEW-FACE already exists as a face, it is modified to be like
OLD-FACE. If it doesn't already exist, it is created.
-If the optional argument FRAME is given as a frame, NEW-FACE is
+If the optional argument FRAME is given as a frame, NEW-FACE is
changed on FRAME only.
If FRAME is t, the frame-independent default specification for OLD-FACE
is copied to NEW-FACE.
like an underlying face would be, with higher priority than underlying faces."
(let ((where (if (null frame) 0 frame)))
(setq args (purecopy args))
+ ;; If we set the new-frame defaults, this face is modified outside Custom.
+ (if (memq where '(0 t))
+ (put face 'face-modified t))
(while args
(internal-set-lisp-face-attribute face (car args)
(purecopy (cadr args))
If optional argument FRAME Is nil or omitted, use the selected frame."
(let ((completion-ignore-case t))
(completing-read (format "Set font attributes of face `%s' from font: " face)
- (mapcar 'list (x-list-fonts "*" nil frame)))))
+ (x-list-fonts "*" nil frame))))
(defun read-all-face-attributes (face &optional frame)
;; The name list-faces would be more consistent, but let's avoid a
;; conflict with Lucid, which uses that name differently.
+(defvar help-xref-stack)
(defun list-faces-display ()
"List all faces, using the same sample text in each.
The sample text is a string that comes from the variable
(not (featurep 'motif)))
(and (memq 'x-toolkit options)
(featurep 'x-toolkit))))
+ ((eq req 'min-colors)
+ (>= (display-color-cells frame) (car options)))
((eq req 'class)
(memq (frame-parameter frame 'display-type) options))
((eq req 'background)
(setq attribute nil))))
(when attribute
(set-face-attribute face frame attribute value)))
- (setq attrs (cdr (cdr attrs))))))
+ (setq attrs (cdr (cdr attrs)))))
+ ;; When we reset the face based on its spec, then it is unmodified
+ ;; as far as Custom is concerned.
+ (if (null frame)
+ (put face 'face-modified nil)))
(defun face-attr-match-p (face attrs &optional frame)
(1) different in appearance than the default face, and
(2) `close in spirit' to what the attributes specify, if not exact.
-Point (2) implies that a `:weight black' attribute will be satisified by
+Point (2) implies that a `:weight black' attribute will be satisfied by
any display that can display bold, and a `:foreground \"yellow\"' as long
as it can display a yellowish color, but `:slant italic' will _not_ be
-satisified by the tty display code's automatic substitution of a `dim'
+satisfied by the tty display code's automatic substitution of a `dim'
face for italic."
(let ((frame
(if (framep display)
according to the `background-mode' and `display-type' frame parameters."
(let* ((bg-resource
(and window-system
- (x-get-resource ".backgroundMode" "BackgroundMode")))
+ (x-get-resource "backgroundMode" "BackgroundMode")))
(bg-color (frame-parameter frame 'background-color))
(bg-mode
(cond (frame-background-mode)
(defun face-set-after-frame-default (frame)
"Set frame-local faces of FRAME from face specs and resources.
Initialize colors of certain faces from frame parameters."
+ (if (face-attribute 'default :font t)
+ (set-face-attribute 'default frame :font
+ (face-attribute 'default :font t))
+ (set-face-attribute 'default frame :family
+ (face-attribute 'default :family t))
+ (set-face-attribute 'default frame :height
+ (face-attribute 'default :height t))
+ (set-face-attribute 'default frame :slant
+ (face-attribute 'default :slant t))
+ (set-face-attribute 'default frame :weight
+ (face-attribute 'default :weight t))
+ (set-face-attribute 'default frame :width
+ (face-attribute 'default :width t)))
(dolist (face (face-list))
- (when (not (equal face 'default))
- (face-spec-set face (face-user-default-spec face) frame)
- (internal-merge-in-global-face face frame)
- (when (and (memq window-system '(x w32 mac))
- (or (not (boundp 'inhibit-default-face-x-resources))
- (not (eq face 'default))))
- (make-face-x-resource-internal face frame))))
-
+ ;; Don't let frame creation fail because of an invalid face spec.
+ (condition-case ()
+ (when (not (equal face 'default))
+ (face-spec-set face (face-user-default-spec face) frame)
+ (internal-merge-in-global-face face frame)
+ (when (and (memq window-system '(x w32 mac))
+ (or (not (boundp 'inhibit-default-face-x-resources))
+ (not (eq face 'default))))
+ (make-face-x-resource-internal face frame)))
+ (error nil)))
;; Initialize attributes from frame parameters.
(let ((params '((foreground-color default :foreground)
(background-color default :background)
(put 'modeline-inactive 'face-alias 'mode-line-inactive)
(defface header-line
- '((((type tty))
+ '((t
+ :inherit mode-line)
+ (((type tty))
;; This used to be `:inverse-video t', but that doesn't look very
;; good when combined with inverse-video mode-lines and multiple
;; windows. Underlining looks better, and is more consistent with
;; highlighting; this may be too confusing in general, although it
;; happens to look good with the only current use of header-lines,
;; the info browser. XXX
+ :inverse-video nil ;Override the value inherited from mode-line.
:underline t)
(((class color grayscale) (background light))
:background "grey90" :foreground "grey20"
- :box nil
- :inherit mode-line)
+ :box nil)
(((class color grayscale) (background dark))
:background "grey20" :foreground "grey90"
- :box nil
- :inherit mode-line)
+ :box nil)
(((class mono) (background light))
:background "white" :foreground "black"
:inverse-video nil
:box nil
- :underline t
- :inherit mode-line)
+ :underline t)
(((class mono) (background dark))
:background "black" :foreground "white"
:inverse-video nil
:box nil
- :underline t
- :inherit mode-line))
+ :underline t))
"Basic header-line face."
:version "21.1"
:group 'basic-faces)
(defface tool-bar
- '((((type x w32 mac) (class color))
+ '((t
:box (:line-width 1 :style released-button)
- :background "grey75" :foreground "black")
+ :foreground "black")
+ (((type x w32 mac) (class color))
+ :background "grey75")
(((type x) (class mono))
- :box (:line-width 1 :style released-button)
- :background "grey" :foreground "black")
- (t
- ()))
+ :background "grey"))
"Basic tool-bar face."
:version "21.1"
:group 'basic-faces)
(append minibuffer-prompt-properties (list 'face 'minibuffer-prompt)))
(defface region
- '((((type tty) (class color))
+ '((((class color) (min-colors 88) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 88) (background light))
+ :background "lightgoldenrod2")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "lightgoldenrod2")
+ (((class color) (min-colors 8))
:background "blue" :foreground "white")
(((type tty) (class mono))
:inverse-video t)
- (((class color) (background dark))
- :background "blue3")
- (((class color) (background light))
- :background "lightgoldenrod2")
(t :background "gray"))
"Basic face for highlighting the region."
:version "21.1"
(defface highlight
- '((((type tty) (class color))
- :background "green" :foreground "black")
- (((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
:background "darkseagreen2")
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
:background "darkolivegreen")
+ (((class color) (min-colors 16) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 16) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 8))
+ :background "green" :foreground "black")
(t :inverse-video t))
"Basic face for highlighting."
:group 'basic-faces)
(defface secondary-selection
- '((((type tty) (class color))
- :background "cyan" :foreground "black")
- (((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
:background "yellow")
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
+ :background "SkyBlue4")
+ (((class color) (min-colors 16) (background light))
+ :background "yellow")
+ (((class color) (min-colors 16) (background dark))
:background "SkyBlue4")
+ (((class color) (min-colors 8))
+ :background "cyan" :foreground "black")
(t :inverse-video t))
"Basic face for displaying the secondary selection."
:group 'basic-faces)
(provide 'faces)
+;;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
;;; faces.el ends here