comparison lisp/faces.el @ 109089:bd58a72bb9bb

Fix application of default-frame-alist (Bug#5378). * lisp/frame.el (make-frame): Add default-frame-alist to the PARAMETERS argument passed to frame-creation-function (Bug#5378). * lisp/faces.el (x-handle-named-frame-geometry) (x-handle-reverse-video, x-create-frame-with-faces) (face-set-after-frame-default, tty-create-frame-with-faces): Don't separately consult default-frame-alist. It is now passed as the PARAMETER argument. * src/frame.c (get_future_frame_param, Fmake_terminal_frame): Don't check default-frame-alist.

109088:05a72c8a402b

(defun x-handle-named-frame-geometry (parameters)
  "Add geometry parameters for a named frame to parameter list PARAMETERS.
Value is the new parameter list."
  ;; Note that `x-resource-name' has a global meaning.
  (let ((x-resource-name (or (cdr (assq 'name parameters))
			     (cdr (assq 'name default-frame-alist)))))
    (when x-resource-name
      ;; Before checking X resources, we must have an X connection.
      (or (window-system)
	  (x-display-list)
	  (x-open-connection (or (cdr (assq 'display parameters))
				 x-display-name)))
      (let (res-geometry parsed)
	(and (setq res-geometry (x-get-resource "geometry" "Geometry"))
	     (setq parsed (x-parse-geometry res-geometry))
	     (setq parameters
		   (append parameters default-frame-alist parsed
			   ;; If the resource specifies a position,
			   ;; take note of that.
			   (if (or (assq 'top parsed) (assq 'left parsed))
			       '((user-position . t) (user-size . t)))))))))
  parameters)

(defun x-handle-reverse-video (frame parameters)
  "Handle the reverse-video frame parameter and X resource.
`x-create-frame' does not handle this one."
  (when (cdr (or (assq 'reverse parameters)
		 (assq 'reverse default-frame-alist)
		 (let ((resource (x-get-resource "reverseVideo"
						 "ReverseVideo")))
		   (if resource
		       (cons nil (member (downcase resource)
					 '("on" "true")))))))

(declare-function x-create-frame "xfns.c" (parms))
(declare-function x-setup-function-keys "term/x-win" (frame))

(defun x-create-frame-with-faces (&optional parameters)
  "Create a frame from optional frame parameters PARAMETERS.
Parameters not specified by PARAMETERS are taken from
`default-frame-alist'.  If PARAMETERS specify a frame name,
handle X geometry resources for that name.  If either PARAMETERS
or `default-frame-alist' contains a `reverse' parameter, or
the X resource ``reverseVideo'' is present, handle that.
Value is the new frame created."
  (setq parameters (x-handle-named-frame-geometry parameters))
  (let* ((params (copy-tree parameters))
	 (visibility-spec (assq 'visibility parameters))
	 (delayed-params '(foreground-color background-color font
			   border-color cursor-color mouse-color

(defun face-set-after-frame-default (frame &optional parameters)
  "Initialize the frame-local faces of FRAME.
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 and `default-frame-alist'."
  (dolist (face (nreverse (face-list))) ;Why reverse?  --Stef
    (condition-case ()
	(progn
	  ;; Initialize faces from face spec and custom theme.
	  (face-spec-recalc face frame)

  		       (scroll-bar-foreground scroll-bar :foreground)
  		       (scroll-bar-background scroll-bar :background)
  		       (mouse-color mouse :background))))
    (dolist (param face-params)
      (let* ((param-name (nth 0 param))
  	     (value (cdr (or (assq param-name parameters)
  			     (assq param-name default-frame-alist)))))
  	(if value
  	    (set-face-attribute (nth 1 param) frame
				(nth 2 param) value))))))

(defun tty-handle-reverse-video (frame parameters)
  "Handle the reverse-video frame parameter for terminal frames."
  (when (cdr (or (assq 'reverse parameters)
		 (assq 'reverse default-frame-alist)))
    (let* ((params (frame-parameters frame))
	   (bg (cdr (assq 'foreground-color params)))
	   (fg (cdr (assq 'background-color params))))
      (modify-frame-parameters frame
			       (list (cons 'foreground-color fg)

	  (modify-frame-parameters frame
				   (list (cons 'cursor-color fg)))))))


(defun tty-create-frame-with-faces (&optional parameters)
  "Create a frame from optional frame parameters PARAMETERS.
Parameters not specified by PARAMETERS are taken from
`default-frame-alist'.  If either PARAMETERS or `default-frame-alist'
contains a `reverse' parameter, handle that.  Value is the new frame
created."
  (let ((frame (make-terminal-frame parameters))
	success)
    (unwind-protect
	(with-selected-frame frame
	  (tty-handle-reverse-video frame (frame-parameters frame))

109089:bd58a72bb9bb

(defun x-handle-named-frame-geometry (parameters)
  "Add geometry parameters for a named frame to parameter list PARAMETERS.
Value is the new parameter list."
  ;; Note that `x-resource-name' has a global meaning.
  (let ((x-resource-name (cdr (assq 'name parameters))))
    (when x-resource-name
      ;; Before checking X resources, we must have an X connection.
      (or (window-system)
	  (x-display-list)
	  (x-open-connection (or (cdr (assq 'display parameters))
				 x-display-name)))
      (let (res-geometry parsed)
	(and (setq res-geometry (x-get-resource "geometry" "Geometry"))
	     (setq parsed (x-parse-geometry res-geometry))
	     (setq parameters
		   (append parameters parsed
			   ;; If the resource specifies a position,
			   ;; take note of that.
			   (if (or (assq 'top parsed) (assq 'left parsed))
			       '((user-position . t) (user-size . t)))))))))
  parameters)

(defun x-handle-reverse-video (frame parameters)
  "Handle the reverse-video frame parameter and X resource.
`x-create-frame' does not handle this one."
  (when (cdr (or (assq 'reverse parameters)
		 (let ((resource (x-get-resource "reverseVideo"
						 "ReverseVideo")))
		   (if resource
		       (cons nil (member (downcase resource)
					 '("on" "true")))))))

(declare-function x-create-frame "xfns.c" (parms))
(declare-function x-setup-function-keys "term/x-win" (frame))

(defun x-create-frame-with-faces (&optional parameters)
  "Create and return a frame with frame parameters PARAMETERS.
If PARAMETERS specify a frame name, handle X geometry resources
for that name.  If PARAMETERS includes a `reverse' parameter, or
the X resource ``reverseVideo'' is present, handle that."
  (setq parameters (x-handle-named-frame-geometry parameters))
  (let* ((params (copy-tree parameters))
	 (visibility-spec (assq 'visibility parameters))
	 (delayed-params '(foreground-color background-color font
			   border-color cursor-color mouse-color

(defun face-set-after-frame-default (frame &optional parameters)
  "Initialize the frame-local faces of FRAME.
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."
  (dolist (face (nreverse (face-list))) ;Why reverse?  --Stef
    (condition-case ()
	(progn
	  ;; Initialize faces from face spec and custom theme.
	  (face-spec-recalc face frame)

  		       (scroll-bar-foreground scroll-bar :foreground)
  		       (scroll-bar-background scroll-bar :background)
  		       (mouse-color mouse :background))))
    (dolist (param face-params)
      (let* ((param-name (nth 0 param))
  	     (value (cdr (assq param-name parameters))))
  	(if value
  	    (set-face-attribute (nth 1 param) frame
				(nth 2 param) value))))))

(defun tty-handle-reverse-video (frame parameters)
  "Handle the reverse-video frame parameter for terminal frames."
  (when (cdr (assq 'reverse parameters))
    (let* ((params (frame-parameters frame))
	   (bg (cdr (assq 'foreground-color params)))
	   (fg (cdr (assq 'background-color params))))
      (modify-frame-parameters frame
			       (list (cons 'foreground-color fg)

	  (modify-frame-parameters frame
				   (list (cons 'cursor-color fg)))))))


(defun tty-create-frame-with-faces (&optional parameters)
  "Create and return a frame from optional frame parameters PARAMETERS.
If PARAMETERS contains a `reverse' parameter, handle that."
  (let ((frame (make-terminal-frame parameters))
	success)
    (unwind-protect
	(with-selected-frame frame
	  (tty-handle-reverse-video frame (frame-parameters frame))