unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Face initialization
@ 2008-07-06  5:57 Chong Yidong
  2008-07-06 13:41 ` Stefan Monnier
  2008-07-06 18:47 ` Richard M Stallman
  0 siblings, 2 replies; 22+ messages in thread
From: Chong Yidong @ 2008-07-06  5:57 UTC (permalink / raw)
  To: emacs-devel

After staring at face-set-after-frame-default for a while, I think it
can be simplified somewhat.  If we only set frame parameters based on
the parameter list explicitly passed to `make-frame', it shouldn't be
necessary to mess around with the default face in the beginning of the
function.  Also, the call to make-face-x-resource-internal seems to be
unnecessary.  I think this also fixes some of the problems with faces in
new frames that we've been seeing.

Could someone test this patch out and see if I've missed anything?


*** trunk/lisp/faces.el.~1.417.~	2008-07-06 01:05:46.000000000 -0400
--- trunk/lisp/faces.el	2008-07-06 01:46:31.000000000 -0400
***************
*** 1993,1999 ****
  	  (x-setup-function-keys frame)
  	  (x-handle-reverse-video frame parameters)
  	  (frame-set-background-mode frame)
! 	  (face-set-after-frame-default frame)
  	  ;; Make sure the tool-bar is ready to be enabled.  The
  	  ;; `tool-bar-lines' frame parameter will not take effect
  	  ;; without this call.
--- 1993,1999 ----
  	  (x-setup-function-keys frame)
  	  (x-handle-reverse-video frame parameters)
  	  (frame-set-background-mode frame)
! 	  (face-set-after-frame-default frame parameters)
  	  ;; Make sure the tool-bar is ready to be enabled.  The
  	  ;; `tool-bar-lines' frame parameter will not take effect
  	  ;; without this call.
***************
*** 2006,2031 ****
  	(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)))
    ;; Find attributes that should be initialized from frame parameters.
    (let ((face-params '((foreground-color default :foreground)
  		       (background-color default :background)
!                        (font-parameter default :font)
  		       (border-color border :background)
  		       (cursor-color cursor :background)
  		       (scroll-bar-foreground scroll-bar :foreground)
--- 2006,2018 ----
  	(delete-frame frame)))
      frame))
  
! (defun face-set-after-frame-default (frame parameters)
    "Set frame-local faces of FRAME from face specs and resources.
  Initialize colors of certain faces from frame parameters."
    ;; Find attributes that should be initialized from frame parameters.
    (let ((face-params '((foreground-color default :foreground)
  		       (background-color default :background)
!                        (font default :font)
  		       (border-color border :background)
  		       (cursor-color cursor :background)
  		       (scroll-bar-foreground scroll-bar :foreground)
***************
*** 2033,2071 ****
  		       (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 (face-list))
-       ;; This loop used to exclude the `default' face for an unknown reason.
-       ;; It lead to odd behaviors where face-spec settings on the `default'
-       ;; face weren't obeyed for new frame.
        (condition-case ()
  	  (progn
  	    (face-spec-recalc face frame)
- 	    (if (memq (window-system frame) '(x w32 mac))
- 		(make-face-x-resource-internal face frame))
  	    (internal-merge-in-global-face 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))))
  
--- 2020,2046 ----
  		       (mouse-color mouse :background)))
  	apply-params)
      (dolist (param face-params)
!       (let* ((param-name (nth 0 param))
  	     (face (nth 1 param))
  	     (attr (nth 2 param))
! 	     (value (cdr (or (assq param-name parameters)
! 			     (assq param-name default-frame-alist)))))
  	;; 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 value
! 	    (push (list face frame attr value) apply-params))))
!     ;; Initialize faces from face specs and face-new-frame-defaults.
!     ;; The condition-case prevents invalid specs from causing frame
      ;; creation to fail.
      (dolist (face (face-list))
        (condition-case ()
  	  (progn
  	    (face-spec-recalc face frame)
  	    (internal-merge-in-global-face face frame))
  	(error nil)))
!     ;; Apply the attributes specified by frame parameters.
      (dolist (param apply-params)
        (apply 'set-face-attribute param))))
  
***************
*** 2104,2110 ****
              (set-locale-environment nil frame)
              (tty-run-terminal-initialization frame))
  	  (frame-set-background-mode frame)
! 	  (face-set-after-frame-default frame)
  	  (setq success t))
        (unless success
  	(delete-frame frame)))
--- 2079,2085 ----
              (set-locale-environment nil frame)
              (tty-run-terminal-initialization frame))
  	  (frame-set-background-mode frame)
! 	  (face-set-after-frame-default frame parameters)
  	  (setq success t))
        (unless success
  	(delete-frame frame)))
***************
*** 2160,2166 ****
  (defun tty-set-up-initial-frame-faces ()
    (let ((frame (selected-frame)))
      (frame-set-background-mode frame)
!     (face-set-after-frame-default frame)))
  
  
  
--- 2135,2141 ----
  (defun tty-set-up-initial-frame-faces ()
    (let ((frame (selected-frame)))
      (frame-set-background-mode frame)
!     (face-set-after-frame-default frame nil)))
  
  
  




^ permalink raw reply	[flat|nested] 22+ messages in thread

end of thread, other threads:[~2008-07-10 16:07 UTC | newest]

Thread overview: 22+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2008-07-06  5:57 Face initialization Chong Yidong
2008-07-06 13:41 ` Stefan Monnier
2008-07-06 13:58   ` Chong Yidong
2008-07-06 21:28     ` Richard M Stallman
2008-07-07  2:51       ` Chong Yidong
2008-07-07  1:56     ` Stefan Monnier
2008-07-07  3:06       ` Chong Yidong
2008-07-07  4:37         ` Stefan Monnier
2008-07-07 11:38           ` Richard M Stallman
2008-07-07 19:24             ` Stephen J. Turnbull
2008-07-08 12:52               ` Richard M Stallman
2008-07-08 13:40                 ` Jason Rumney
2008-07-08 23:06                   ` Richard M Stallman
2008-07-07 11:38         ` Richard M Stallman
2008-07-07 14:00           ` Chong Yidong
2008-07-09 21:45             ` Jason Rumney
2008-07-10  2:54               ` Chong Yidong
2008-07-10  3:09               ` Miles Bader
2008-07-10  8:16                 ` Jason Rumney
2008-07-10 15:52                   ` Stefan Monnier
2008-07-10 16:07                     ` Jason Rumney
2008-07-06 18:47 ` Richard M Stallman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).