From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 13 Nov 1995 23:47:32 +0000 (+0000)
Subject: Don't override the geometry specification given in the X resource
X-Git-Tag: 20090517-FFI~5731
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1fabb1e83fc74328c2b470087b7d73b0385cdd11;p=mit-scheme.git

Don't override the geometry specification given in the X resource
database.  This can cause really unpleasant behavior.
---

diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm
index 79f8b75b6..e52d46dc3 100644
--- a/v7/src/edwin/debug.scm
+++ b/v7/src/edwin/debug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: debug.scm,v 1.33 1994/11/02 19:36:59 adams Exp $
+;;;	$Id: debug.scm,v 1.34 1995/11/13 23:47:32 cph Exp $
 ;;;
 ;;;	Copyright (c) 1992-94 Massachusetts Institute of Technology
 ;;;
@@ -1002,29 +1002,31 @@ The buffer below describes the current subproblem or reduction.
 (define (make-debug-screen-args)
   (case (display-type/name (current-display-type))
     ((X)
-     (list (or new-screen-geometry
-	       (let ((geometry
-		      (prompt-for-string "Please enter a geometry"
-					 default-screen-geometry)))
-		 (if (geometry? geometry)
-		     (begin
-		       (set! new-screen-geometry geometry)
-		       geometry)
-		     (begin
-		       (message "Invalid geometry!  Using default.")
-		       default-screen-geometry))))))
+     (cond ((string? default-screen-geometry)
+	    (list default-screen-geometry))
+	   ((eq? default-screen-geometry 'ASK)
+	    (let ((geometry
+		   (prompt-for-string "Please enter a geometry"
+				      default-screen-geometry)))
+	      (if (geometry? geometry)
+		  (begin
+		    (set! default-screen-geometry geometry)
+		    geometry)
+		  (begin
+		    (message "Invalid geometry!  Using default.")
+		    default-screen-geometry))))
+	   (else '())))
     (else '())))
 
 (define (geometry? geometry)
   (let ((geometry-pattern
 	 "[0-9]+x[0-9]+\\(-[0-9]+\\|+[0-9]+\\|\\)\\(-[0-9]+\\|+[0-9]+\\|\\)"))
-    (re-match-string-forward  (re-compile-pattern geometry-pattern false)
-			      false
-			      false
-			      geometry)))
+    (re-match-string-forward (re-compile-pattern geometry-pattern #f)
+			     #f
+			     #f
+			     geometry)))
 
-(define default-screen-geometry "80x75-0+0")
-(define new-screen-geometry default-screen-geometry)
+(define default-screen-geometry #f)
 
 (define (continuation-browser-buffer object)
   (let ((browser