]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
(titdic-convert): Force files be
[gnu-emacs] / lisp / faces.el
index c28cbc5d84fd0e733ffdcdefb8441167340a6964..749754ffb0825dc1368cf6dd3f55e44acc0933ee 100644 (file)
@@ -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, 2007 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -20,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -32,6 +32,7 @@
   ;; Warning suppression -- can't require x-win in batch:
   (autoload 'xw-defined-colors "x-win"))
 
+(defvar help-xref-stack-item)
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Font selection.
@@ -180,20 +181,16 @@ to NEW-FACE on frame NEW-FRAME."
 (defun internal-find-face (name &optional frame)
   "Retrieve the face named NAME.
 Return nil if there is no such face.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
+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 the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
+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")
@@ -247,8 +244,8 @@ If FRAME is t, report on the defaults for face FACE (for new frames).
 If FRAME is omitted or nil, use the selected frame."
   (let ((attrs
         '(:family :width :height :weight :slant :foreground
-          :foreground :background :underline :overline
-          :strike-through :box :inverse-video))
+          :background :underline :overline :strike-through
+          :box :inverse-video))
        (differs nil))
     (while (and attrs (not differs))
       (let* ((attr (pop attrs))
@@ -373,8 +370,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 +385,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 +545,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 +556,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 +678,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,7 +776,7 @@ 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 &optional frame)
   "Specify whether face FACE is underlined.
 UNDERLINE nil means FACE explicitly doesn't underline.
 UNDERLINE non-nil means FACE explicitly does underlining
@@ -783,17 +789,8 @@ Use `set-face-attribute' to ``unspecify'' underlining."
      (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)
@@ -858,10 +855,11 @@ of the default face.  Value is FACE."
 
 (defun read-face-name (prompt &optional string-describing-default multiple)
   "Read a face, defaulting to the face or faces on the char after point.
-If it has a `read-face-name' property, that overrides the `face' property.
-PROMPT describes what you will do with the face (don't end in a space).
-STRING-DESCRIBING-DEFAULT describes what default you will use
-if this function returns nil.
+If it has the property `read-face-name', that overrides the `face' property.
+PROMPT should be a string that describes what the caller will do with the face;
+it should not end in a space.
+STRING-DESCRIBING-DEFAULT should describe what default the caller will use if
+the user just types RET; you can omit it.
 If MULTIPLE is non-nil, return a list of faces (possibly only one).
 Otherwise, return a single face."
   (let ((faceprop (or (get-char-property (point) 'read-face-name)
@@ -869,7 +867,10 @@ Otherwise, return a single face."
         (aliasfaces nil)
         (nonaliasfaces nil)
        faces)
-    ;; Make a list of the named faces that the `face' property uses.
+    ;; Try to get a face name from the buffer.
+    (if (memq (intern-soft (thing-at-point 'symbol)) (face-list))
+       (setq faces (list (intern-soft (thing-at-point 'symbol)))))
+    ;; Add the named faces that the `face' property uses.
     (if (and (listp faceprop)
             ;; Don't treat an attribute spec as a list of faces.
             (not (keywordp (car faceprop)))
@@ -879,10 +880,7 @@ Otherwise, return a single face."
              (push f faces)))
       (if (symbolp faceprop)
          (push faceprop faces)))
-    ;; If there are none, try to get a face name from the buffer.
-    (if (and (null faces)
-            (memq (intern-soft (thing-at-point 'symbol)) (face-list)))
-       (setq faces (list (intern-soft (thing-at-point 'symbol)))))
+    (delete-dups faces)
 
     ;; Build up the completion tables.
     (mapatoms (lambda (s)
@@ -896,22 +894,27 @@ Otherwise, return a single face."
     (unless multiple
       (if faces
          (setq faces (list (car faces)))))
+    (require 'crm)
     (let* ((input
            ;; Read the input.
-           (completing-read
+           (completing-read-multiple
             (if (or faces string-describing-default)
                 (format "%s (default %s): " prompt
-                        (if faces (mapconcat 'symbol-name faces ", ")
+                        (if faces (mapconcat 'symbol-name faces ",")
                           string-describing-default))
               (format "%s: " prompt))
-            (complete-in-turn nonaliasfaces aliasfaces) nil t))
+            (complete-in-turn nonaliasfaces aliasfaces)
+            nil t nil nil
+            (if faces (mapconcat 'symbol-name faces ","))))
           ;; Canonicalize the output.
           (output
-           (if (equal input "")
-               faces
-             (if (stringp input)
-                 (list (intern input))
-               input))))
+           (cond ((or (equal input "") (equal input '("")))
+                  faces)
+                 ((stringp input)
+                  (mapcar 'intern (split-string input ", *" t)))
+                 ((listp input)
+                  (mapcar 'intern input))
+                 (input))))
       ;; Return either a list of faces or just one face.
       (if multiple
          output
@@ -941,7 +944,7 @@ an integer value."
                 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
                                (internal-lisp-face-attribute-values attribute))
                        (mapcar #'(lambda (c) (cons c c))
-                               (x-defined-colors frame)))
+                               (defined-colors frame)))
              (mapcar #'(lambda (x) (cons (symbol-name x) x))
                      (internal-lisp-face-attribute-values attribute))))
            ((:foreground :background)
@@ -1013,7 +1016,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)))
 
 
@@ -1091,7 +1094,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))))
@@ -1099,7 +1102,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)
@@ -1108,12 +1111,12 @@ Value is a property list of attribute names and new values."
                               result))))))
 
 (defun modify-face (&optional face foreground background stipple
-                             bold-p italic-p underline-p inverse-p frame)
+                             bold-p italic-p underline inverse-p frame)
   "Modify attributes of faces interactively.
 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
@@ -1123,7 +1126,7 @@ and the face and its settings are obtained by querying the user."
                          :stipple stipple
                          :bold bold-p
                          :italic italic-p
-                         :underline underline-p
+                         :underline underline
                          :inverse-video inverse-p)
     (setq face (read-face-name "Modify face"))
     (apply #'set-face-attribute face frame
@@ -1286,6 +1289,7 @@ If FRAME is omitted or nil, use the selected frame."
              (insert "   undefined face.\n")
            (let ((customize-label "customize this face")
                  file-name)
+             (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
              (princ (concat " (" customize-label ")\n"))
              (insert "Documentation: "
                      (or (face-documentation f)
@@ -1299,6 +1303,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)
@@ -1312,8 +1317,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))))
 
@@ -1326,7 +1338,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."
@@ -1434,7 +1446,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))
@@ -1503,7 +1515,8 @@ If there is neither a user setting nor a default for FACE, return nil."
   "Return a list of colors supported for a particular frame.
 The argument FRAME specifies which frame to try.
 The value may be different for frames on different display types.
-If FRAME doesn't support colors, the value is nil."
+If FRAME doesn't support colors, the value is nil.
+If FRAME is nil, that stands for the selected frame."
   (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
       (xw-defined-colors frame)
     (mapcar 'car (tty-color-alist frame))))
@@ -1524,7 +1537,7 @@ 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 65535; white is \(65535 65535 65535\).
+These values range from 0 to 65535; white is \(65535 65535 65535\).
 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
@@ -1563,17 +1576,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.
@@ -1604,17 +1617,17 @@ according to the `background-mode' and `display-type' frame parameters."
                 (or default-frame-background-mode 'dark))
                ((equal bg-color "unspecified-fg") ; inverted colors
                 (if (eq default-frame-background-mode 'light) 'dark 'light))
-               ((>= (apply '+ (x-color-values bg-color frame))
+               ((>= (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 '+ (x-color-values "white" frame)) .6))
+                   (* (apply '+ (color-values "white" frame)) .6))
                 'light)
                (t 'dark)))
         (display-type
          (cond ((null window-system)
                 (if (tty-display-color-p frame) 'color 'mono))
-               ((x-display-color-p frame)
+               ((display-color-p frame)
                 'color)
                ((x-display-grayscale-p frame)
                 'grayscale)
@@ -1724,52 +1737,65 @@ 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)))
-  (dolist (face (face-list))
-    ;; Don't let frame creation fail because of an invalid face spec.
-    (condition-case ()
-       (when (not (equal face 'default))
-         (face-spec-set face (face-user-default-spec face) frame)
-         (internal-merge-in-global-face face frame)
-         (when (and (memq window-system '(x w32 mac))
-                    (or (not (boundp 'inhibit-default-face-x-resources))
-                        (not (eq face 'default))))
-           (make-face-x-resource-internal face frame)))
-      (error nil)))
-  ;; Initialize attributes from frame parameters.
-  (let ((params '((foreground-color default :foreground)
-                 (background-color default :background)
-                 (border-color border :background)
-                 (cursor-color cursor :background)
-                 (scroll-bar-foreground scroll-bar :foreground)
-                 (scroll-bar-background scroll-bar :background)
-                 (mouse-color mouse :background))))
-    (dolist (param params)
-      (let ((frame-param (frame-parameter frame (nth 0 param)))
-           (face (nth 1 param))
-           (attr (nth 2 param)))
-       (when (and frame-param
-                  ;; Don't override face attributes explicitly
-                  ;; specified for new frames.
-                  (eq (face-attribute face attr t) 'unspecified))
-         (set-face-attribute face frame attr frame-param))))))
-
+  (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))))
+  ;; Find attributes that should be initialized from frame parameters.
+  (let ((face-params '((foreground-color default :foreground)
+                      (background-color default :background)
+                      (border-color border :background)
+                      (cursor-color cursor :background)
+                      (scroll-bar-foreground scroll-bar :foreground)
+                      (scroll-bar-background scroll-bar :background)
+                      (mouse-color mouse :background)))
+       apply-params)
+    (dolist (param face-params)
+      (let* ((value (frame-parameter frame (nth 0 param)))
+            (face (nth 1 param))
+            (attr (nth 2 param))
+            (default-value (face-attribute face attr t)))
+       ;; Compile a list of face attributes to set, but don't set
+       ;; them yet.  The call to make-face-x-resource-internal,
+       ;; below, can change frame parameters, and the final set of
+       ;; frame parameters should be the ones acquired at this step.
+       (if (eq default-value 'unspecified)
+           ;; The face spec does not specify a new-frame value for
+           ;; this attribute.  Check if the existing frame parameter
+           ;; specifies it.
+           (if value
+               (push (list face frame attr value) apply-params))
+         ;; The face spec specifies a value for this attribute, to be
+         ;; applied to the face on all new frames.
+         (push (list face frame attr default-value) apply-params))))
+    ;; Initialize faces from face specs and X resources.  The
+    ;; condition-case prevents invalid specs from causing frame
+    ;; creation to fail.
+    (dolist (face (delq 'default (face-list)))
+      (condition-case ()
+         (progn
+           (face-spec-set face (face-user-default-spec face) frame)
+           (internal-merge-in-global-face face frame)
+           (if (memq window-system '(x w32 mac))
+               (make-face-x-resource-internal face frame)))
+       (error nil)))
+    ;; Apply the attributes specified by frame parameters.  This
+    ;; rewrites parameters changed by make-face-x-resource-internal
+    (dolist (param apply-params)
+      (apply 'set-face-attribute param))))
 
 (defun tty-handle-reverse-video (frame parameters)
   "Handle the reverse-video frame parameter for terminal frames."
@@ -1831,8 +1857,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")
 
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1843,12 +1869,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 using `^' or `\\'."
+  :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 'mode-line
+  :group 'faces
+  :version "22.1")
 
 (defface mode-line
   '((((class color) (min-colors 88))
@@ -1858,7 +2044,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
@@ -1874,32 +2060,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
-  '((default :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
@@ -1936,52 +2121,34 @@ 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 momentary
+  '((t (:inherit mode-line)))
+  "Face for momentarily displaying text in the current buffer."
+  :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")
@@ -1994,35 +2161,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"
@@ -2031,126 +2182,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")
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Manipulating font names.