From: Richard M. Stallman <rms@gnu.org>
Date: Thu, 22 Sep 1994 07:26:46 +0000 (+0000)
Subject: (x-create-frame-with-faces): Delete the frame if get error.
X-Git-Tag: emacs-19.34~6855
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e7cc6aa5c632744c94c1bccad8582ce596bb5b3e;p=emacs.git

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

diff --git a/lisp/faces.el b/lisp/faces.el
index a058292ab39..7beb5c2562f 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -816,42 +816,48 @@ selected frame."
     (let* ((visibility-spec (assq 'visibility parameters))
 	   (frame (x-create-frame (cons '(visibility . nil) parameters)))
 	   (faces (copy-alist global-face-data))
+	   success
 	   (rest faces))
-      (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)))
-	    (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 'border-color (cdr (assq 'background-color params)))))
-	    (modify-frame-parameters
-	     frame
-	     (list (cons 'cursor-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)))
-      (if (null visibility-spec)
-	  (make-frame-visible frame)
-	(modify-frame-parameters frame (list visibility-spec)))
-      frame)))
+      (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)))
+		  (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 'border-color (cdr (assq 'background-color params)))))
+		  (modify-frame-parameters
+		   frame
+		   (list (cons 'cursor-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)))
+	    (if (null visibility-spec)
+		(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.
 (defun frame-update-faces (frame)