- (if (null global-face-data)
- (x-create-frame parameters)
- (let* ((frame (x-create-frame parameters))
- (faces (copy-alist global-face-data))
- (rest faces))
- (set-frame-face-alist frame faces)
-
- (if (cdr (or (assq 'reverse parameters)
- (assq 'reverse default-frame-alist)
- (cons nil
- (member (x-get-resource "reverseVideo" "ReverseVideo")
- '("on" "true")))))
- (let ((params (frame-parameters frame)))
- (modify-frame-parameters
- frame
- (list (cons 'foreground-color (cdr (assq 'background-color params)))
- (cons 'background-color (cdr (assq 'foreground-color params)))
- (cons 'mouse-color (cdr (assq 'background-color params)))
- (cons 'cursor-color (cdr (assq 'background-color params)))
- (cons 'border-color (cdr (assq 'background-color params)))))))
-
- ;; Copy the vectors that represent the faces.
- ;; Also fill them in from X resources.
- (while rest
- (let ((global (cdr (car rest))))
- (setcdr (car rest) (vector 'face
- (face-name (cdr (car rest)))
- (face-id (cdr (car rest)))
- nil nil nil nil nil))
- (face-fill-in (car (car rest)) global frame))
- (make-face-x-resource-internal (cdr (car rest)) frame t)
- (setq rest (cdr rest)))
- frame)))
+ ;; Read this frame's geometry resource, if it has an explicit name,
+ ;; and put the specs into PARAMETERS.
+ (let* ((name (or (cdr (assq 'name parameters))
+ (cdr (assq 'name default-frame-alist))))
+ (x-resource-name name)
+ (res-geometry (if name (x-get-resource "geometry" "Geometry")))
+ parsed)
+ (if res-geometry
+ (progn
+ (setq parsed (x-parse-geometry res-geometry))
+ ;; If the resource specifies a position,
+ ;; call the position and size "user-specified".
+ (if (or (assq 'top parsed) (assq 'left parsed))
+ (setq parsed (cons '(user-position . t)
+ (cons '(user-size . t) parsed))))
+ ;; Put the geometry parameters at the end.
+ ;; Copy default-frame-alist so that they go after it.
+ (setq parameters (append parameters
+ default-frame-alist
+ parsed)))))
+ (let (frame)
+ (if (null global-face-data)
+ (setq frame (x-create-frame parameters))
+ (let* ((visibility-spec (assq 'visibility parameters))
+ (faces (copy-alist global-face-data))
+ success
+ (rest faces))
+ (setq frame (x-create-frame (cons '(visibility . nil) parameters)))
+ (unwind-protect
+ (progn
+ (set-frame-face-alist frame faces)
+
+ (if (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")))))))
+ (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)
+ (cons 'background-color bg)))
+ (if (equal bg (cdr (assq 'border-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'border-color fg))))
+ (if (equal bg (cdr (assq 'mouse-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'mouse-color fg))))
+ (if (equal bg (cdr (assq 'cursor-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'cursor-color fg))))))
+ ;; Copy the vectors that represent the faces.
+ ;; Also fill them in from X resources.
+ (while rest
+ (let ((global (cdr (car rest))))
+ (setcdr (car rest) (vector 'face
+ (face-name (cdr (car rest)))
+ (face-id (cdr (car rest)))
+ nil nil nil nil nil))
+ (face-fill-in (car (car rest)) global frame))
+ (make-face-x-resource-internal (cdr (car rest)) frame t)
+ (setq rest (cdr rest)))
+ (if (null visibility-spec)
+ (make-frame-visible frame)
+ (modify-frame-parameters frame (list visibility-spec)))
+ (setq success t))
+ (or success
+ (delete-frame frame)))))
+ ;; Set up the background-mode frame parameter
+ ;; so that programs can decide good ways of highlighting
+ ;; on this frame.
+ (let ((bg-resource (x-get-resource ".backgroundMode"
+ "BackgroundMode"))
+ (params (frame-parameters frame))
+ (bg-mode))
+ (setq bg-mode
+ (cond (bg-resource (intern (downcase bg-resource)))
+ ((< (apply '+ (x-color-values
+ (cdr (assq 'background-color params))
+ frame))
+ (/ (apply '+ (x-color-values "white" frame)) 3))
+ 'dark)
+ (t 'light)))
+ (modify-frame-parameters frame
+ (list (cons 'background-mode bg-mode)
+ (cons 'display-type
+ (cond ((x-display-color-p frame)
+ 'color)
+ ((x-display-grayscale-p frame)
+ 'grayscale)
+ (t 'mono))))))
+ frame))
+
+;; Update a frame's faces when we change its default font.
+(defun frame-update-faces (frame)
+ (let* ((faces global-face-data)
+ (rest faces))
+ (while rest
+ (let* ((face (car (car rest)))
+ (font (face-font face t)))
+ (if (listp font)
+ (let ((bold (memq 'bold font))
+ (italic (memq 'italic font)))
+ ;; Ignore any previous (string-valued) font, it might not even
+ ;; be the right size anymore.
+ (set-face-font face nil frame)
+ (cond ((and bold italic)
+ (make-face-bold-italic face frame t))
+ (bold
+ (make-face-bold face frame t))
+ (italic
+ (make-face-italic face frame t)))))
+ (setq rest (cdr rest)))
+ frame)))
+
+;; Update the colors of FACE, after FRAME's own colors have been changed.
+;; This applies only to faces with global color specifications
+;; that are not simple constants.
+(defun frame-update-face-colors (frame)
+ (let ((faces global-face-data))
+ (while faces
+ (condition-case nil
+ (let* ((data (cdr (car faces)))
+ (face (car (car faces)))
+ (foreground (face-foreground data))
+ (background (face-background data)))
+ ;; If the global spec is a specific color,
+ ;; which doesn't depend on the frame's attributes,
+ ;; we don't need to recalculate it now.
+ (or (listp foreground)
+ (setq foreground nil))
+ (or (listp background)
+ (setq background nil))
+ ;; If we are going to frob this face at all,
+ ;; reinitialize it first.
+ (if (or foreground background)
+ (progn (set-face-foreground face nil frame)
+ (set-face-background face nil frame)))
+ (if foreground
+ (face-try-color-list 'set-face-foreground
+ face foreground frame))
+ (if background
+ (face-try-color-list 'set-face-background
+ face background frame)))
+ (error nil))
+ (setq faces (cdr faces)))))