]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
*** empty log message ***
[gnu-emacs] / lisp / faces.el
index 3cadfb41b85711b8e65661f15ef2862ed7bef181..81a6a953aa522f92cb71b609179dda587c885310 100644 (file)
@@ -33,7 +33,6 @@
   (autoload 'xw-defined-colors "x-win"))
 
 (defvar help-xref-stack-item)
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Font selection.
@@ -547,6 +546,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.
 
@@ -677,9 +679,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))))))
 
 
@@ -1297,6 +1302,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)
@@ -1729,23 +1735,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 ()
@@ -1848,12 +1854,154 @@ 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 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 mode-line-highlight
+  '((((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 '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           ; 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")
 
 (defface mode-line
   '((((class color) (min-colors 88))
@@ -1882,23 +2030,6 @@ created."
   :group 'modeline
   :group 'basic-faces)
 
-(defface mode-line-highlight
-  '((((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 'basic-faces)
-
-(defface vertical-border
-  '((((type tty)) :inherit mode-line-inactive))
-  "Face used for vertical window dividers on ttys."
-  :version "22.1"
-  :group 'modeline
-  :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)
@@ -1939,20 +2070,13 @@ 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 'modeline
   :group 'basic-faces)
 
-
 (defface minibuffer-prompt
   '((((background dark)) :foreground "cyan")
     ;; Don't use blue because many users of the MS-DOS port customize
@@ -1969,25 +2093,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")
@@ -2000,34 +2105,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."
@@ -2043,126 +2132,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")
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Manipulating font names.