X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d52969e8afaa19ed1acc01f4ff0bb651bf7869a7..e66ba1dfc4cf2e12100191d2c24436c42d097268:/lisp/faces.el diff --git a/lisp/faces.el b/lisp/faces.el index a46ee6c93f..21193589de 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,8 +1,6 @@ ;;; 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-2011 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -121,7 +119,7 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." (defun face-list () - "Return a list of all defined face names." + "Return a list of all defined faces." (mapcar #'car face-new-frame-defaults)) @@ -209,7 +207,7 @@ Value is FACE." ;; 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 @@ -590,10 +588,14 @@ It must be one of the symbols `ultra-condensed', `extra-condensed', `: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' @@ -722,7 +724,7 @@ like an underlying face would be, with higher priority than underlying faces." 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. @@ -731,7 +733,7 @@ Use `set-face-attribute' for finer control of the font weight." (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." @@ -739,7 +741,7 @@ 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. @@ -748,7 +750,7 @@ Use `set-face-attribute' for finer control of the font slant." (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." @@ -756,7 +758,7 @@ 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. @@ -1253,7 +1255,7 @@ arg, prompt for a regular expression." (insert (substitute-command-keys (concat - "Use " + "\\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"))) @@ -1411,11 +1413,12 @@ If FRAME is omitted or nil, use the selected frame." ;; 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)) @@ -1442,24 +1445,26 @@ If FRAME is nil, the current FRAME is used." 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) @@ -1575,13 +1580,25 @@ Optional parameter FRAME is the frame whose definition of FACE 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)) @@ -1639,18 +1656,28 @@ If COLOR is the symbol `unspecified' or one of the strings (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)) @@ -1677,13 +1704,14 @@ If omitted or nil, that stands for the selected frame's display." (> (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 @@ -1726,8 +1754,7 @@ resulting color name in the echo area." ((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) @@ -1797,109 +1824,6 @@ Return nil if it has no specified face." (cond ((memq 'background-color face) (cdr (memq 'background-color face))) ((memq ':background face) (cadr (memq ':background face))))) (t nil)))) ; Invalid face value. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1996,12 +1920,13 @@ settings, X resources, and `face-new-frame-defaults'. 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)) @@ -2141,9 +2066,9 @@ terminal type to a different value." (((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) @@ -2187,7 +2112,7 @@ terminal type to a different value." (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)) @@ -2442,6 +2367,10 @@ used to display the prompt text." '((((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 @@ -2491,12 +2420,45 @@ Note: Other faces cannot inherit from the cursor face." 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) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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.