X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/086add1519b5c5a69a1a35aadbfd4d7cc6a2b294..cb58ea33227cfe3fa6bc71483097a0aecfff826f:/lisp/faces.el diff --git a/lisp/faces.el b/lisp/faces.el index 35ec7ad24a..14c57ed6e3 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,7 +1,7 @@ ;;; faces.el --- Lisp faces -;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004,2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +;; 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -32,6 +32,7 @@ ;; Warning suppression -- can't require x-win in batch: (autoload 'xw-defined-colors "x-win")) +(defvar help-xref-stack-item) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Font selection. @@ -373,8 +374,11 @@ completely specified)." ;; 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)) @@ -385,7 +389,7 @@ completely specified)." (defun face-attribute-merged-with (attribute value faces &optional frame) "Merges ATTRIBUTE, initially VALUE, with faces from FACES until absolute. FACES may be either a single face or a list of faces. -\[This is an internal function]" +\[This is an internal function.]" (cond ((not (face-attribute-relative-p attribute value)) value) ((null faces) @@ -545,6 +549,9 @@ If FACE is a face-alias, get the documentation for the target face." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar inhibit-face-set-after-frame-default nil + "If non-nil, that tells `face-set-after-frame-default' to do nothing.") + (defun set-face-attribute (face frame &rest args) "Set attributes of FACE on FRAME from ARGS. @@ -553,7 +560,7 @@ 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'; +face attribute name. All attributes can be set to `unspecified'; this fact is not further mentioned below. The following attributes are recognized: @@ -675,9 +682,12 @@ like an underlying face would be, with higher priority than underlying faces." (if (memq where '(0 t)) (put (or (get face 'face-alias) face) 'face-modified t)) (while args - (internal-set-lisp-face-attribute face (car args) - (purecopy (cadr args)) - where) + ;; Don't recursively set the attributes from the frame's font param + ;; when we update the frame's font param fro the attributes. + (let ((inhibit-face-set-after-frame-default t)) + (internal-set-lisp-face-attribute face (car args) + (purecopy (cadr args)) + where)) (setq args (cdr (cdr args)))))) @@ -770,31 +780,22 @@ and DATA is a string, containing the raw bits of the bitmap." (set-face-attribute face frame :stipple (or stipple 'unspecified))) -(defun set-face-underline (face underline &optional frame) +(defun set-face-underline-p (face underline-p &optional frame) "Specify whether face FACE is underlined. UNDERLINE nil means FACE explicitly doesn't underline. UNDERLINE non-nil means FACE explicitly does underlining with the same of the foreground color. If UNDERLINE is a string, underline with the color named UNDERLINE. FRAME nil or not specified means change face on all frames. -Use `set-face-attribute' to ``unspecify'' underlining." - (interactive - (let ((list (read-face-and-attribute :underline))) - (list (car list) (eq (car (cdr list)) t)))) - (set-face-attribute face frame :underline underline)) - - -(defun set-face-underline-p (face underline-p &optional frame) - "Specify whether face FACE is underlined. -UNDERLINE-P nil means FACE explicitly doesn't underline. -UNDERLINE-P non-nil means FACE explicitly does underlining. -FRAME nil or not specified means change face on all frames. Use `set-face-attribute' to ``unspecify'' 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)) +(define-obsolete-function-alias 'set-face-underline + 'set-face-underline-p "22.1") + (defun set-face-inverse-video-p (face inverse-video-p &optional frame) "Specify whether face FACE is in inverse video. @@ -882,6 +883,7 @@ Otherwise, return a single face." (push f faces))) (if (symbolp faceprop) (push faceprop faces))) + (delete-dups faces) ;; Build up the completion tables. (mapatoms (lambda (s) @@ -1017,7 +1019,7 @@ Value is the new attribute value." (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))) @@ -1095,7 +1097,7 @@ of a global face. Value is the new attribute value." (defun read-face-font (face &optional frame) "Read the name of a font for FACE on FRAME. -If optional argument FRAME Is nil or omitted, use the selected frame." +If optional argument FRAME is nil or omitted, use the selected frame." (let ((completion-ignore-case t)) (completing-read (format "Set font attributes of face `%s' from font: " face) (x-list-fonts "*" nil frame)))) @@ -1103,7 +1105,7 @@ If optional argument FRAME Is nil or omitted, use the selected frame." (defun read-all-face-attributes (face &optional frame) "Interactively read all attributes for FACE. -If optional argument FRAME Is nil or omitted, use the selected frame. +If optional argument FRAME is nil or omitted, use the selected frame. Value is a property list of attribute names and new values." (let (result) (dolist (attribute face-attribute-name-alist result) @@ -1117,7 +1119,7 @@ Value is a property list of attribute names and new values." If optional argument FRAME is nil or omitted, modify the face used for newly created frame, i.e. the global face. For non-interactive use, `set-face-attribute' is preferred. -When called from elisp, if FACE is nil, all arguments but FRAME are ignored +When called from Lisp, if FACE is nil, all arguments but FRAME are ignored and the face and its settings are obtained by querying the user." (interactive) (if face @@ -1303,6 +1305,7 @@ If FRAME is omitted or nil, use the selected frame." ;; The next 4 sexps are copied from describe-function-1 ;; and simplified. (setq file-name (symbol-file f 'defface)) + (setq file-name (describe-simplify-lib-file-name file-name)) (when file-name (princ "Defined in `") (princ file-name) @@ -1316,8 +1319,15 @@ If FRAME is omitted or nil, use the selected frame." (terpri)) (dolist (a attrs) (let ((attr (face-attribute f (car a) frame))) - (insert (make-string (- max-width (length (cdr a))) ?\ ) - (cdr a) ": " (format "%s" attr) "\n"))))) + (insert (make-string (- max-width (length (cdr a))) ?\s) + (cdr a) ": " (format "%s" attr)) + (if (and (eq (car a) :inherit) + (not (eq attr 'unspecified))) + ;; Make a hyperlink to the parent face. + (save-excursion + (re-search-backward ": \\([^:]+\\)" nil t) + (help-xref-button 1 'help-face attr))) + (insert "\n"))))) (terpri))) (print-help-return-message)))) @@ -1330,7 +1340,7 @@ If FRAME is omitted or nil, use the selected frame." ;; face implementation. (defun face-attr-construct (face &optional frame) - "Return a defface-style attribute list for FACE on FRAME. + "Return a `defface'-style attribute list for FACE on FRAME. 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." @@ -1438,7 +1448,7 @@ 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." (let ((attrs (face-spec-choose spec frame))) - (when attrs + (when spec (face-spec-reset-face face frame)) (while attrs (let ((attribute (car attrs)) @@ -1567,17 +1577,17 @@ If omitted or nil, that stands for the selected frame's display." (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. @@ -1728,23 +1738,23 @@ Value is the new frame created." (delete-frame frame))) frame)) - (defun face-set-after-frame-default (frame) "Set frame-local faces of FRAME from face specs and resources. Initialize colors of certain faces from frame parameters." - (if (face-attribute 'default :font t) - (set-face-attribute 'default frame :font - (face-attribute 'default :font t)) - (set-face-attribute 'default frame :family - (face-attribute 'default :family t)) - (set-face-attribute 'default frame :height - (face-attribute 'default :height t)) - (set-face-attribute 'default frame :slant - (face-attribute 'default :slant t)) - (set-face-attribute 'default frame :weight - (face-attribute 'default :weight t)) - (set-face-attribute 'default frame :width - (face-attribute 'default :width t))) + (unless inhibit-face-set-after-frame-default + (if (face-attribute 'default :font t) + (set-face-attribute 'default frame :font + (face-attribute 'default :font t)) + (set-face-attribute 'default frame :family + (face-attribute 'default :family t)) + (set-face-attribute 'default frame :height + (face-attribute 'default :height t)) + (set-face-attribute 'default frame :slant + (face-attribute 'default :slant t)) + (set-face-attribute 'default frame :weight + (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 () @@ -1835,8 +1845,8 @@ created." ;; Update the colors of FACE, after FRAME's own colors have been ;; changed. -(defalias 'frame-update-face-colors 'frame-set-background-mode) -(make-obsolete 'frame-update-face-colors 'frame-set-background-mode "21.1") +(define-obsolete-function-alias 'frame-update-face-colors + 'frame-set-background-mode "21.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1847,12 +1857,172 @@ created." "The standard faces of Emacs." :group 'faces) - (defface default '((t nil)) "Basic default face." :group 'basic-faces) +(defface bold + '((t :weight bold)) + "Basic bold face." + :group 'basic-faces) + +(defface italic + '((((supports :slant italic)) + :slant italic) + (((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) + :slant italic)) + "Basic italic face." + :group 'basic-faces) + +(defface bold-italic + '((t :weight bold :slant italic)) + "Basic bold-italic face." + :group 'basic-faces) + +(defface underline + '((((supports :underline t)) + :underline t) + (((supports :weight bold)) + :weight bold) + (t :underline t)) + "Basic underlined face." + :group 'basic-faces) + +(defface fixed-pitch + '((t :family "courier")) + "The basic fixed-pitch face." + :group 'basic-faces) + +(defface variable-pitch + '((t :family "helv")) + "The basic variable-pitch face." + :group 'basic-faces) + +(defface shadow + '((((class color grayscale) (min-colors 88) (background light)) + :foreground "grey50") + (((class color grayscale) (min-colors 88) (background dark)) + :foreground "grey70") + (((class color) (min-colors 8) (background light)) + :foreground "green") + (((class color) (min-colors 8) (background dark)) + :foreground "yellow")) + "Basic face for shadowed text." + :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") + (((class color) (min-colors 88) (background dark)) + :background "darkolivegreen") + (((class color) (min-colors 16) (background light)) + :background "darkseagreen2") + (((class color) (min-colors 16) (background dark)) + :background "darkolivegreen") + (((class color) (min-colors 8)) + :background "green" :foreground "black") + (t :inverse-video t)) + "Basic face for highlighting." + :group 'basic-faces) + +(defface region + '((((class color) (min-colors 88) (background dark)) + :background "blue3") + (((class color) (min-colors 88) (background light)) + :background "lightgoldenrod2") + (((class color) (min-colors 16) (background dark)) + :background "blue3") + (((class color) (min-colors 16) (background light)) + :background "lightgoldenrod2") + (((class color) (min-colors 8)) + :background "blue" :foreground "white") + (((type tty) (class mono)) + :inverse-video t) + (t :background "gray")) + "Basic face for highlighting the region." + :version "21.1" + :group 'basic-faces) + +(defface secondary-selection + '((((class color) (min-colors 88) (background light)) + :background "yellow1") + (((class color) (min-colors 88) (background dark)) + :background "SkyBlue4") + (((class color) (min-colors 16) (background light)) + :background "yellow") + (((class color) (min-colors 16) (background dark)) + :background "SkyBlue4") + (((class color) (min-colors 8)) + :background "cyan" :foreground "black") + (t :inverse-video t)) + "Basic face for displaying the secondary selection." + :group 'basic-faces) + +(defface trailing-whitespace + '((((class color) (background light)) + :background "red1") + (((class color) (background dark)) + :background "red1") + (t :inverse-video t)) + "Basic face for highlighting trailing whitespace." + :version "21.1" + :group 'whitespace-faces ; like `show-trailing-whitespace' + :group 'basic-faces) + +(defface escape-glyph + '((((background dark)) :foreground "cyan") + ;; See the comment in minibuffer-prompt for + ;; the reason not to use blue on MS-DOS. + (((type pc)) :foreground "magenta") + ;; 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." + :group 'basic-faces + :version "22.1") + +(defface nobreak-space + '((((class color) (min-colors 88)) :inherit escape-glyph :underline t) + (((class color) (min-colors 8)) :background "magenta") + (t :inverse-video t)) + "Face for displaying nobreak space." + :group 'basic-faces + :version "22.1") + +(defgroup mode-line-faces nil + "Faces used in the mode line." + :group 'modeline + :group 'faces + :version "22.1") (defface mode-line '((((class color) (min-colors 88)) @@ -1862,7 +2032,7 @@ created." :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 @@ -1878,32 +2048,31 @@ created." :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) (background light)) - :background "RoyalBlue4" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "light sky blue" :foreground "black") - (t - :inverse-video t)) + '((((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 'mode-line-faces :group 'basic-faces) -(defface vertical-border - '((((type tty)) :inherit mode-line-inactive)) - "Face used for vertical window dividers on ttys." +(defface mode-line-buffer-id + '((t (:weight bold))) + "Face used for buffer identification parts of the mode line." :version "22.1" - :group 'modeline + :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 @@ -1940,52 +2109,28 @@ created." :version "21.1" :group 'basic-faces) - -(defface tool-bar - '((default - :box (:line-width 1 :style released-button) - :foreground "black") - (((type x w32 mac) (class color)) - :background "grey75") - (((type x) (class mono)) - :background "grey")) - "Basic tool-bar face." - :version "21.1" +(defface vertical-border + '((((type tty)) :inherit mode-line-inactive)) + "Face used for vertical window dividers on ttys." + :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")) - "Face for minibuffer prompts." +(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")) + "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 +used to display the prompt text." :version "22.1" :group 'basic-faces) (setq minibuffer-prompt-properties (append minibuffer-prompt-properties (list 'face 'minibuffer-prompt))) -(defface region - '((((class color) (min-colors 88) (background dark)) - :background "blue3") - (((class color) (min-colors 88) (background light)) - :background "lightgoldenrod2") - (((class color) (min-colors 16) (background dark)) - :background "blue3") - (((class color) (min-colors 16) (background light)) - :background "lightgoldenrod2") - (((class color) (min-colors 8)) - :background "blue" :foreground "white") - (((type tty) (class mono)) - :inverse-video t) - (t :background "gray")) - "Basic face for highlighting the region." - :version "21.1" - :group 'basic-faces) - - (defface fringe '((((class color) (background light)) :background "grey95") @@ -1998,35 +2143,19 @@ created." :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 menu - '((((type tty)) - :inverse-video t) - (((type x-toolkit)) - ) - (t - :inverse-video t)) - "Basic face for the font and colors of the menu bar and popup menus." - :version "21.1" - :group 'menu - :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" @@ -2035,126 +2164,36 @@ Note: Other faces cannot inherit from the cursor face." (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 :group 'basic-faces) - -(defface bold '((t :weight bold)) - "Basic bold face." +(defface tool-bar + '((default + :box (:line-width 1 :style released-button) + :foreground "black") + (((type x w32 mac) (class color)) + :background "grey75") + (((type x) (class mono)) + :background "grey")) + "Basic tool-bar face." + :version "21.1" :group 'basic-faces) - -(defface italic - '((((supports :slant italic)) - :slant italic) - (((supports :underline t)) - :underline t) +(defface menu + '((((type tty)) + :inverse-video t) + (((type x-toolkit)) + ) (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) - :slant italic)) - "Basic italic font." - :group 'basic-faces) - - -(defface bold-italic '((t :weight bold :slant italic)) - "Basic bold-italic face." - :group 'basic-faces) - - -(defface underline '((((supports :underline t)) - :underline t) - (((supports :weight bold)) - :weight bold) - (t :underline t)) - "Basic underlined face." - :group 'basic-faces) - - -(defface highlight - '((((class color) (min-colors 88) (background light)) - :background "darkseagreen2") - (((class color) (min-colors 88) (background dark)) - :background "darkolivegreen") - (((class color) (min-colors 16) (background light)) - :background "darkseagreen2") - (((class color) (min-colors 16) (background dark)) - :background "darkolivegreen") - (((class color) (min-colors 8)) - :background "green" :foreground "black") - (t :inverse-video t)) - "Basic face for highlighting." - :group 'basic-faces) - - -(defface secondary-selection - '((((class color) (min-colors 88) (background light)) - :background "yellow1") - (((class color) (min-colors 88) (background dark)) - :background "SkyBlue4") - (((class color) (min-colors 16) (background light)) - :background "yellow") - (((class color) (min-colors 16) (background dark)) - :background "SkyBlue4") - (((class color) (min-colors 8)) - :background "cyan" :foreground "black") - (t :inverse-video t)) - "Basic face for displaying the secondary selection." - :group 'basic-faces) - - -(defface fixed-pitch '((t :family "courier")) - "The basic fixed-pitch face." - :group 'basic-faces) - - -(defface variable-pitch '((t :family "helv")) - "The basic variable-pitch face." - :group 'basic-faces) - - -(defface trailing-whitespace - '((((class color) (background light)) - :background "red1") - (((class color) (background dark)) - :background "red1") - (t :inverse-video t)) - "Basic face for highlighting trailing whitespace." + :inverse-video t)) + "Basic face for the font and colors of the menu bar and popup menus." :version "21.1" - :group 'whitespace ; like `show-trailing-whitespace' + :group 'menu :group 'basic-faces) -(defface escape-glyph - '((((background dark)) :foreground "cyan") - ;; See the comment in minibuffer-prompt for - ;; the reason not to use blue on MS-DOS. - (((type pc)) :foreground "magenta") - ;; 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." - :group 'basic-faces - :version "22.1") - -(defface nobreak-space - '((((class color) (min-colors 88)) :inherit escape-glyph :underline t) - (((class color) (min-colors 8)) :background "magenta") - (t :inverse-video t)) - "Face for displaying nobreak space." - :group 'basic-faces - :version "22.1") - -(defface shadow - '((((background dark)) :foreground "grey70") - (((background light)) :foreground "grey50")) - "Basic face for shadowed text." - :group 'basic-faces - :version "22.1") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Manipulating font names.