]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
(goto-address-mail-regexp): Allow = in username.
[gnu-emacs] / lisp / faces.el
index cdc5607571187980e3bf13955e502ff273042919..d2ae90805f2c70680765775efd226b6566f9dda1 100644 (file)
@@ -244,39 +244,20 @@ If FRAME is omitted or nil, use the selected frame."
 If the optional argument FRAME is given, report on face FACE in that frame.
 If FRAME is t, report on the defaults for face FACE (for new frames).
 If FRAME is omitted or nil, use the selected frame."
-  (if (not (equal (face-font face frame) (face-font 'default frame)))
-      ;; The font is different from the default face's font, so clearly it
-      ;; differs.  This only really works on window-systems; on ttys, the
-      ;; "font" is a constant, with attributes layered on top of it.
-      :font
-    ;; General face attribute check.  On graphical displays
-    ;; `display-supports-face-attributes-p' just checks whether each
-    ;; attribute is different that the default face, so we just check to
-    ;; make sure each attribute of the merged face is not `unspecified';
-    ;; we already checked the font above, so font-related attributes are
-    ;; omitted for that reason.  On a tty,
-    ;; display-supports-face-attributes-p actually does do further
-    ;; checks, and correctly deals with the display's capabilities, so
-    ;; we use it to check all attributes.
-    (let ((attrs
-          (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
-              ;; Omit font-related attributes on a window-system
-              '(:foreground :foreground :background :underline :overline
-                :strike-through :box :inverse-video :stipple)
-            ;; On a tty, check all attributes
-            '(:family :width :height :weight :slant :foreground
-              :foreground :background :underline :overline
-              :strike-through :box :inverse-video :stipple)))
-         (differs nil))
-      (while (and attrs (not differs))
-       (let* ((attr (pop attrs))
-              (attr-val (face-attribute face attr frame t)))
-         (when (and
-                (not (eq attr-val 'unspecified))
-                (display-supports-face-attributes-p (list attr attr-val)
-                                                    frame))
-           (setq differs attr))))
-      differs)))
+  (let ((attrs
+        '(:family :width :height :weight :slant :foreground
+          :foreground :background :underline :overline
+          :strike-through :box :inverse-video))
+       (differs nil))
+    (while (and attrs (not differs))
+      (let* ((attr (pop attrs))
+            (attr-val (face-attribute face attr frame t)))
+       (when (and
+              (not (eq attr-val 'unspecified))
+              (display-supports-face-attributes-p (list attr attr-val)
+                                                  frame))
+         (setq differs attr))))
+    differs))
 
 
 (defun face-nontrivial-p (face &optional frame)
@@ -1353,21 +1334,29 @@ If SPEC is nil, return nil."
   (unless frame
     (setq frame (selected-frame)))
   (let ((tail spec)
-       result all)
+       result defaults)
     (while tail
       (let* ((entry (pop tail))
             (display (car entry))
-            (attrs (cdr entry)))
-       (when (face-spec-set-match-display display frame)
-         (setq result (if (null (cdr attrs)) ;; was (listp (car attrs))
-                          ;; Old-style entry, the attribute list is the
-                          ;; first element.
-                          (car attrs)
-                        attrs))
-         (if (eq display t)
-             (setq all result result nil)
+            (attrs (cdr entry))
+            thisval)
+       ;; Get the attributes as actually specified by this alternative.
+       (setq thisval
+             (if (null (cdr attrs)) ;; was (listp (car attrs))
+                 ;; Old-style entry, the attribute list is the
+                 ;; first element.
+                 (car attrs)
+               attrs))
+
+       ;; If the condition is `default', that sets the default
+       ;; for following conditions.
+       (if (eq display 'default)
+           (setq defaults thisval)
+         ;; Otherwise, if it matches, use it.
+         (when (face-spec-set-match-display display frame)
+           (setq result thisval)
            (setq tail nil)))))
-    (if all (append result all) result)))
+    (if defaults (append result defaults) result)))
 
 
 (defun face-spec-reset-face (face &optional frame)
@@ -1505,47 +1494,6 @@ If omitted or nil, that stands for the selected frame's display."
      (t
       (> (tty-color-gray-shades display) 2)))))
 
-(defun display-supports-face-attributes-p (attributes &optional display)
-  "Return non-nil if all the face attributes in ATTRIBUTES are supported.
-The optional argument DISPLAY can be a display name, a frame, or
-nil (meaning the selected frame's display)
-
-The definition of `supported' is somewhat heuristic, but basically means
-that a face containing all the attributes in ATTRIBUTES, when merged
-with the default face for display, can be represented in a way that's
-
- (1) different in appearance than the default face, and
- (2) `close in spirit' to what the attributes specify, if not exact.
-
-Point (2) implies that a `:weight black' attribute will be satisfied by
-any display that can display bold, and a `:foreground \"yellow\"' as long
-as it can display a yellowish color, but `:slant italic' will _not_ be
-satisfied by the tty display code's automatic substitution of a `dim'
-face for italic."
-  (let ((frame
-        (if (framep display)
-            display
-          (car (frames-on-display-list display)))))
-    (if (not (memq (framep frame) '(x w32 mac)))
-       ;; On ttys, `tty-supports-face-attributes-p' does all the work we need.
-       (tty-supports-face-attributes-p attributes frame)
-      ;; For now, we assume that non-tty displays can support everything,
-      ;; and so we just check to see if any of the specified attributes is
-      ;; different from the default -- though this probably isn't always
-      ;; accurate for font-related attributes.  Later, we should add the
-      ;; ability to query about specific fonts, colors, etc.
-      (while (and attributes
-                 (let* ((attr (car attributes))
-                        (val (cadr attributes))
-                        (default-val (face-attribute 'default attr frame)))
-                   (if (and (stringp val) (stringp default-val))
-                       ;; compare string attributes case-insensitively
-                       (eq (compare-strings val nil nil default-val nil nil t)
-                           t)
-                     (equal val default-val))))
-       (setq attributes (cddr attributes)))
-      (not (null attributes)))))
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Background mode.
@@ -1835,7 +1783,7 @@ created."
 
 
 (defface mode-line
-  '((((type x w32 mac) (class color))
+  '((((class color) (min-colors 88))
      :box (:line-width -1 :style released-button)
      :background "grey75" :foreground "black")
     (t
@@ -1846,13 +1794,13 @@ created."
   :group 'basic-faces)
 
 (defface mode-line-inactive
-  '((t
+  '((default
      :inherit mode-line)
-    (((type x w32 mac) (background light) (class color))
+    (((class color) (min-colors 88) (background light))
      :weight light
      :box (:line-width -1 :color "grey75" :style nil)
      :foreground "grey20" :background "grey90")
-    (((type x w32 mac) (background dark) (class color))
+    (((class color) (min-colors 88) (background dark) )
      :weight light
      :box (:line-width -1 :color "grey40" :style nil)
      :foreground "grey80" :background "grey30"))
@@ -1866,7 +1814,7 @@ created."
 (put 'modeline-inactive 'face-alias 'mode-line-inactive)
 
 (defface header-line
-  '((t
+  '((default
      :inherit mode-line)
     (((type tty))
      ;; This used to be `:inverse-video t', but that doesn't look very
@@ -1902,7 +1850,7 @@ created."
 
 
 (defface tool-bar
-  '((t
+  '((default
      :box (:line-width 1 :style released-button)
      :foreground "black")
     (((type x w32 mac) (class color))
@@ -1984,11 +1932,13 @@ created."
 
 
 (defface cursor '()
-  "Basic face for the cursor color under X."
+  "Basic face for the cursor color under X.
+Note: Other faces cannot inherit from the cursor face."
   :version "21.1"
   :group 'cursor
   :group 'basic-faces)
 
+(put 'cursor 'face-no-inherit t)
 
 (defface mouse '()
   "Basic face for the mouse color under X."
@@ -2079,7 +2029,11 @@ created."
   :group 'font-lock                    ; like `show-trailing-whitespace'
   :group 'basic-faces)
 
-
+(defface escape-glyph '((((background dark)) :foreground "cyan")
+                       (((type pc)) :foreground "magenta")
+                       (t :foreground "blue"))
+  "Face for characters displayed as ^-sequences or \-sequences."
+  :group 'basic-faces)
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Manipulating font names.