Mercurial > emacs

changeset 8999:c3a04b8a2786

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(x-create-frame-with-faces): Delete the frame if get error.
author Richard M. Stallman <rms@gnu.org>
date Thu, 22 Sep 1994 07:26:46 +0000
parents 25406f41c336
children 49f21ecbda41
files lisp/faces.el
diffstat 1 files changed, 39 insertions(+), 33 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/faces.el	Thu Sep 22 07:22:46 1994 +0000
+++ b/lisp/faces.el	Thu Sep 22 07:26:46 1994 +0000
@@ -816,42 +816,48 @@
     (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)
+      (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)))))))
+	    (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)))
+	    ;; 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)