X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2ec1b5ee3464999a18b8197101e8bf08a3c564a8..fa7c3228b5868efb5789ad862ea29a59c265acd4:/lisp/faces.el diff --git a/lisp/faces.el b/lisp/faces.el index 83c7c8b2a0..302f8af35a 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,11 +1,10 @@ ;;; faces.el --- Lisp faces -;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992-1996, 1998-2011 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -29,7 +28,7 @@ (eval-when-compile (require 'cl)) -(declare-function xw-defined-colors "term/x-win" (&optional frame)) +(declare-function xw-defined-colors "term/common-win" (&optional frame)) (defvar help-xref-stack-item) @@ -185,33 +184,6 @@ to NEW-FACE on frame NEW-FRAME. In this case, FRAME may not be nil." (internal-copy-lisp-face old-face new-face frame new-frame)) new-face)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Obsolete functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; The functions in this section are defined because Lisp packages use -;; them, despite the prefix `internal-' suggesting that they are -;; private to the face implementation. - -(defun internal-find-face (name &optional frame) - "Retrieve the face named NAME. -Return nil if there is no such face. -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 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") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Predicates, type checks. @@ -235,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 @@ -376,7 +348,7 @@ FRAME nil or not specified means do it for all frames." (defun face-all-attributes (face &optional frame) "Return an alist stating the attributes of FACE. Each element of the result has the form (ATTR-NAME . ATTR-VALUE). -Normally the value describes the default attributes, +If FRAME is omitted or nil the value describes the default attributes, but if you specify FRAME, the value describes the attributes of FACE on FRAME." (mapcar (lambda (pair) @@ -616,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' @@ -748,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. @@ -757,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." @@ -765,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. @@ -774,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." @@ -782,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. @@ -1279,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"))) @@ -1437,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)) @@ -1474,18 +1451,18 @@ If FRAME is nil, the current FRAME is used." ;; 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) @@ -1533,12 +1510,11 @@ If SPEC is nil, return nil." (defun face-spec-reset-face (face &optional frame) "Reset all attributes of FACE on FRAME to unspecified." - (let ((attrs face-attribute-name-alist)) - (while attrs - (let ((attr-and-name (car attrs))) - (set-face-attribute face frame (car attr-and-name) 'unspecified)) - (setq attrs (cdr attrs))))) - + (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))) (defun face-spec-set (face spec &optional for-defface) "Set FACE's face spec, which controls its appearance, to SPEC. @@ -1602,20 +1578,32 @@ 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)) - (while (and match (not (null list))) - (let* ((attr (car (car list))) + (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)) (setq list (cdr list)))) match)) -(defun face-spec-match-p (face spec &optional frame) +(defsubst face-spec-match-p (face spec &optional frame) "Return t if FACE, on FRAME, matches what SPEC says it should look like." (face-attr-match-p face (face-spec-choose spec frame) frame)) @@ -1666,18 +1654,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)) @@ -1703,89 +1701,75 @@ If omitted or nil, that stands for the selected frame's display." (t (> (tty-color-gray-shades display) 2))))) -(defun read-color (&optional prompt convert-to-RGB-p allow-empty-name-p msg-p) - "Read a color name or RGB hex value: #RRRRGGGGBBBB. -Completion is available for color names, but not for RGB hex strings. -If the user inputs an RGB hex string, it must have the form -#XXXXXXXXXXXX or 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. +(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg) + "Read a color name or RGB triplet of the form \"#RRRRGGGGBBBB\". +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. -In addition to standard color names and RGB hex values, the following -are available as color candidates. In each case, the corresponding -color is used. +In addition to standard color names and RGB hex values, the +following are available as color candidates. In each case, the +corresponding color is used. * `foreground at point' - foreground under the cursor * `background at point' - background under the cursor -Checks input to be sure it represents a valid color. If not, raises -an error (but see exception for empty input with non-nil -ALLOW-EMPTY-NAME-P). - -Optional arg PROMPT is the prompt; if nil, uses a default prompt. +Optional arg PROMPT is the prompt; if nil, use a default prompt. -Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, converts -an input color name to an RGB hex string. Returns the RGB hex string. +Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, +convert an input color name to an RGB hex string. Return the RGB +hex string. -Optional arg ALLOW-EMPTY-NAME-P controls what happens if the user -enters an empty color name (that is, just hits `RET'). If non-nil, -then returns an empty color name, \"\". If nil, then raises an error. -Programs must test for \"\" if ALLOW-EMPTY-NAME-P is non-nil. They -can then perform an appropriate action in case of empty input. +If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed +to enter an empty color name (the empty string). -Interactively, or with optional arg MSG-P non-nil, echoes the color in -a message." +Interactively, or with optional arg MSG non-nil, print the +resulting color name in the echo area." (interactive "i\np\ni\np") ; Always convert to RGB interactively. (let* ((completion-ignore-case t) - (colors (append '("foreground at point" "background at point") - (defined-colors))) - (color (completing-read (or prompt "Color (name or #R+G+B+): ") - colors)) - hex-string) - (cond ((string= "foreground at point" color) - (setq color (foreground-color-at-point))) - ((string= "background at point" color) - (setq color (background-color-at-point)))) - (unless color - (setq color "")) - (setq hex-string - (string-match "^#?\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)) - (if (and allow-empty-name-p (string= "" color)) - "" - (when (and hex-string (not (eq (aref color 0) ?#))) - (setq color (concat "#" color))) ; No #; add it. - (unless hex-string - (when (or (string= "" color) (not (test-completion color colors))) - (error "No such color: %S" color)) - (when convert-to-RGB-p - (let ((components (x-color-values color))) - (unless components (error "No such color: %S" color)) - (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) - (setq color (format "#%04X%04X%04X" - (logand 65535 (nth 0 components)) - (logand 65535 (nth 1 components)) - (logand 65535 (nth 2 components)))))))) - (when msg-p (message "Color: `%s'" color)) - color))) - -;; Commented out because I decided it is better to include the -;; duplicates in read-color's completion list. - -;; (defun defined-colors-without-duplicates () -;; "Return the list of defined colors, without the no-space versions. -;; For each color name, we keep the variant that DOES have spaces." -;; (let ((result (copy-sequence (defined-colors))) -;; to-be-rejected) -;; (save-match-data -;; (dolist (this result) -;; (if (string-match " " this) -;; (push (replace-regexp-in-string " " "" -;; this) -;; to-be-rejected))) -;; (dolist (elt to-be-rejected) -;; (let ((as-found (car (member-ignore-case elt result)))) -;; (setq result (delete as-found result))))) -;; result)) + (colors (or facemenu-color-alist + (append '("foreground at point" "background at point") + (if allow-empty-name '("")) + (defined-colors)))) + (color (completing-read + (or prompt "Color (name or #RGB triplet): ") + ;; Completing function for reading colors, accepting + ;; both color names and RGB triplets. + (lambda (string pred flag) + (cond + ((null flag) ; Try completion. + (or (try-completion string colors pred) + (if (color-defined-p string) + string))) + ((eq flag t) ; List all completions. + (or (all-completions string colors pred) + (if (color-defined-p string) + (list string)))) + ((eq flag 'lambda) ; Test completion. + (or (memq string colors) + (color-defined-p string))))) + nil t))) + + ;; Process named colors. + (when (member color colors) + (cond ((string-equal color "foreground at point") + (setq color (foreground-color-at-point))) + ((string-equal color "background at point") + (setq color (background-color-at-point)))) + (when (and convert-to-RGB + (not (string-equal color ""))) + (let ((components (x-color-values color))) + (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) + (setq color (format "#%04X%04X%04X" + (logand 65535 (nth 0 components)) + (logand 65535 (nth 1 components)) + (logand 65535 (nth 2 components)))))))) + (when msg (message "Color: `%s'" color)) + color)) + (defun face-at-point () "Return the face of the character after point. @@ -1837,106 +1821,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) - "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." - (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)) - ;; Before modifying the frame parameters, collect a list of - ;; faces that don't match what their face-spec says they - ;; should look like. We then avoid changing these faces - ;; below. These are the faces whose attributes were - ;; modified on FRAME. We use a negative list on the - ;; assumption that most faces will be unmodified, so we can - ;; avoid consing in the common case. - (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 - (list (cons 'background-mode bg-mode) - (cons 'display-type display-type))) - ;; For all named faces, choose face specs matching the new frame - ;; parameters, unless they have been locally modified. - (dolist (face (face-list)) - (unless (memq face locally-modified-faces) - (face-spec-recalc face frame)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1994,7 +1878,7 @@ Value is the new parameter list." (list (cons 'cursor-color fg))))))) (declare-function x-create-frame "xfns.c" (parms)) -(declare-function x-setup-function-keys "term/x-win" (frame)) +(declare-function x-setup-function-keys "term/common-win" (frame)) (defun x-create-frame-with-faces (&optional parameters) "Create and return a frame with frame parameters PARAMETERS. @@ -2016,7 +1900,7 @@ the X resource ``reverseVideo'' is present, handle that." (progn (x-setup-function-keys frame) (x-handle-reverse-video frame parameters) - (frame-set-background-mode frame) + (frame-set-background-mode frame t) (face-set-after-frame-default frame parameters) (if (null visibility-spec) (make-frame-visible frame) @@ -2032,20 +1916,22 @@ Calculate the face definitions using the face specs, custom theme settings, X resources, and `face-new-frame-defaults'. Finally, apply any relevant face attributes found amongst the frame parameters in PARAMETERS." - (dolist (face (nreverse (face-list))) ;Why reverse? --Stef - (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-create-frame. - (and (not (eq face 'default)) - (memq (window-system frame) '(x w32)) - (make-face-x-resource-internal face frame)) - ;; Apply attributes specified by face-new-frame-defaults - (internal-merge-in-global-face face frame)) - ;; Don't let invalid specs prevent frame creation. - (error nil))) + (let ((window-system-p (memq (window-system frame) '(x w32)))) + ;; 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-create-frame'. + (and (not (eq face 'default)) window-system-p + (make-face-x-resource-internal face frame)) + ;; Apply attributes specified by face-new-frame-defaults + (internal-merge-in-global-face face frame)) + ;; Don't let invalid specs prevent frame creation. + (error nil)))) + ;; Apply attributes specified by frame parameters. (let ((face-params '((foreground-color default :foreground) (background-color default :background) @@ -2092,7 +1978,7 @@ If PARAMETERS contains a `reverse' parameter, handle that." (set-terminal-parameter frame 'terminal-initted t) (set-locale-environment nil frame) (tty-run-terminal-initialization frame)) - (frame-set-background-mode frame) + (frame-set-background-mode frame t) (face-set-after-frame-default frame parameters) (setq success t)) (unless success @@ -2148,27 +2034,10 @@ terminal type to a different value." (defun tty-set-up-initial-frame-faces () (let ((frame (selected-frame))) - (frame-set-background-mode frame) + (frame-set-background-mode frame t) (face-set-after-frame-default frame))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compatibility with 20.2 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Update a frame's faces when we change its default font. - -(defalias 'frame-update-faces 'ignore "") -(make-obsolete 'frame-update-faces "no longer necessary." "21.1") - -;; Update the colors of FACE, after FRAME's own colors have been -;; changed. - -(define-obsolete-function-alias 'frame-update-face-colors - 'frame-set-background-mode "21.1") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Standard faces. @@ -2240,7 +2109,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)) @@ -2281,6 +2150,9 @@ terminal type to a different value." (defface region '((((class color) (min-colors 88) (background dark)) :background "blue3") + (((class color) (min-colors 88) (background light) (type gtk)) + :foreground "gtk_selection_fg_color" + :background "gtk_selection_bg_color") (((class color) (min-colors 88) (background light) (type ns)) :background "ns_selection_color") (((class color) (min-colors 88) (background light)) @@ -2488,7 +2360,9 @@ used to display the prompt text." :group 'frames :group 'basic-faces) -(defface cursor '((t nil)) +(defface cursor + '((((background light)) :background "black") + (((background dark)) :background "white")) "Basic face for the cursor color under X. Note: Other faces cannot inherit from the cursor face." :version "21.1" @@ -2530,6 +2404,15 @@ Note: Other faces cannot inherit from the cursor face." (defface help-argument-name '((((supports :slant italic)) :inherit italic)) "Face to highlight argument names in *Help* buffers." :group 'help) + +(defface glyphless-char + '((((type tty)) :inherit underline) + (((type pc)) :inherit escape-glyph) + (t :height 0.6)) + "Face for displaying non-graphic characters (e.g. U+202A (LRE)). +It is used for characters of no fonts too." + :version "24.1" + :group 'basic-faces) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Manipulating font names. @@ -2616,98 +2499,6 @@ also the same size as FACE on FRAME, or fail." (car fonts)) (cdr (assq 'font (frame-parameters (selected-frame)))))) - -(defun x-frob-font-weight (font which) - (let ((case-fold-search t)) - (cond ((string-match x-font-regexp font) - (concat (substring font 0 - (match-beginning x-font-regexp-weight-subnum)) - which - (substring font (match-end x-font-regexp-weight-subnum) - (match-beginning x-font-regexp-adstyle-subnum)) - ;; Replace the ADD_STYLE_NAME field with * - ;; because the info in it may not be the same - ;; for related fonts. - "*" - (substring font (match-end x-font-regexp-adstyle-subnum)))) - ((string-match x-font-regexp-head font) - (concat (substring font 0 (match-beginning 1)) which - (substring font (match-end 1)))) - ((string-match x-font-regexp-weight font) - (concat (substring font 0 (match-beginning 1)) which - (substring font (match-end 1))))))) -(make-obsolete 'x-frob-font-weight 'make-face-... "21.1") - -(defun x-frob-font-slant (font which) - (let ((case-fold-search t)) - (cond ((string-match x-font-regexp font) - (concat (substring font 0 - (match-beginning x-font-regexp-slant-subnum)) - which - (substring font (match-end x-font-regexp-slant-subnum) - (match-beginning x-font-regexp-adstyle-subnum)) - ;; Replace the ADD_STYLE_NAME field with * - ;; because the info in it may not be the same - ;; for related fonts. - "*" - (substring font (match-end x-font-regexp-adstyle-subnum)))) - ((string-match x-font-regexp-head font) - (concat (substring font 0 (match-beginning 2)) which - (substring font (match-end 2)))) - ((string-match x-font-regexp-slant font) - (concat (substring font 0 (match-beginning 1)) which - (substring font (match-end 1))))))) -(make-obsolete 'x-frob-font-slant 'make-face-... "21.1") - -;; These aliases are here so that we don't get warnings about obsolete -;; functions from the byte compiler. -(defalias 'internal-frob-font-weight 'x-frob-font-weight) -(defalias 'internal-frob-font-slant 'x-frob-font-slant) - -(defun x-make-font-bold (font) - "Given an X font specification, make a bold version of it. -If that can't be done, return nil." - (internal-frob-font-weight font "bold")) -(make-obsolete 'x-make-font-bold 'make-face-bold "21.1") - -(defun x-make-font-demibold (font) - "Given an X font specification, make a demibold version of it. -If that can't be done, return nil." - (internal-frob-font-weight font "demibold")) -(make-obsolete 'x-make-font-demibold 'make-face-bold "21.1") - -(defun x-make-font-unbold (font) - "Given an X font specification, make a non-bold version of it. -If that can't be done, return nil." - (internal-frob-font-weight font "medium")) -(make-obsolete 'x-make-font-unbold 'make-face-unbold "21.1") - -(defun x-make-font-italic (font) - "Given an X font specification, make an italic version of it. -If that can't be done, return nil." - (internal-frob-font-slant font "i")) -(make-obsolete 'x-make-font-italic 'make-face-italic "21.1") - -(defun x-make-font-oblique (font) ; you say tomayto... - "Given an X font specification, make an oblique version of it. -If that can't be done, return nil." - (internal-frob-font-slant font "o")) -(make-obsolete 'x-make-font-oblique 'make-face-italic "21.1") - -(defun x-make-font-unitalic (font) - "Given an X font specification, make a non-italic version of it. -If that can't be done, return nil." - (internal-frob-font-slant font "r")) -(make-obsolete 'x-make-font-unitalic 'make-face-unitalic "21.1") - -(defun x-make-font-bold-italic (font) - "Given an X font specification, make a bold and italic version of it. -If that can't be done, return nil." - (and (setq font (internal-frob-font-weight font "bold")) - (internal-frob-font-slant font "i"))) -(make-obsolete 'x-make-font-bold-italic 'make-face-bold-italic "21.1") - (provide 'faces) -;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 ;;; faces.el ends here