;;; faces.el --- Lisp faces
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(defun face-list ()
- "Return a list of all defined face names."
+ "Return a list of all defined faces."
(mapcar #'car face-new-frame-defaults))
-
-;;; ### If not frame-local initialize by what X resources?
-
(defun make-face (face &optional no-init-from-resources)
"Define a new face with name FACE, a symbol.
-NO-INIT-FROM-RESOURCES non-nil means don't initialize frame-local
-variants of FACE from X resources. (X resources recognized are found
-in the global variable `face-x-resources'.) If FACE is already known
-as a face, leave it unmodified. Value is FACE."
+Do not call this directly from Lisp code; use `defface' instead.
+
+If NO-INIT-FROM-RESOURCES is non-nil, don't initialize face
+attributes from X resources. If FACE is already known as a face,
+leave it unmodified. Return FACE."
(interactive (list (read-from-minibuffer
"Make face: " nil nil t 'face-name-history)))
(unless (facep face)
(make-face-x-resource-internal face)))
face)
-
(defun make-empty-face (face)
"Define a new, empty face with name FACE.
-If the face already exists, it is left unmodified. Value is FACE."
+Do not call this directly from Lisp code; use `defface' instead."
(interactive (list (read-from-minibuffer
"Make empty face: " nil nil t 'face-name-history)))
(make-face face 'no-init-from-resources))
-
(defun copy-face (old-face new-face &optional frame new-frame)
- "Define a face just like OLD-FACE, with name NEW-FACE.
-
-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
-changed on FRAME only.
-If FRAME is t, the frame-independent default specification for OLD-FACE
-is copied to NEW-FACE.
-If FRAME is nil, copying is done for the frame-independent defaults
-and for each existing frame.
-
-If the optional fourth argument NEW-FRAME is given,
-copy the information from face OLD-FACE on frame FRAME
-to NEW-FACE on frame NEW-FRAME. In this case, FRAME may not be nil."
+ "Define a face named NEW-FACE, which is a copy of OLD-FACE.
+This function does not copy face customization data, so NEW-FACE
+will not be made customizable. Most Lisp code should not call
+this function; use `defface' with :inherit instead.
+
+If NEW-FACE already exists as a face, modify it to be like
+OLD-FACE. If NEW-FACE doesn't already exist, create it.
+
+If the optional argument FRAME is a frame, change NEW-FACE on
+FRAME only. If FRAME is t, copy the frame-independent default
+specification for OLD-FACE to NEW-FACE. If FRAME is nil, copy
+the defaults as well as the faces on each existing frame.
+
+If the optional fourth argument NEW-FRAME is given, copy the
+information from face OLD-FACE on frame FRAME to NEW-FACE on
+frame NEW-FRAME. In this case, FRAME must not be nil."
(let ((inhibit-quit t))
(if (null frame)
(progn
;; of realized faces. The ID assigned to Lisp faces is used to
;; support faces in display table entries.
-(defun face-id (face &optional frame)
+(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
(defun set-face-attribute (face frame &rest args)
"Set attributes of FACE on FRAME from ARGS.
-FRAME nil means change attributes on all frames. FRAME t means change
-the default for new frames (this is done automatically each time an
-attribute is changed on all frames).
+If FRAME is nil this function sets the attributes for all
+existing frames, and the default for new frames. If FRAME is t,
+change the default for new frames (this is done automatically
+each time an 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';
`:height'
-VALUE must be either an integer specifying the height of the font to use
-in 1/10 pt, a floating point number specifying the amount by which to
-scale any underlying face, or a function, which is called with the old
-height (from the underlying face), and should return the new height.
+VALUE specifies the height of the font, in either absolute or relative
+terms. An absolute height is an integer, and specifies font height in
+units of 1/10 pt. A relative height is either a floating point number,
+which specifies a scaling factor for the underlying face height;
+or a function that takes a single argument (the underlying face height)
+and returns the new height. Note that for the `default' face,
+you can only specify an absolute height (since there is nothing
+for it to be relative to).
`:weight'
where))
(setq args (cddr args)))))
-(defun make-face-bold (face &optional frame noerror)
+(defun make-face-bold (face &optional frame _noerror)
"Make the font of FACE be bold, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
(set-face-attribute face frame :weight 'bold))
-(defun make-face-unbold (face &optional frame noerror)
+(defun make-face-unbold (face &optional frame _noerror)
"Make the font of FACE be non-bold, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
(set-face-attribute face frame :weight 'normal))
-(defun make-face-italic (face &optional frame noerror)
+(defun make-face-italic (face &optional frame _noerror)
"Make the font of FACE be italic, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
(set-face-attribute face frame :slant 'italic))
-(defun make-face-unitalic (face &optional frame noerror)
+(defun make-face-unitalic (face &optional frame _noerror)
"Make the font of FACE be non-italic, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
(set-face-attribute face frame :slant 'normal))
-(defun make-face-bold-italic (face &optional frame noerror)
+(defun make-face-bold-italic (face &optional frame _noerror)
"Make the font of FACE be bold and italic, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
(insert
(substitute-command-keys
(concat
- "Use "
+ "\\<help-mode-map>Use "
(if (display-mouse-p) "\\[help-follow-mouse] or ")
"\\[help-follow] on a face name to customize it\n"
"or on its sample text for a description of the face.\n\n")))
;; Parameter FRAME Is kept for call compatibility to with previous
;; face implementation.
-(defun face-attr-construct (face &optional frame)
- "Return a `defface'-style attribute list for FACE on FRAME.
+(defun face-attr-construct (face &optional _frame)
+ "Return a `defface'-style attribute list for FACE.
Value is a property list of pairs ATTRIBUTE VALUE for all specified
face attributes of FACE where ATTRIBUTE is the attribute name and
-VALUE is the specified value of that attribute."
+VALUE is the specified value of that attribute.
+Argument FRAME is ignored and retained for compatibility."
(let (result)
(dolist (entry face-attribute-name-alist result)
(let* ((attribute (car entry))
options (cdr conjunct)
match (cond ((eq req 'type)
(or (memq (window-system frame) options)
+ (and (memq 'graphic options)
+ (memq (window-system frame) '(x w32 ns)))
;; FIXME: This should be revisited to use
;; display-graphic-p, provided that the
;; color selection depends on the number
;; of supported colors, and all defface's
;; are changed to look at number of colors
;; instead of (type graphic) etc.
- (and (null (window-system frame))
- (memq 'tty options))
- (and (memq 'motif options)
- (featurep 'motif))
- (and (memq 'gtk options)
- (featurep 'gtk))
- (and (memq 'lucid options)
- (featurep 'x-toolkit)
- (not (featurep 'motif))
- (not (featurep 'gtk)))
- (and (memq 'x-toolkit options)
- (featurep 'x-toolkit))))
+ (if (null (window-system frame))
+ (memq 'tty options)
+ (or (and (memq 'motif options)
+ (featurep 'motif))
+ (and (memq 'gtk options)
+ (featurep 'gtk))
+ (and (memq 'lucid options)
+ (featurep 'x-toolkit)
+ (not (featurep 'motif))
+ (not (featurep 'gtk)))
+ (and (memq 'x-toolkit options)
+ (featurep 'x-toolkit))))))
((eq req 'min-colors)
(>= (display-color-cells frame) (car options)))
((eq req 'class)
(defun face-spec-reset-face (face &optional frame)
"Reset all attributes of FACE on FRAME to unspecified."
- (let (reset-args)
- (dolist (attr-and-name face-attribute-name-alist)
- (push 'unspecified reset-args)
- (push (car attr-and-name) reset-args))
- (apply 'set-face-attribute face frame reset-args)))
+ (apply 'set-face-attribute face frame
+ (if (eq face 'default)
+ ;; For the default face, avoid making any attribute
+ ;; unspecified. Instead, set attributes to default values
+ ;; (see also realize_default_face in xfaces.c).
+ (append
+ '(:underline nil :overline nil :strike-through nil
+ :box nil :inverse-video nil :stipple nil :inherit nil)
+ ;; `display-graphic-p' is unavailable when running
+ ;; temacs, prior to loading frame.el.
+ (unless (and (fboundp 'display-graphic-p)
+ (display-graphic-p frame))
+ '(:family "default" :foundry "default" :width normal
+ :height 1 :weight normal :slant normal
+ :foreground "unspecified-fg"
+ :background "unspecified-bg")))
+ ;; For all other faces, unspecify all attributes.
+ (apply 'append
+ (mapcar (lambda (x) (list (car x) 'unspecified))
+ face-attribute-name-alist)))))
(defun face-spec-set (face spec &optional for-defface)
"Set FACE's face spec, which controls its appearance, to SPEC.
is used. If nil or omitted, use the selected frame."
(unless frame
(setq frame (selected-frame)))
- (let ((list face-attribute-name-alist)
- (match t))
+ (let* ((list face-attribute-name-alist)
+ (match t)
+ (bold (and (plist-member attrs :bold)
+ (not (plist-member attrs :weight))))
+ (italic (and (plist-member attrs :italic)
+ (not (plist-member attrs :slant))))
+ (plist (if (or bold italic)
+ (copy-sequence attrs)
+ attrs)))
+ ;; Handle the Emacs 20 :bold and :italic properties.
+ (if bold
+ (plist-put plist :weight (if bold 'bold 'normal)))
+ (if italic
+ (plist-put plist :slant (if italic 'italic 'normal)))
(while (and match list)
(let* ((attr (caar list))
(specified-value
- (if (plist-member attrs attr)
- (plist-get attrs attr)
+ (if (plist-member plist attr)
+ (plist-get plist attr)
'unspecified))
(value-now (face-attribute face attr frame)))
(setq match (equal specified-value value-now))
(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 to 65280 or 65535, depending
-on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\).
+COLOR should be a string naming a color (e.g. \"white\"), or a
+string specifying a color's RGB components (e.g. \"#ff12ec\").
+
+Return a list of three integers, (RED GREEN BLUE), each between 0
+and either 65280 or 65535 (the maximum depends on the system).
+Use `color-name-to-rgb' if you want RGB floating-point values
+normalized to 1.0.
+
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
-\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
- (if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
- nil
- (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
- (xw-color-values color frame)
- (tty-color-values color frame))))
+
+COLOR can also be the symbol `unspecified' or one of the strings
+\"unspecified-fg\" or \"unspecified-bg\", in which case the
+return value is nil."
+ (cond
+ ((member color '(unspecified "unspecified-fg" "unspecified-bg"))
+ nil)
+ ((memq (framep (or frame (selected-frame))) '(x w32 ns))
+ (xw-color-values color frame))
+ (t
+ (tty-color-values color frame))))
+
(defalias 'x-color-values 'color-values)
(declare-function xw-display-color-p "xfns.c" (&optional terminal))
(> (tty-color-gray-shades display) 2)))))
(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
- "Read a color name or RGB triplet of the form \"#RRRRGGGGBBBB\".
+ "Read a color name or RGB triplet.
Completion is available for color names, but not for RGB triplets.
-RGB triplets have the form #XXXXXXXXXXXX, where each X is a hex
-digit. The number of Xs must be a multiple of 3, with the same
-number of Xs for each of red, green, and blue. The order is red,
-green, blue.
+RGB triplets have the form \"#RRGGBB\". Each of the R, G, and B
+components can have one to four digits, but all three components
+must have the same number of digits. Each digit is a hex value
+between 0 and F; either upper case or lower case for A through F
+are acceptable.
In addition to standard color names and RGB hex values, the
following are available as color candidates. In each case, the
((eq flag 'lambda) ; Test completion.
(or (memq string colors)
(color-defined-p string)))))
- nil t))
- hex-string)
+ nil t)))
;; Process named colors.
(when (member color colors)
(cond ((memq 'background-color face) (cdr (memq 'background-color face)))
((memq ':background face) (cadr (memq ':background face)))))
(t nil)))) ; Invalid face value.
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Background mode.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(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 (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 (const dark)
- (const light)
- (const :tag "automatic" nil)))
-
-
-(declare-function x-get-resource "frame.c"
- (attribute class &optional component subclass))
-
-(defvar inhibit-frame-set-background-mode nil)
-
-(defun frame-set-background-mode (frame &optional keep-face-specs)
- "Set up display-dependent faces on FRAME.
-Display-dependent faces are those which have different definitions
-according to the `background-mode' and `display-type' frame parameters.
-
-If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
-face specs for the new background mode."
- (unless inhibit-frame-set-background-mode
- (let* ((bg-resource
- (and (window-system frame)
- (x-get-resource "backgroundMode" "BackgroundMode")))
- (bg-color (frame-parameter frame 'background-color))
- (terminal-bg-mode (terminal-parameter frame 'background-mode))
- (tty-type (tty-type frame))
- (default-bg-mode
- (if (or (window-system frame)
- (and tty-type
- (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
- tty-type)))
- 'light
- 'dark))
- (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
- (bg-mode
- (cond (frame-background-mode)
- (bg-resource (intern (downcase bg-resource)))
- (terminal-bg-mode)
- ((equal bg-color "unspecified-fg") ; inverted colors
- non-default-bg-mode)
- ((not (color-values bg-color frame))
- default-bg-mode)
- ((>= (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 '+ (color-values "white" frame)) .6))
- 'light)
- (t 'dark)))
- (display-type
- (cond ((null (window-system frame))
- (if (tty-display-color-p frame) 'color 'mono))
- ((display-color-p frame)
- 'color)
- ((x-display-grayscale-p frame)
- 'grayscale)
- (t 'mono)))
- (old-bg-mode
- (frame-parameter frame 'background-mode))
- (old-display-type
- (frame-parameter frame 'display-type)))
-
- (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
- (let ((locally-modified-faces nil)
- ;; Prevent face-spec-recalc from calling this function
- ;; again, resulting in a loop (bug#911).
- (inhibit-frame-set-background-mode t)
- (params (list (cons 'background-mode bg-mode)
- (cons 'display-type display-type))))
- (if keep-face-specs
- (modify-frame-parameters frame params)
- ;; If we are recomputing face specs, first collect a list
- ;; of faces that don't match their face-specs. These are
- ;; the faces modified on FRAME, and we avoid changing them
- ;; below. Use a negative list to avoid consing (we assume
- ;; most faces are unmodified).
- (dolist (face (face-list))
- (and (not (get face 'face-override-spec))
- (not (face-spec-match-p face
- (face-user-default-spec face)
- (selected-frame)))
- (push face locally-modified-faces)))
- ;; Now change to the new frame parameters
- (modify-frame-parameters frame params)
- ;; For all unmodified named faces, choose face specs
- ;; matching the new frame parameters.
- (dolist (face (face-list))
- (unless (memq face locally-modified-faces)
- (face-spec-recalc face frame)))))))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
(let ((window-system-p (memq (window-system frame) '(x w32))))
- (dolist (face (nreverse (face-list))) ;Why reverse? --Stef
+ ;; The `reverse' is so that `default' goes first.
+ (dolist (face (nreverse (face-list)))
(condition-case ()
(progn
;; Initialize faces from face spec and custom theme.
(face-spec-recalc face frame)
- ;; X resouces for the default face are applied during
+ ;; X resources for the default face are applied during
;; `x-create-frame'.
(and (not (eq face 'default)) window-system-p
(make-face-x-resource-internal face frame))
(((supports :underline t))
:underline t)
(t
- ;; default to italic, even it doesn't appear to be supported,
- ;; because in some cases the display engine will do it's own
- ;; workaround (to `dim' on ttys)
+ ;; Default to italic, even if it doesn't appear to be supported,
+ ;; because in some cases the display engine will do its own
+ ;; workaround (to `dim' on ttys).
:slant italic))
"Basic italic face."
:group 'basic-faces)
(defface link
'((((class color) (min-colors 88) (background light))
- :foreground "blue1" :underline t)
+ :foreground "RoyalBlue3" :underline t)
(((class color) (background light))
:foreground "blue" :underline t)
(((class color) (min-colors 88) (background dark))
'((((background light)) :background "black")
(((background dark)) :background "white"))
"Basic face for the cursor color under X.
+Currently, only the `:background' attribute is meaningful; all
+other attributes are ignored. The cursor foreground color is
+taken from the background color of the underlying text.
+
Note: Other faces cannot inherit from the cursor face."
:version "21.1"
:group 'cursor
It is used for characters of no fonts too."
:version "24.1"
:group 'basic-faces)
+
+(defface error
+ '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
+ (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
+ (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
+ (((class color) (min-colors 8)) (:foreground "red"))
+ (t (:inverse-video t :weight bold)))
+ "Basic face used to highlight errors and to denote failure."
+ :version "24.1"
+ :group 'basic-faces)
+
+(defface warning
+ '((((class color) (min-colors 16)) (:foreground "DarkOrange" :weight bold))
+ (((class color)) (:foreground "yellow" :weight bold))
+ (t (:weight bold)))
+ "Basic face used to highlight warnings."
+ :version "24.1"
+ :group 'basic-faces)
+
+(defface success
+ '((((class color) (min-colors 16) (background light))
+ (:foreground "ForestGreen" :weight bold))
+ (((class color) (min-colors 88) (background dark))
+ (:foreground "Green1" :weight bold))
+ (((class color) (min-colors 16) (background dark))
+ (:foreground "Green" :weight bold))
+ (((class color)) (:foreground "green" :weight bold))
+ (t (:weight bold)))
+ "Basic face used to indicate successful operation."
+ :version "24.1"
+ :group 'basic-faces)
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Manipulating font names.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This is here for compatibilty with Emacs 20.2. For example,
+;; This is here for compatibility with Emacs 20.2. For example,
;; international/fontset.el uses x-resolve-font-name. The following
;; functions are not used in the face implementation itself.
HCoop / bpt / emacs.git / blobdiff