X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f5e4494cd06f7624382f815585419f489bfe36c3..8be099a2c10ce4718e6630cef6b6ca1983617264:/lisp/faces.el

diff --git a/lisp/faces.el b/lisp/faces.el
index e4d8a35ac6..1d4fc9c557 100644
--- 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 "25.1")
+
 (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.
@@ -1635,18 +1652,22 @@ function for its other effects."
 
 (defun face-spec-recalc (face frame)
   "Reset the face attributes of FACE on FRAME according to its specs.
-After the reset, the specs are applied from the following sources in this order:
-  X resources (if applicable)
+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 nonexistent or does not match the current frame,
+    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)
-  (make-face-x-resource-internal face frame)
   ;; If FACE is customized or themed, set the custom spec from
   ;; `theme-face' records.
   (let ((theme-faces (get face 'theme-face))
@@ -1660,10 +1681,12 @@ After the reset, the specs are applied from the following sources in this order:
 	    (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.
+    ;; 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))
+      (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)))
 
@@ -1802,7 +1825,9 @@ If omitted or nil, that stands for the selected frame's display."
 (declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
 
 (defun display-grayscale-p (&optional display)
-  "Return non-nil if frames on DISPLAY can display shades of gray."
+  "Return non-nil if frames on DISPLAY can display shades of gray.
+DISPLAY should be either a frame or a display name (a string).
+If omitted or nil, that stands for the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -2042,17 +2067,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)
@@ -2068,7 +2092,8 @@ frame parameters in PARAMETERS."
   	     (value (cdr (assq param-name parameters))))
   	(if value
   	    (set-face-attribute (nth 1 param) frame
-				(nth 2 param) value))))))
+				(nth 2 param) value))))
+    (frame-can-run-window-configuration-change-hook frame t)))
 
 (defun tty-handle-reverse-video (frame parameters)
   "Handle the reverse-video frame parameter for terminal frames."
@@ -2134,11 +2159,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
@@ -2719,8 +2749,6 @@ If PATTERN is nil, return the name of the frame's base font, which never
 contains wildcards.
 Given optional arguments FACE and FRAME, return a font which is
 also the same size as FACE on FRAME, or fail."
-  (or (symbolp face)
-      (setq face (face-name face)))
   (and (eq frame t)
        (setq frame nil))
   (if pattern