Commit e7cc6aa5 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(x-create-frame-with-faces): Delete the frame if get error.

parent 8be055fd
...@@ -816,42 +816,48 @@ selected frame." ...@@ -816,42 +816,48 @@ selected frame."
(let* ((visibility-spec (assq 'visibility parameters)) (let* ((visibility-spec (assq 'visibility parameters))
(frame (x-create-frame (cons '(visibility . nil) parameters))) (frame (x-create-frame (cons '(visibility . nil) parameters)))
(faces (copy-alist global-face-data)) (faces (copy-alist global-face-data))
success
(rest faces)) (rest faces))
(set-frame-face-alist frame faces) (unwind-protect
(progn
(if (cdr (or (assq 'reverse parameters) (set-frame-face-alist frame faces)
(assq 'reverse default-frame-alist)
(let ((resource (x-get-resource "reverseVideo" (if (cdr (or (assq 'reverse parameters)
"ReverseVideo"))) (assq 'reverse default-frame-alist)
(if resource (let ((resource (x-get-resource "reverseVideo"
(cons nil (member (downcase resource) "ReverseVideo")))
'("on" "true"))))))) (if resource
(let ((params (frame-parameters frame))) (cons nil (member (downcase resource)
(modify-frame-parameters '("on" "true")))))))
frame (let ((params (frame-parameters frame)))
(list (cons 'foreground-color (cdr (assq 'background-color params))) (modify-frame-parameters
(cons 'background-color (cdr (assq 'foreground-color params))) frame
(cons 'mouse-color (cdr (assq 'background-color params))) (list (cons 'foreground-color (cdr (assq 'background-color params)))
(cons 'border-color (cdr (assq 'background-color params))))) (cons 'background-color (cdr (assq 'foreground-color params)))
(modify-frame-parameters (cons 'mouse-color (cdr (assq 'background-color params)))
frame (cons 'border-color (cdr (assq 'background-color params)))))
(list (cons 'cursor-color (cdr (assq 'background-color params))))))) (modify-frame-parameters
frame
;; Copy the vectors that represent the faces. (list (cons 'cursor-color (cdr (assq 'background-color params)))))))
;; Also fill them in from X resources.
(while rest ;; Copy the vectors that represent the faces.
(let ((global (cdr (car rest)))) ;; Also fill them in from X resources.
(setcdr (car rest) (vector 'face (while rest
(face-name (cdr (car rest))) (let ((global (cdr (car rest))))
(face-id (cdr (car rest))) (setcdr (car rest) (vector 'face
nil nil nil nil nil)) (face-name (cdr (car rest)))
(face-fill-in (car (car rest)) global frame)) (face-id (cdr (car rest)))
(make-face-x-resource-internal (cdr (car rest)) frame t) nil nil nil nil nil))
(setq rest (cdr rest))) (face-fill-in (car (car rest)) global frame))
(if (null visibility-spec) (make-face-x-resource-internal (cdr (car rest)) frame t)
(make-frame-visible frame) (setq rest (cdr rest)))
(modify-frame-parameters frame (list visibility-spec))) (if (null visibility-spec)
frame))) (make-frame-visible frame)
(modify-frame-parameters frame (list visibility-spec)))
(setq success t)
frame)
(or success
(delete-frame frame))))))
;; Update a frame's faces when we change its default font. ;; Update a frame's faces when we change its default font.
(defun frame-update-faces (frame) (defun frame-update-faces (frame)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment