X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/621806aab200b6d9bc592471b55e8664aa3646f3..380874900ca183ec2fdce91949d841328852d7a8:/lisp/faces.el diff --git a/lisp/faces.el b/lisp/faces.el index 238c4c788f..67f8a2af07 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, 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -33,7 +33,6 @@ (autoload 'xw-defined-colors "x-win")) (defvar help-xref-stack-item) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Font selection. @@ -375,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)) @@ -547,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. @@ -555,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: @@ -677,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)))))) @@ -1011,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))) @@ -1298,6 +1306,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) @@ -1440,7 +1449,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)) @@ -1569,17 +1578,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. @@ -1730,23 +1739,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 () @@ -1849,12 +1858,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)) @@ -1864,7 +2033,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 @@ -1880,7 +2049,7 @@ 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 @@ -1890,20 +2059,21 @@ created." :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,20 +2110,12 @@ 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 @@ -1970,25 +2132,6 @@ used to display the prompt text." (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") @@ -2001,34 +2144,18 @@ used to display the prompt text." :group 'frames :group 'basic-faces) - (defface scroll-bar '() "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 '() "Basic face for the frame border under X." :version "21.1" :group 'frames :group 'basic-faces) - (defface cursor '() "Basic face for the cursor color under X. Note: Other faces cannot inherit from the cursor face." @@ -2044,126 +2171,30 @@ Note: Other faces cannot inherit from the cursor face." :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 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 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 - '((((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") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Manipulating font names.