;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
"*A list specifying how face font selection chooses fonts.
Each of the four symbols `:width', `:height', `:weight', and `:slant'
must appear once in the list, and the list must not contain any other
-elements. Font selection tries to find a best matching font for
-those face attributes first that appear first in the list. For
+elements. Font selection first tries to find a best matching font
+for those face attributes that appear before in the list. For
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."
(save-excursion
(set-buffer standard-output)
(dolist (f face)
+ (if (stringp f) (setq f (intern f)))
(insert "Face: " (symbol-name f))
(if (not (facep f))
(insert " undefined face.\n")
(defun face-spec-set (face spec &optional frame)
"Set FACE's attributes according to the first matching entry in SPEC.
FRAME is the frame whose frame-local face is set. FRAME nil means
-do it on all frames. See `defface' for information about SPEC.
-If SPEC is nil, do nothing."
+do it on all frames (and change the default for new frames).
+See `defface' for information about SPEC. If SPEC is nil, do nothing."
(let ((attrs (face-spec-choose spec frame)))
(when spec
- (face-spec-reset-face face frame))
+ (face-spec-reset-face face (or frame t)))
(while attrs
(let ((attribute (car attrs))
(value (car (cdr attrs))))
;; Support some old-style attribute names and values.
(case attribute
- (:bold (setq attribute :weight value (if value 'bold 'normal)))
- (:italic (setq attribute :slant value (if value 'italic 'normal)))
- ((:foreground :background)
- ;; Compatibility with 20.x. Some bogus face specs seem to
- ;; exist containing things like `:foreground nil'.
- (if (null value) (setq value 'unspecified)))
- (t (unless (assq attribute face-x-resources)
- (setq attribute nil))))
+ (:bold (setq attribute :weight value (if value 'bold 'normal)))
+ (:italic (setq attribute :slant value (if value 'italic 'normal)))
+ ((:foreground :background)
+ ;; Compatibility with 20.x. Some bogus face specs seem to
+ ;; exist containing things like `:foreground nil'.
+ (if (null value) (setq value 'unspecified)))
+ (t (unless (assq attribute face-x-resources)
+ (setq attribute nil))))
(when attribute
- (set-face-attribute face frame attribute value)))
+ ;; If frame is nil, set the default for new frames.
+ ;; Existing frames are handled below.
+ (set-face-attribute face (or frame t) attribute value)))
(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 (or (get face 'face-alias) face) 'face-modified nil)))
+ (unless frame
+ ;; When we reset the face based on its spec, then it is unmodified
+ ;; as far as Custom is concerned.
+ (put (or (get face 'face-alias) face) 'face-modified nil)
+ ;; Set each frame according to the rules implied by SPEC.
+ (dolist (frame (frame-list))
+ (face-spec-set face spec frame))))
(defun face-attr-match-p (face attrs &optional frame)
(get face 'saved-face)
(face-default-spec face)))
+(defsubst face-normalize-spec (spec)
+ "Return a normalized face-spec of SPEC."
+ (let (normalized-spec)
+ (while spec
+ (let ((attribute (car spec))
+ (value (car (cdr spec))))
+ ;; Support some old-style attribute names and values.
+ (case attribute
+ (:bold (setq attribute :weight value (if value 'bold 'normal)))
+ (:italic (setq attribute :slant value (if value 'italic 'normal)))
+ ((:foreground :background)
+ ;; Compatibility with 20.x. Some bogus face specs seem to
+ ;; exist containing things like `:foreground nil'.
+ (if (null value) (setq value 'unspecified)))
+ (t (unless (assq attribute face-x-resources)
+ (setq attribute nil))))
+ (when attribute
+ (push attribute normalized-spec)
+ (push value normalized-spec)))
+ (setq spec (cdr (cdr spec))))
+ (nreverse normalized-spec)))
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Frame-type independent color support.
;; be unmodified, so we can avoid consing in the common case.
(dolist (face (face-list))
(when (not (face-spec-match-p face
- (face-user-default-spec face)
+ (face-normalize-spec
+ (face-user-default-spec face))
(selected-frame)))
(push face locally-modified-faces)))
;; Now change to the new frame parameters
(defun tty-set-up-initial-frame-faces ()
(let ((frame (selected-frame)))
(frame-set-background-mode frame)
- (face-set-after-frame-default frame)
- (set-frame-parameter frame-initial-frame 'term-environment-variable
- (getenv "TERM"))
- (set-frame-parameter frame-initial-frame 'display-environment-variable
- (getenv "DISPLAY"))))
+ (face-set-after-frame-default frame)))