update nadvice
[bpt/emacs.git] / lisp / faces.el
index 9a34aec..f78267c 100644 (file)
@@ -1,8 +1,8 @@
 ;;; faces.el --- Lisp faces
 
-;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2014 Free Software Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
 ;; Package: emacs
 
@@ -35,6 +35,26 @@ the terminal-initialization file to be loaded."
                 (string :tag "Name of directory with term files"))
   :group 'terminals)
 
+(defcustom term-file-aliases
+  '(("apollo" . "vt100")
+    ("vt102" . "vt100")
+    ("vt125" . "vt100")
+    ("vt201" . "vt200")
+    ("vt220" . "vt200")
+    ("vt240" . "vt200")
+    ("vt300" . "vt200")
+    ("vt320" . "vt200")
+    ("vt400" . "vt200")
+    ("vt420" . "vt200")
+    )
+  "Alist of terminal type aliases.
+Entries are of the form (TYPE . ALIAS), where both elements are strings.
+This means to treat a terminal of type TYPE as if it were of type ALIAS."
+  :type '(alist :key-type (string :tag "Terminal")
+               :value-type (string :tag "Alias"))
+  :group 'terminals
+  :version "24.5")
+
 (declare-function xw-defined-colors "term/common-win" (&optional frame))
 
 (defvar help-xref-stack-item)
@@ -129,13 +149,11 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
   "Return a list of all defined faces."
   (mapcar #'car face-new-frame-defaults))
 
-(defun make-face (face &optional no-init-from-resources)
+(defun make-face (face)
   "Define a new face with name FACE, a symbol.
 Do not call this directly from Lisp code; use `defface' instead.
 
-If NO-INIT-FROM-RESOURCES is non-nil, don't initialize face
-attributes from X resources.  If FACE is already known as a face,
-leave it unmodified.  Return FACE."
+If FACE is already known as a face, leave it unmodified.  Return FACE."
   (interactive (list (read-from-minibuffer
                      "Make face: " nil nil t 'face-name-history)))
   (unless (facep face)
@@ -146,8 +164,7 @@ leave it unmodified.  Return FACE."
     (when (fboundp 'facemenu-add-new-face)
       (facemenu-add-new-face face))
     ;; Define frame-local faces for all frames from X resources.
-    (unless no-init-from-resources
-      (make-face-x-resource-internal face)))
+    (make-face-x-resource-internal face))
   face)
 
 (defun make-empty-face (face)
@@ -155,7 +172,7 @@ leave it unmodified.  Return FACE."
 Do not call this directly from Lisp code; use `defface' instead."
   (interactive (list (read-from-minibuffer
                      "Make empty face: " nil nil t 'face-name-history)))
-  (make-face face 'no-init-from-resources))
+  (make-face face))
 
 (defun copy-face (old-face new-face &optional frame new-frame)
   "Define a face named NEW-FACE, which is a copy of OLD-FACE.
@@ -274,6 +291,8 @@ If FRAME is omitted or nil, use the selected frame."
     (:weight (".attributeWeight" . "Face.AttributeWeight"))
     (:slant (".attributeSlant" . "Face.AttributeSlant"))
     (:foreground (".attributeForeground" . "Face.AttributeForeground"))
+    (:distant-foreground
+     (".attributeDistantForeground" . "Face.AttributeDistantForeground"))
     (:background (".attributeBackground" . "Face.AttributeBackground"))
     (:overline (".attributeOverline" . "Face.AttributeOverline"))
     (:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
@@ -332,11 +351,16 @@ specifies an invalid attribute."
 
 (defun make-face-x-resource-internal (face &optional frame)
   "Fill frame-local FACE on FRAME from X resources.
-FRAME nil or not specified means do it for all frames."
-  (if (null frame)
-      (dolist (frame (frame-list))
-       (set-face-attributes-from-resources face frame))
-    (set-face-attributes-from-resources face frame)))
+FRAME nil or not specified means do it for all frames.
+
+If `inhibit-x-resources' is non-nil, this function does nothing."
+  (unless inhibit-x-resources
+    (dolist (frame (if (null frame) (frame-list) (list frame)))
+      ;; `x-create-frame' already took care of correctly handling
+      ;; the reverse video case-- do _not_ touch the default face
+      (unless (and (eq face 'default)
+                  (frame-parameter frame 'reverse))
+        (set-face-attributes-from-resources face frame)))))
 
 
 \f
@@ -956,10 +980,11 @@ a single face name."
                   ;; If we only want one, and the default is more than one,
                   ;; discard the unwanted ones.
                   (t (symbol-name (car default))))))
-  (if (and default (not multiple))
-      ;; For compatibility with `completing-read-multiple' use `crm-separator'
-      ;; to define DEFAULT if MULTIPLE is nil.
-      (setq default (car (split-string default crm-separator t))))
+  (when (and default (not multiple))
+    (require 'crm)
+    ;; For compatibility with `completing-read-multiple' use `crm-separator'
+    ;; to define DEFAULT if MULTIPLE is nil.
+    (setq default (car (split-string default crm-separator t))))
 
   (let ((prompt (if default
                     (format "%s (default `%s'): " prompt default)
@@ -1237,204 +1262,6 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read
 
 
 \f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Listing faces.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst list-faces-sample-text
-  "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-  "Text string to display as the sample text for `list-faces-display'.")
-
-
-;; The name list-faces would be more consistent, but let's avoid a
-;; conflict with Lucid, which uses that name differently.
-
-(defvar help-xref-stack)
-(defun list-faces-display (&optional regexp)
-  "List all faces, using the same sample text in each.
-The sample text is a string that comes from the variable
-`list-faces-sample-text'.
-
-If REGEXP is non-nil, list only those faces with names matching
-this regular expression.  When called interactively with a prefix
-arg, prompt for a regular expression."
-  (interactive (list (and current-prefix-arg
-                          (read-regexp "List faces matching regexp"))))
-  (let ((all-faces (zerop (length regexp)))
-       (frame (selected-frame))
-       (max-length 0)
-       faces line-format
-       disp-frame window face-name)
-    ;; We filter and take the max length in one pass
-    (setq faces
-         (delq nil
-               (mapcar (lambda (f)
-                         (let ((s (symbol-name f)))
-                           (when (or all-faces (string-match-p regexp s))
-                             (setq max-length (max (length s) max-length))
-                             f)))
-                       (sort (face-list) #'string-lessp))))
-    (unless faces
-      (error "No faces matching \"%s\"" regexp))
-    (setq max-length (1+ max-length)
-         line-format (format "%%-%ds" max-length))
-    (with-help-window "*Faces*"
-      (with-current-buffer standard-output
-       (setq truncate-lines t)
-       (insert
-        (substitute-command-keys
-         (concat
-          "\\<help-mode-map>Use "
-          (if (display-mouse-p) "\\[help-follow-mouse] or ")
-          "\\[help-follow] on a face name to customize it\n"
-          "or on its sample text for a description of the face.\n\n")))
-       (setq help-xref-stack nil)
-       (dolist (face faces)
-         (setq face-name (symbol-name face))
-         (insert (format line-format face-name))
-         ;; Hyperlink to a customization buffer for the face.  Using
-         ;; the help xref mechanism may not be the best way.
-         (save-excursion
-           (save-match-data
-             (search-backward face-name)
-             (setq help-xref-stack-item `(list-faces-display ,regexp))
-             (help-xref-button 0 'help-customize-face face)))
-         (let ((beg (point))
-               (line-beg (line-beginning-position)))
-           (insert list-faces-sample-text)
-           ;; Hyperlink to a help buffer for the face.
-           (save-excursion
-             (save-match-data
-               (search-backward list-faces-sample-text)
-               (help-xref-button 0 'help-face face)))
-           (insert "\n")
-           (put-text-property beg (1- (point)) 'face face)
-           ;; Make all face commands default to the proper face
-           ;; anywhere in the line.
-           (put-text-property line-beg (1- (point)) 'read-face-name face)
-           ;; If the sample text has multiple lines, line up all of them.
-           (goto-char beg)
-           (forward-line 1)
-           (while (not (eobp))
-             (insert-char ?\s max-length)
-             (forward-line 1))))
-       (goto-char (point-min))))
-    ;; If the *Faces* buffer appears in a different frame,
-    ;; copy all the face definitions from FRAME,
-    ;; so that the display will reflect the frame that was selected.
-    (setq window (get-buffer-window (get-buffer "*Faces*") t))
-    (setq disp-frame (if window (window-frame window)
-                      (car (frame-list))))
-    (or (eq frame disp-frame)
-       (dolist (face (face-list))
-         (copy-face face face frame disp-frame)))))
-
-
-(defun describe-face (face &optional frame)
-  "Display the properties of face FACE on FRAME.
-Interactively, FACE defaults to the faces of the character after point
-and FRAME defaults to 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."
-  (interactive (list (read-face-name "Describe face"
-                                     (or (face-at-point t) 'default)
-                                     t)))
-  (let* ((attrs '((:family . "Family")
-                 (:foundry . "Foundry")
-                 (:width . "Width")
-                 (:height . "Height")
-                 (:weight . "Weight")
-                 (:slant . "Slant")
-                 (:foreground . "Foreground")
-                 (:background . "Background")
-                 (:underline . "Underline")
-                 (:overline . "Overline")
-                 (:strike-through . "Strike-through")
-                 (:box . "Box")
-                 (:inverse-video . "Inverse")
-                 (:stipple . "Stipple")
-                 (:font . "Font")
-                 (:fontset . "Fontset")
-                 (:inherit . "Inherit")))
-       (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
-                                       attrs))))
-    (help-setup-xref (list #'describe-face face)
-                    (called-interactively-p 'interactive))
-    (unless face
-      (setq face 'default))
-    (if (not (listp face))
-       (setq face (list face)))
-    (with-help-window (help-buffer)
-      (with-current-buffer standard-output
-       (dolist (f face)
-         (if (stringp f) (setq f (intern f)))
-         ;; We may get called for anonymous faces (i.e., faces
-         ;; expressed using prop-value plists).  Those can't be
-         ;; usefully customized, so ignore them.
-         (when (symbolp f)
-           (insert "Face: " (symbol-name f))
-           (if (not (facep f))
-               (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"))
-               ;; FIXME not sure how much of this belongs here, and
-               ;; how much in `face-documentation'.  The latter is
-               ;; not used much, but needs to return nil for
-               ;; undocumented faces.
-               (let ((alias (get f 'face-alias))
-                     (face f)
-                     obsolete)
-                 (when alias
-                   (setq face alias)
-                   (insert
-                    (format "\n  %s is an alias for the face `%s'.\n%s"
-                            f alias
-                            (if (setq obsolete (get f 'obsolete-face))
-                                (format "  This face is obsolete%s; use `%s' instead.\n"
-                                        (if (stringp obsolete)
-                                            (format " since %s" obsolete)
-                                          "")
-                                        alias)
-                              ""))))
-                 (insert "\nDocumentation:\n"
-                         (or (face-documentation face)
-                             "Not documented as a face.")
-                         "\n\n"))
-               (with-current-buffer standard-output
-                 (save-excursion
-                   (re-search-backward
-                    (concat "\\(" customize-label "\\)") nil t)
-                   (help-xref-button 1 'help-customize-face f)))
-               (setq file-name (find-lisp-object-file-name f 'defface))
-               (when file-name
-                 (princ "Defined in `")
-                 (princ (file-name-nondirectory file-name))
-                 (princ "'")
-                 ;; Make a hyperlink to the library.
-                 (save-excursion
-                   (re-search-backward "`\\([^`']+\\)'" nil t)
-                   (help-xref-button 1 'help-face-def f file-name))
-                 (princ ".")
-                 (terpri)
-                 (terpri))
-               (dolist (a attrs)
-                 (let ((attr (face-attribute f (car a) frame)))
-                   (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)))))))
-
-\f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Face specifications (defface).
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1508,13 +1335,15 @@ If FRAME is nil, the current FRAME is used."
     match))
 
 
-(defun face-spec-choose (spec &optional frame)
-  "Choose the proper attributes for FRAME, out of SPEC.
-If SPEC is nil, return nil."
+(defun face-spec-choose (spec &optional frame no-match-retval)
+  "Return the proper attributes for FRAME, out of SPEC.
+
+If no match is found or SPEC is nil, return nil, unless NO-MATCH-RETVAL
+is given, in which case return its value instead."
   (unless frame
     (setq frame (selected-frame)))
   (let ((tail spec)
-       result defaults)
+       result defaults match-found)
     (while tail
       (let* ((entry (pop tail))
             (display (car entry))
@@ -1534,9 +1363,18 @@ If SPEC is nil, return nil."
            (setq defaults thisval)
          ;; Otherwise, if it matches, use it.
          (when (face-spec-set-match-display display frame)
-           (setq result thisval)
-           (setq tail nil)))))
-    (if defaults (append result defaults) result)))
+           (setq result thisval
+                 tail nil
+                 match-found t)))))
+    ;; If defaults have been found, it's safe to just append those to the result
+    ;; list (which at this point will be either nil or contain actual specs) and
+    ;; return it to the caller. Since there will most definitely be something to
+    ;; return in this case, there's no need to know/check if a match was found.
+    (if defaults
+       (append result defaults)
+      (if match-found
+         result
+       no-match-retval))))
 
 
 (defun face-spec-reset-face (face &optional frame)
@@ -1551,16 +1389,16 @@ If SPEC is nil, return nil."
                :box nil :inverse-video nil :stipple nil :inherit nil)
              ;; `display-graphic-p' is unavailable when running
              ;; temacs, prior to loading frame.el.
-             (unless (and (fboundp 'display-graphic-p)
-                          (display-graphic-p frame))
-               `(:family "default" :foundry "default" :width normal
-                 :height 1 :weight normal :slant normal
-                 :foreground ,(if (frame-parameter nil 'reverse)
-                                  "unspecified-bg"
-                                "unspecified-fg")
-                 :background ,(if (frame-parameter nil 'reverse)
-                                  "unspecified-fg"
-                                "unspecified-bg"))))
+             (when (fboundp 'display-graphic-p)
+               (unless (display-graphic-p frame)
+                 `(:family "default" :foundry "default" :width normal
+                   :height 1 :weight normal :slant normal
+                   :foreground ,(if (frame-parameter nil 'reverse)
+                                    "unspecified-bg"
+                                  "unspecified-fg")
+                   :background ,(if (frame-parameter nil 'reverse)
+                                    "unspecified-fg"
+                                  "unspecified-bg")))))
           ;; For all other faces, unspecify all attributes.
           (apply 'append
                  (mapcar (lambda (x) (list (car x) 'unspecified))
@@ -1570,9 +1408,13 @@ If SPEC is nil, return nil."
   "Set the face spec SPEC for FACE.
 See `defface' for the format of SPEC.
 
-The appearance of each face is controlled by its spec, and by the
-internal face attributes (which can be frame-specific and can be
-set via `set-face-attribute').
+The appearance of each face is controlled by its specs (set via
+this function), and by the internal frame-specific face
+attributes (set via `set-face-attribute').
+
+This function also defines FACE as a valid face name if it is not
+already one, and (re)calculates its attributes on existing
+frames.
 
 The argument SPEC-TYPE determines which spec to set:
   nil or `face-override-spec' means the override spec (which is
@@ -1585,11 +1427,7 @@ The argument SPEC-TYPE determines which spec to set:
   `reset' means to ignore SPEC, but clear the `customized-face'
     and `face-override-spec' specs;
 Any other value means not to set any spec, but to run the
-function for its other effects.
-
-In addition to setting the face spec, this function defines FACE
-as a valid face name if it is not already one, and (re)calculates
-the face's attributes on existing frames."
+function for its other effects."
   (if (get face 'face-alias)
       (setq face (get face 'face-alias)))
   ;; Save SPEC to the relevant symbol property.
@@ -1608,42 +1446,54 @@ the face's attributes on existing frames."
   ;; as far as Custom is concerned.
   (unless (eq face 'face-override-spec)
     (put face 'face-modified nil))
-  (if (facep face)
-      ;; If the face already exists, recalculate it.
-      (dolist (frame (frame-list))
-       (face-spec-recalc face frame))
-    ;; Otherwise, initialize it on all frames.
-    (make-empty-face face)
-    (let ((value (face-user-default-spec face))
-         (have-window-system (memq initial-window-system '(x w32 ns))))
-      (dolist (frame (frame-list))
-       (face-spec-set-2 face frame value)
-       (when (memq (window-system frame) '(x w32 ns))
-         (setq have-window-system t)))
-      (if have-window-system
-         (make-face-x-resource-internal face)))))
+  ;; Initialize the face if it does not exist, then recalculate.
+  (make-empty-face face)
+  (dolist (frame (frame-list))
+    (face-spec-recalc face frame)))
 
 (defun face-spec-recalc (face frame)
   "Reset the face attributes of FACE on FRAME according to its specs.
-This applies the defface/custom spec first, then the custom theme specs,
-then the override spec."
+The following sources are applied in this order:
+
+  face reset to default values if it's the default face, otherwise set
+  to unspecified (through `face-spec-reset-face')
+   |
+  (theme and user customization)
+    or: if none of the above exist, and none match the current frame or
+        inherited from the defface spec instead of overwriting it
+        entirely, the following is applied instead:
+  (defface default spec)
+  (X resources (if applicable))
+   |
+  defface override spec"
   (while (get face 'face-alias)
     (setq face (get face 'face-alias)))
   (face-spec-reset-face face frame)
   ;; If FACE is customized or themed, set the custom spec from
-  ;; `theme-face' records, which completely replace the defface spec
-  ;; rather than inheriting from it.
-  (let ((theme-faces (get face 'theme-face)))
+  ;; `theme-face' records.
+  (let ((theme-faces (get face 'theme-face))
+       (no-match-found 0)
+       spec theme-face-applied)
     (if theme-faces
-       (dolist (spec (reverse theme-faces))
-         (face-spec-set-2 face frame (cadr spec)))
-      (face-spec-set-2 face frame (face-default-spec face))))
-  (face-spec-set-2 face frame (get face 'face-override-spec)))
+       (dolist (elt (reverse theme-faces))
+         (setq spec (face-spec-choose (cadr elt) frame no-match-found))
+         (unless (eq spec no-match-found)
+           (face-spec-set-2 face frame spec)
+           (setq theme-face-applied t))))
+    ;; If there was a spec applicable to FRAME, that overrides the
+    ;; defface spec entirely (rather than inheriting from it).  If
+    ;; there was no spec applicable to FRAME, apply the defface spec
+    ;; as well as any applicable X resources.
+    (unless theme-face-applied
+      (setq spec (face-spec-choose (face-default-spec face) frame))
+      (face-spec-set-2 face frame spec)
+      (make-face-x-resource-internal face frame))
+    (setq spec (face-spec-choose (get face 'face-override-spec) frame))
+    (face-spec-set-2 face frame spec)))
 
 (defun face-spec-set-2 (face frame spec)
   "Set the face attributes of FACE on FRAME according to SPEC."
-  (let* ((spec (face-spec-choose spec frame))
-        attrs)
+  (let (attrs)
     (while spec
       (when (assq (car spec) face-x-resources)
        (push (car spec) attrs)
@@ -1833,7 +1683,7 @@ resulting color name in the echo area."
                         (if (color-defined-p string)
                             (list string))))
                    ((eq flag 'lambda) ; Test completion.
-                    (or (memq string colors)
+                    (or (member string colors)
                         (color-defined-p string)))))
                 nil t)))
 
@@ -1921,6 +1771,11 @@ Return nil if there is no face."
 ;;; Frame creation.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(declare-function x-display-list "xfns.c" ())
+(declare-function x-open-connection "xfns.c"
+                 (display &optional xrm-string must-succeed))
+(declare-function x-get-resource "frame.c"
+                 (attribute class &optional component subclass))
 (declare-function x-parse-geometry "frame.c" (string))
 (defvar x-display-name)
 
@@ -2011,21 +1866,16 @@ Calculate the face definitions using the face specs, custom theme
 settings, X resources, and `face-new-frame-defaults'.
 Finally, apply any relevant face attributes found amongst the
 frame parameters in PARAMETERS."
-  (let ((window-system-p (memq (window-system frame) '(x w32))))
-    ;; The `reverse' is so that `default' goes first.
-    (dolist (face (nreverse (face-list)))
-      (condition-case ()
-         (progn
-           ;; Initialize faces from face spec and custom theme.
-           (face-spec-recalc face frame)
-           ;; X resources for the default face are applied during
-           ;; `x-create-frame'.
-           (and (not (eq face 'default)) window-system-p
-                (make-face-x-resource-internal face frame))
-           ;; Apply attributes specified by face-new-frame-defaults
-           (internal-merge-in-global-face face frame))
-       ;; Don't let invalid specs prevent frame creation.
-       (error nil))))
+  ;; The `reverse' is so that `default' goes first.
+  (dolist (face (nreverse (face-list)))
+    (condition-case ()
+       (progn
+         ;; Initialize faces from face spec and custom theme.
+         (face-spec-recalc face frame)
+         ;; Apply attributes specified by face-new-frame-defaults
+         (internal-merge-in-global-face face frame))
+      ;; Don't let invalid specs prevent frame creation.
+      (error nil)))
 
   ;; Apply attributes specified by frame parameters.
   (let ((face-params '((foreground-color default :foreground)
@@ -2072,7 +1922,7 @@ If PARAMETERS contains a `reverse' parameter, handle that."
           (unless (terminal-parameter frame 'terminal-initted)
             (set-terminal-parameter frame 'terminal-initted t)
             (set-locale-environment nil frame)
-            (tty-run-terminal-initialization frame))
+            (tty-run-terminal-initialization frame nil t))
          (frame-set-background-mode frame t)
          (face-set-after-frame-default frame parameters)
          (setq success t))
@@ -2099,13 +1949,24 @@ the above example."
 
 (defvar tty-setup-hook nil
   "Hook run after running the initialization function of a new text terminal.
+Specifically, `tty-run-terminal-initialization' runs this.
 This can be used to fine tune the `input-decode-map', for example.")
 
-(defun tty-run-terminal-initialization (frame &optional type)
+(defun tty-run-terminal-initialization (frame &optional type run-hook)
   "Run the special initialization code for the terminal type of FRAME.
 The optional TYPE parameter may be used to override the autodetected
-terminal type to a different value."
+terminal type to a different value.
+
+This consults `term-file-aliases' to map terminal types to their aliases.
+
+If optional argument RUN-HOOK is non-nil, then as a final step,
+this runs the hook `tty-setup-hook'.
+
+If you set `term-file-prefix' to nil, this function does nothing."
   (setq type (or type (tty-type frame)))
+  (let ((alias (tty-find-type
+               (lambda (typ) (assoc typ term-file-aliases)) type)))
+    (if alias (setq type (cdr (assoc alias term-file-aliases)))))
   ;; Load library for our terminal type.
   ;; User init file can set term-file-prefix to nil to prevent this.
   (with-selected-frame frame
@@ -2127,7 +1988,7 @@ terminal type to a different value."
        (when (fboundp term-init-func)
          (funcall term-init-func))
        (set-terminal-parameter frame 'terminal-initted term-init-func)
-       (run-hooks 'tty-setup-hook)))))
+       (if run-hook (run-hooks 'tty-setup-hook))))))
 
 ;; Called from C function init_display to initialize faces of the
 ;; dumped terminal frame on startup.
@@ -2137,7 +1998,6 @@ terminal type to a different value."
     (frame-set-background-mode frame t)
     (face-set-after-frame-default frame)))
 
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Standard faces.
@@ -2251,10 +2111,11 @@ terminal type to a different value."
   '((((class color) (min-colors 88) (background dark))
      :background "blue3")
     (((class color) (min-colors 88) (background light) (type gtk))
-     :foreground "gtk_selection_fg_color"
+     :distant-foreground "gtk_selection_fg_color"
      :background "gtk_selection_bg_color")
     (((class color) (min-colors 88) (background light) (type ns))
-     :background "ns_selection_color")
+     :distant-foreground "ns_selection_fg_color"
+     :background "ns_selection_bg_color")
     (((class color) (min-colors 88) (background light))
      :background "lightgoldenrod2")
     (((class color) (min-colors 16) (background dark))
@@ -2417,6 +2278,39 @@ Use the face `mode-line-highlight' for features that can be selected."
   :version "22.1"
   :group 'basic-faces)
 
+(defface window-divider '((t :foreground "gray60"))
+  "Basic face for window dividers.
+When a divider is less than 3 pixels wide, it is drawn solidly
+with the foreground of this face.  For larger dividers this face
+is used for the inner part while the first pixel line/column is
+drawn with the `window-divider-first-pixel' face and the last
+pixel line/column with the `window-divider-last-pixel' face."
+  :version "24.4"
+  :group 'frames
+  :group 'basic-faces)
+
+(defface window-divider-first-pixel
+  '((t :foreground "gray80"))
+  "Basic face for first pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its first pixel
+line/column is drawn with the foreground of this face.  If you do
+not want to accentuate the first pixel line/column, set this to
+the same as `window-divider' face."
+  :version "24.4"
+  :group 'frames
+  :group 'basic-faces)
+
+(defface window-divider-last-pixel
+  '((t :foreground "gray40"))
+  "Basic face for last pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its last pixel
+line/column is drawn with the foreground of this face.  If you do
+not want to accentuate the last pixel line/column, set this to
+the same as `window-divider' face."
+  :version "24.4"
+  :group 'frames
+  :group 'basic-faces)
+
 (defface minibuffer-prompt
   '((((background dark)) :foreground "cyan")
     ;; Don't use blue because many users of the MS-DOS port customize
@@ -2545,6 +2439,50 @@ It is used for characters of no fonts too."
   :version "24.1"
   :group 'basic-faces)
 
+;; Faces for TTY menus.
+(defface tty-menu-enabled-face
+  '((t
+     :foreground "yellow" :background "blue" :weight bold))
+  "Face for displaying enabled items in TTY menus."
+  :group 'basic-faces)
+
+(defface tty-menu-disabled-face
+  '((((class color) (min-colors 16))
+     :foreground "lightgray" :background "blue")
+    (t
+     :foreground "white" :background "blue"))
+  "Face for displaying disabled items in TTY menus."
+  :group 'basic-faces)
+
+(defface tty-menu-selected-face
+  '((t :background "red"))
+  "Face for displaying the currently selected item in TTY menus."
+  :group 'basic-faces)
+
+(defgroup paren-showing-faces nil
+  "Faces used to highlight paren matches."
+  :group 'paren-showing
+  :group 'faces
+  :version "22.1")
+
+(defface show-paren-match
+  '((((class color) (background light))
+     :background "turquoise")          ; looks OK on tty (becomes cyan)
+    (((class color) (background dark))
+     :background "steelblue3")         ; looks OK on tty (becomes blue)
+    (((background dark))
+     :background "grey50")
+    (t
+     :background "gray"))
+  "Face used for a matching paren."
+  :group 'paren-showing-faces)
+
+(defface show-paren-mismatch
+  '((((class color)) (:foreground "white" :background "purple"))
+    (t (:inverse-video t)))
+  "Face used for a mismatching paren."
+  :group 'paren-showing-faces)
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Manipulating font names.