;; 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."
(defun internal-find-face (name &optional frame)
"Retrieve the face named NAME.
Return nil if there is no such face.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
+If NAME is already a face, it is simply returned.
+The optional argument FRAME is ignored."
(facep name))
(make-obsolete 'internal-find-face 'facep "21.1")
(defun internal-get-face (name &optional frame)
"Retrieve the face named NAME; error if there is none.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
+If NAME is already a face, it is simply returned.
+The optional argument FRAME is ignored."
(or (facep name)
(check-face name)))
(make-obsolete 'internal-get-face "see `facep' and `check-face'." "21.1")
(defun face-id (face &optional frame)
"Return the internal ID of face with name FACE.
+If FACE is a face-alias, return the ID of the target face.
The optional argument FRAME is ignored, since the internal face ID
of a face name is the same for all frames."
(check-face face)
- (get face 'face))
-
+ (or (get face 'face)
+ (face-id (get face 'face-alias))))
(defun face-equal (face1 face2 &optional frame)
"Non-nil if faces FACE1 and FACE2 are equal.
If FRAME is omitted or nil, use the selected frame."
(let ((attrs
'(:family :width :height :weight :slant :foreground
- :foreground :background :underline :overline
- :strike-through :box :inverse-video))
+ :background :underline :overline :strike-through
+ :box :inverse-video))
(differs nil))
(while (and attrs (not differs))
(let* ((attr (pop attrs))
(set-face-attribute face frame :stipple (or stipple 'unspecified)))
-(defun set-face-underline-p (face underline-p &optional frame)
+(defun set-face-underline-p (face underline &optional frame)
"Specify whether face FACE is underlined.
UNDERLINE nil means FACE explicitly doesn't underline.
UNDERLINE non-nil means FACE explicitly does underlining
(interactive
(let ((list (read-face-and-attribute :underline)))
(list (car list) (eq (car (cdr list)) t))))
- (set-face-attribute face frame :underline underline-p))
+ (set-face-attribute face frame :underline underline))
(define-obsolete-function-alias 'set-face-underline
'set-face-underline-p "22.1")
(nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
(mapcar #'(lambda (c) (cons c c))
- (x-defined-colors frame)))
+ (defined-colors frame)))
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
((:foreground :background)
result))))))
(defun modify-face (&optional face foreground background stipple
- bold-p italic-p underline-p inverse-p frame)
+ bold-p italic-p underline inverse-p frame)
"Modify attributes of faces interactively.
If optional argument FRAME is nil or omitted, modify the face used
for newly created frame, i.e. the global face.
:stipple stipple
:bold bold-p
:italic italic-p
- :underline underline-p
+ :underline underline
:inverse-video inverse-p)
(setq face (read-face-name "Modify face"))
(apply #'set-face-attribute face frame
(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.
(defun color-values (color &optional frame)
"Return a description of the color named COLOR on frame FRAME.
-The value is a list of integer RGB values--\(RED GREEN BLUE\).
-These values appear to range from 0 65535; white is \(65535 65535 65535\).
+The value is a list of integer RGB values--(RED GREEN BLUE).
+These values appear to range from 0 to 65280 or 65535, depending
+on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\).
If FRAME is omitted or nil, use the selected frame.
If FRAME cannot display COLOR, the value is nil.
If COLOR is the symbol `unspecified' or one of the strings
tty-type))
'dark
'light))
- ((>= (apply '+ (x-color-values bg-color frame))
+ ((>= (apply '+ (color-values bg-color frame))
;; Just looking at the screen, colors whose
;; values add up to .6 of the white total
;; still look dark to me.
- (* (apply '+ (x-color-values "white" frame)) .6))
+ (* (apply '+ (color-values "white" frame)) .6))
'light)
(t 'dark)))
(display-type
(cond ((null (window-system frame))
(if (tty-display-color-p frame) 'color 'mono))
- ((x-display-color-p frame)
+ ((display-color-p frame)
'color)
((x-display-grayscale-p frame)
'grayscale)
;; 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
(face-attribute 'default :weight t))
(set-face-attribute 'default frame :width
(face-attribute 'default :width t))))
- (dolist (face (face-list))
- ;; 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 frame) '(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)
- (border-color border :background)
- (cursor-color cursor :background)
- (scroll-bar-foreground scroll-bar :foreground)
- (scroll-bar-background scroll-bar :background)
- (mouse-color mouse :background))))
- (dolist (param params)
- (let ((frame-param (frame-parameter frame (nth 0 param)))
- (face (nth 1 param))
- (attr (nth 2 param)))
- (when (and frame-param
- ;; Don't override face attributes explicitly
- ;; specified for new frames.
- (eq (face-attribute face attr t) 'unspecified))
- (set-face-attribute face frame attr frame-param))))))
-
+ ;; Find attributes that should be initialized from frame parameters.
+ (let ((face-params '((foreground-color default :foreground)
+ (background-color default :background)
+ (border-color border :background)
+ (cursor-color cursor :background)
+ (scroll-bar-foreground scroll-bar :foreground)
+ (scroll-bar-background scroll-bar :background)
+ (mouse-color mouse :background)))
+ apply-params)
+ (dolist (param face-params)
+ (let* ((value (frame-parameter frame (nth 0 param)))
+ (face (nth 1 param))
+ (attr (nth 2 param))
+ (default-value (face-attribute face attr t)))
+ ;; Compile a list of face attributes to set, but don't set
+ ;; them yet. The call to make-face-x-resource-internal,
+ ;; below, can change frame parameters, and the final set of
+ ;; frame parameters should be the ones acquired at this step.
+ (if (eq default-value 'unspecified)
+ ;; The face spec does not specify a new-frame value for
+ ;; this attribute. Check if the existing frame parameter
+ ;; specifies it.
+ (if value
+ (push (list face frame attr value) apply-params))
+ ;; The face spec specifies a value for this attribute, to be
+ ;; applied to the face on all new frames.
+ (push (list face frame attr default-value) apply-params))))
+ ;; Initialize faces from face specs and X resources. The
+ ;; condition-case prevents invalid specs from causing frame
+ ;; creation to fail.
+ (dolist (face (delq 'default (face-list)))
+ (condition-case ()
+ (progn
+ (face-spec-set face (face-user-default-spec face) frame)
+ (if (memq (window-system frame) '(x w32 mac))
+ (make-face-x-resource-internal face frame))
+ (internal-merge-in-global-face face frame))
+ (error nil)))
+ ;; Apply the attributes specified by frame parameters. This
+ ;; rewrites parameters changed by make-face-x-resource-internal
+ (dolist (param apply-params)
+ (apply 'set-face-attribute param))))
(defun tty-handle-reverse-video (frame parameters)
"Handle the reverse-video frame parameter for terminal frames."
:version "22.1"
:group 'basic-faces)
-(defface momentary
- '((t (:inherit mode-line)))
- "Face for momentarily displaying text in the current buffer."
- :version "22.1"
- :group 'basic-faces)
-
(defface minibuffer-prompt
'((((background dark)) :foreground "cyan")
;; Don't use blue because many users of the MS-DOS port customize
;; their foreground color to be blue.
(((type pc)) :foreground "magenta")
- (t :foreground "dark blue"))
+ (t :foreground "medium blue"))
"Face for minibuffer prompts.
By default, Emacs automatically adds this face to the value of
`minibuffer-prompt-properties', which is a list of text properties