;;; faces.el --- Lisp faces
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(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")
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))
;; VALUE is relative, so merge with inherited faces
(let ((inh-from (face-attribute face :inherit frame)))
(unless (or (null inh-from) (eq inh-from 'unspecified))
- (setq value
- (face-attribute-merged-with attribute value inh-from frame)))))
+ (condition-case nil
+ (setq value
+ (face-attribute-merged-with attribute value inh-from frame))
+ ;; The `inherit' attribute may point to non existent faces.
+ (error nil)))))
(when (and inherit
(not (eq inherit t))
(face-attribute-relative-p attribute value))
attribute is changed on all frames).
ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid
-face attribute name. All attributes can be set to `unspecified';
+face attribute name. All attributes can be set to `unspecified';
this fact is not further mentioned below.
The following attributes are recognized:
(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")
(defun read-face-name (prompt &optional string-describing-default multiple)
"Read a face, defaulting to the face or faces on the char after point.
-If it has a `read-face-name' property, that overrides the `face' property.
-PROMPT describes what you will do with the face (don't end in a space).
-STRING-DESCRIBING-DEFAULT describes what default you will use
-if this function returns nil.
+If it has the property `read-face-name', that overrides the `face' property.
+PROMPT should be a string that describes what the caller will do with the face;
+it should not end in a space.
+STRING-DESCRIBING-DEFAULT should describe what default the caller will use if
+the user just types RET; you can omit it.
If MULTIPLE is non-nil, return a list of faces (possibly only one).
Otherwise, return a single face."
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(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)
(format "%s for face `%s' (default %s): "
name face default)
(format "%s for face `%s': " name face))
- completion-alist)))
+ completion-alist nil nil nil nil default)))
(if (equal value "") default value)))
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
(insert " undefined face.\n")
(let ((customize-label "customize this face")
file-name)
+ (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
(princ (concat " (" customize-label ")\n"))
(insert "Documentation: "
(or (face-documentation f)
do it on all frames. See `defface' for information about SPEC.
If SPEC is nil, do nothing."
(let ((attrs (face-spec-choose spec frame)))
- (when attrs
+ (when spec
(face-spec-reset-face face frame))
(while attrs
(let ((attribute (car attrs))
"Return a list of colors supported for a particular frame.
The argument FRAME specifies which frame to try.
The value may be different for frames on different display types.
-If FRAME doesn't support colors, the value is nil."
+If FRAME doesn't support colors, the value is nil.
+If FRAME is nil, that stands for the selected frame."
(if (memq (framep (or frame (selected-frame))) '(x w32 mac))
(xw-defined-colors frame)
(mapcar 'car (tty-color-alist frame))))
(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\).
+These values range from 0 to 65535; white is \(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
(defcustom frame-background-mode nil
"*The brightness of the background.
Set this to the symbol `dark' if your background color is dark,
-`light' if your background is light, or nil (default) if you want Emacs
-to examine the brightness for you. Don't set this variable with `setq';
-this won't have the expected effect."
+`light' if your background is light, or nil (automatic by default)
+if you want Emacs to examine the brightness for you. Don't set this
+variable with `setq'; this won't have the expected effect."
:group 'faces
:set #'(lambda (var value)
(set-default var value)
(mapc 'frame-set-background-mode (frame-list)))
:initialize 'custom-initialize-changed
- :type '(choice (choice-item dark)
- (choice-item light)
- (choice-item :tag "default" nil)))
+ :type '(choice (const dark)
+ (const light)
+ (const :tag "automatic" nil)))
(defvar default-frame-background-mode nil
"Internal variable for the default brightness of the background.
(or default-frame-background-mode 'dark))
((equal bg-color "unspecified-fg") ; inverted colors
(if (eq default-frame-background-mode 'light) '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)
(if (tty-display-color-p frame) 'color 'mono))
- ((x-display-color-p frame)
+ ((display-color-p frame)
'color)
((x-display-grayscale-p frame)
'grayscale)
(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 '(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)
+ (internal-merge-in-global-face face frame)
+ (if (memq window-system '(x w32 mac))
+ (make-face-x-resource-internal 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."
:group 'basic-faces
:version "22.1")
+(defface link
+ '((((class color) (min-colors 88) (background light))
+ :foreground "blue1" :underline t)
+ (((class color) (background light))
+ :foreground "blue" :underline t)
+ (((class color) (min-colors 88) (background dark))
+ :foreground "cyan1" :underline t)
+ (((class color) (background dark))
+ :foreground "cyan" :underline t)
+ (t :inherit underline))
+ "Basic face for unvisited links."
+ :group 'basic-faces
+ :version "22.1")
+
+(defface link-visited
+ '((default :inherit link)
+ (((class color) (background light)) :foreground "magenta4")
+ (((class color) (background dark)) :foreground "violet"))
+ "Basic face for visited links."
+ :group 'basic-faces
+ :version "22.1")
+
(defface highlight
'((((class color) (min-colors 88) (background light))
:background "darkseagreen2")
"Basic face for highlighting."
:group 'basic-faces)
-(defface mode-line-highlight
- '((((class color) (min-colors 88))
- :box (:line-width 2 :color "grey40" :style released-button))
- (t
- :inherit highlight))
- "Basic mode line face for highlighting."
- :version "22.1"
- :group 'modeline
- :group 'basic-faces)
-
(defface region
'((((class color) (min-colors 88) (background dark))
:background "blue3")
(t :inverse-video t))
"Basic face for highlighting trailing whitespace."
:version "21.1"
- :group 'whitespace ; like `show-trailing-whitespace'
+ :group 'whitespace-faces ; like `show-trailing-whitespace'
:group 'basic-faces)
(defface escape-glyph
;; red4 is too dark, but some say blue is too loud.
;; brown seems to work ok. -- rms.
(t :foreground "brown"))
- "Face for characters displayed as ^-sequences or \-sequences."
+ "Face for characters displayed as sequences using `^' or `\\'."
:group 'basic-faces
:version "22.1")
:group 'basic-faces
:version "22.1")
+(defgroup mode-line-faces nil
+ "Faces used in the mode line."
+ :group 'mode-line
+ :group 'faces
+ :version "22.1")
+
(defface mode-line
'((((class color) (min-colors 88))
:box (:line-width -1 :style released-button)
:inverse-video t))
"Basic mode line face for selected window."
:version "21.1"
- :group 'modeline
+ :group 'mode-line-faces
:group 'basic-faces)
(defface mode-line-inactive
:foreground "grey80" :background "grey30"))
"Basic mode line face for non-selected windows."
:version "22.1"
- :group 'modeline
+ :group 'mode-line-faces
+ :group 'basic-faces)
+
+(defface mode-line-highlight
+ '((((class color) (min-colors 88))
+ :box (:line-width 2 :color "grey40" :style released-button))
+ (t
+ :inherit highlight))
+ "Basic mode line face for highlighting."
+ :version "22.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+
+(defface mode-line-buffer-id
+ '((t (:weight bold)))
+ "Face used for buffer identification parts of the mode line."
+ :version "22.1"
+ :group 'mode-line-faces
:group 'basic-faces)
;; Make `modeline' an alias for `mode-line', for compatibility.
(put 'modeline 'face-alias 'mode-line)
(put 'modeline-inactive 'face-alias 'mode-line-inactive)
(put 'modeline-highlight 'face-alias 'mode-line-highlight)
+(put 'modeline-buffer-id 'face-alias 'mode-line-buffer-id)
(defface header-line
'((default
'((((type tty)) :inherit mode-line-inactive))
"Face used for vertical window dividers on ttys."
:version "22.1"
- :group 'modeline
+ :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
:group 'frames
:group 'basic-faces)
-(defface scroll-bar '()
+(defface scroll-bar '((t nil))
"Basic face for the scroll bar colors under X."
:version "21.1"
:group 'frames
:group 'basic-faces)
-(defface border '()
+(defface border '((t nil))
"Basic face for the frame border under X."
:version "21.1"
:group 'frames
:group 'basic-faces)
-(defface cursor '()
+(defface cursor '((t nil))
"Basic face for the cursor color under X.
Note: Other faces cannot inherit from the cursor face."
:version "21.1"
(put 'cursor 'face-no-inherit t)
-(defface mouse '()
+(defface mouse '((t nil))
"Basic face for the mouse color under X."
:version "21.1"
:group 'mouse