Merge from emacs-24; up to 2014-05-01T10:21:17Z!rgm@gnu.org

[bpt/emacs.git] / lisp / faces.el

diff --git a/lisp/faces.el b/lisp/faces.el
index 7caba9a..d8b3c7a 100644 (file)
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -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,15 +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 FACE is already known as a face, leave it unmodified.  Return FACE.
-
-NO-INIT-FROM-RESOURCES has been deprecated and is no longer used
-and will go away.  Handling of conditional X resources application
-has been pushed down to make-x-resource-internal itself."
+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)
@@ -151,11 +167,6 @@ has been pushed down to make-x-resource-internal itself."
     (make-face-x-resource-internal face))
   face)
 
-;; Handling of whether to apply X resources or not, has been pushed down
-;; to make-face-x-resource-internal itself, thus the optional arg is no
-;; longer evaluated at all and going away.
-(set-advertised-calling-convention 'make-face '(face) "24.4")
-
 (defun make-empty-face (face)
   "Define a new, empty face with name FACE.
 Do not call this directly from Lisp code; use `defface' instead."
@@ -2054,17 +2065,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)
-           ;; 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)
@@ -2146,11 +2156,16 @@ This can be used to fine tune the `input-decode-map', for example.")
 The optional TYPE parameter may be used to override the autodetected
 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