From 1fabb1e83fc74328c2b470087b7d73b0385cdd11 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 13 Nov 1995 23:47:32 +0000 Subject: [PATCH] Don't override the geometry specification given in the X resource database. This can cause really unpleasant behavior. --- v7/src/edwin/debug.scm | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) 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 -- 2.25.1