diff options
| -rw-r--r-- | lisp/faces.el | 98 |
1 files changed, 36 insertions, 62 deletions
diff --git a/lisp/faces.el b/lisp/faces.el index 02daaa82f85..1524de4dab9 100644 --- a/lisp/faces.el +++ b/lisp/faces.el | |||
| @@ -1993,7 +1993,7 @@ Value is the new frame created." | |||
| 1993 | (x-setup-function-keys frame) | 1993 | (x-setup-function-keys frame) |
| 1994 | (x-handle-reverse-video frame parameters) | 1994 | (x-handle-reverse-video frame parameters) |
| 1995 | (frame-set-background-mode frame) | 1995 | (frame-set-background-mode frame) |
| 1996 | (face-set-after-frame-default frame) | 1996 | (face-set-after-frame-default frame parameters) |
| 1997 | ;; Make sure the tool-bar is ready to be enabled. The | 1997 | ;; Make sure the tool-bar is ready to be enabled. The |
| 1998 | ;; `tool-bar-lines' frame parameter will not take effect | 1998 | ;; `tool-bar-lines' frame parameter will not take effect |
| 1999 | ;; without this call. | 1999 | ;; without this call. |
| @@ -2006,68 +2006,42 @@ Value is the new frame created." | |||
| 2006 | (delete-frame frame))) | 2006 | (delete-frame frame))) |
| 2007 | frame)) | 2007 | frame)) |
| 2008 | 2008 | ||
| 2009 | (defun face-set-after-frame-default (frame) | 2009 | (defun face-set-after-frame-default (frame &optional parameters) |
| 2010 | "Set frame-local faces of FRAME from face specs and resources. | 2010 | "Initialize the frame-local faces of FRAME. |
| 2011 | Initialize colors of certain faces from frame parameters." | 2011 | Calculate the face definitions using the face specs, custom theme |
| 2012 | (if (face-attribute 'default :font t) | 2012 | settings, and `face-new-frame-defaults' (in that order). |
| 2013 | (set-face-attribute 'default frame :font | 2013 | Finally, apply any relevant face attributes found amongst the |
| 2014 | (face-attribute 'default :font t)) | 2014 | frame parameters in PARAMETERS and `default-frame-alist'." |
| 2015 | (set-face-attribute 'default frame :family | 2015 | (dolist (face (nreverse (face-list))) |
| 2016 | (face-attribute 'default :family t)) | 2016 | (condition-case () |
| 2017 | (set-face-attribute 'default frame :height | 2017 | ;; We used to apply X resources within this loop, because X |
| 2018 | (face-attribute 'default :height t)) | 2018 | ;; resources could be frame-specific. We don't do that any |
| 2019 | (set-face-attribute 'default frame :slant | 2019 | ;; more, because this interacts poorly with specifying faces |
| 2020 | (face-attribute 'default :slant t)) | 2020 | ;; via frame parameters and Lisp faces. (X resouces for Emacs |
| 2021 | (set-face-attribute 'default frame :weight | 2021 | ;; as a whole are applied during x-create-frame.) |
| 2022 | (face-attribute 'default :weight t)) | 2022 | (progn |
| 2023 | (set-face-attribute 'default frame :width | 2023 | ;; Initialize faces from face spec and custom theme. |
| 2024 | (face-attribute 'default :width t))) | 2024 | (face-spec-recalc face frame) |
| 2025 | ;; Find attributes that should be initialized from frame parameters. | 2025 | ;; Apply attributes specified by face-new-frame-defaults |
| 2026 | (internal-merge-in-global-face face frame)) | ||
| 2027 | ;; Don't let invalid specs prevent frame creation. | ||
| 2028 | (error nil))) | ||
| 2029 | ;; Apply attributes specified by frame parameters. | ||
| 2026 | (let ((face-params '((foreground-color default :foreground) | 2030 | (let ((face-params '((foreground-color default :foreground) |
| 2027 | (background-color default :background) | 2031 | (background-color default :background) |
| 2028 | (font-parameter default :font) | 2032 | (font default :font) |
| 2029 | (border-color border :background) | 2033 | (border-color border :background) |
| 2030 | (cursor-color cursor :background) | 2034 | (cursor-color cursor :background) |
| 2031 | (scroll-bar-foreground scroll-bar :foreground) | 2035 | (scroll-bar-foreground scroll-bar :foreground) |
| 2032 | (scroll-bar-background scroll-bar :background) | 2036 | (scroll-bar-background scroll-bar :background) |
| 2033 | (mouse-color mouse :background))) | 2037 | (mouse-color mouse :background)))) |
| 2034 | apply-params) | ||
| 2035 | (dolist (param face-params) | 2038 | (dolist (param face-params) |
| 2036 | (let* ((value (frame-parameter frame (nth 0 param))) | 2039 | (let* ((param-name (nth 0 param)) |
| 2037 | (face (nth 1 param)) | 2040 | (value (cdr (or (assq param-name parameters) |
| 2038 | (attr (nth 2 param)) | 2041 | (assq param-name default-frame-alist))))) |
| 2039 | (default-value (face-attribute face attr t))) | 2042 | (if value |
| 2040 | ;; Compile a list of face attributes to set, but don't set | 2043 | (set-face-attribute (nth 1 param) frame |
| 2041 | ;; them yet. The call to make-face-x-resource-internal, | 2044 | (nth 2 param) value)))))) |
| 2042 | ;; below, can change frame parameters, and the final set of | ||
| 2043 | ;; frame parameters should be the ones acquired at this step. | ||
| 2044 | (if (eq default-value 'unspecified) | ||
| 2045 | ;; The face spec does not specify a new-frame value for | ||
| 2046 | ;; this attribute. Check if the existing frame parameter | ||
| 2047 | ;; specifies it. | ||
| 2048 | (if value | ||
| 2049 | (push (list face frame attr value) apply-params)) | ||
| 2050 | ;; The face spec specifies a value for this attribute, to be | ||
| 2051 | ;; applied to the face on all new frames. | ||
| 2052 | (push (list face frame attr default-value) apply-params)))) | ||
| 2053 | ;; Initialize faces from face specs and X resources. The | ||
| 2054 | ;; condition-case prevents invalid specs from causing frame | ||
| 2055 | ;; creation to fail. | ||
| 2056 | (dolist (face (face-list)) | ||
| 2057 | ;; This loop used to exclude the `default' face for an unknown reason. | ||
| 2058 | ;; It lead to odd behaviors where face-spec settings on the `default' | ||
| 2059 | ;; face weren't obeyed for new frame. | ||
| 2060 | (condition-case () | ||
| 2061 | (progn | ||
| 2062 | (face-spec-recalc face frame) | ||
| 2063 | (if (memq (window-system frame) '(x w32 mac)) | ||
| 2064 | (make-face-x-resource-internal face frame)) | ||
| 2065 | (internal-merge-in-global-face face frame)) | ||
| 2066 | (error nil))) | ||
| 2067 | ;; Apply the attributes specified by frame parameters. This | ||
| 2068 | ;; rewrites parameters changed by make-face-x-resource-internal | ||
| 2069 | (dolist (param apply-params) | ||
| 2070 | (apply 'set-face-attribute param)))) | ||
| 2071 | 2045 | ||
| 2072 | (defun tty-handle-reverse-video (frame parameters) | 2046 | (defun tty-handle-reverse-video (frame parameters) |
| 2073 | "Handle the reverse-video frame parameter for terminal frames." | 2047 | "Handle the reverse-video frame parameter for terminal frames." |
| @@ -2104,7 +2078,7 @@ created." | |||
| 2104 | (set-locale-environment nil frame) | 2078 | (set-locale-environment nil frame) |
| 2105 | (tty-run-terminal-initialization frame)) | 2079 | (tty-run-terminal-initialization frame)) |
| 2106 | (frame-set-background-mode frame) | 2080 | (frame-set-background-mode frame) |
| 2107 | (face-set-after-frame-default frame) | 2081 | (face-set-after-frame-default frame parameters) |
| 2108 | (setq success t)) | 2082 | (setq success t)) |
| 2109 | (unless success | 2083 | (unless success |
| 2110 | (delete-frame frame))) | 2084 | (delete-frame frame))) |