From ed128e5d73e71569ce0698bced6bdc7bd4449e5c Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Thu, 3 Nov 1994 04:41:31 +0000
Subject: [PATCH] Fixed edwin.ldr.  Some files were loaded twice.

Changed the selection of a default display type.

If a display type is requested but is not available then an error is
generated (the code used not to check).

There is no longer a preference for the display type 'CONSOLE, so the
list of defined types is always searched.  The initialization sequence
in edwin.ldr is tterm before (xterm or win32), which puts the
graphical display types ahead of the console in the display types
list, and this places them at a higher desirability.

Doing this revealed that the win32 availablility predicate was
implemented incorrectly.
---
 v7/src/edwin/display.scm |  8 +++-----
 v7/src/edwin/editor.scm  | 17 ++++++++++-------
 v7/src/edwin/win32.scm   |  9 ++++++---
 3 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/v7/src/edwin/display.scm b/v7/src/edwin/display.scm
index 9dd696177..34c92a903 100644
--- a/v7/src/edwin/display.scm
+++ b/v7/src/edwin/display.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/display.scm,v 1.5 1992/04/22 21:03:33 mhwu Exp $
+;;;	$Id: display.scm,v 1.6 1994/11/03 04:38:53 adams Exp $
 ;;;
-;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1989-1994 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -107,11 +107,9 @@
 (define (editor-display-types)
   (list-transform-positive display-types display-type/available?))
 
-(define (name->display-type name fail?)
+(define (name->display-type name)
   (let ((display-type
 	 (list-search-positive display-types
 	   (lambda (display-type)
 	     (eq? name (display-type/name display-type))))))
-    (if (and (not display-type) fail?)
-	(error "Unknown display-type name" name))
     display-type))
\ No newline at end of file
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 06c2e77eb..dfc2aea25 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: editor.scm,v 1.235 1994/03/08 20:24:33 cph Exp $
+;;;	$Id: editor.scm,v 1.236 1994/11/03 04:40:33 adams Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology
 ;;;
@@ -146,8 +146,13 @@
 		       (let ((name (and (not (null? args))
                                         (car args))))
 			 (if name
-                             (name->display-type name true)
-			     (default-display-type '(CONSOLE))))
+			     (let ((display-type (name->display-type name)))
+			       (if display-type
+				   (if (display-type/available? display-type)
+				       display-type
+				       (error "Requested display type not available:" display-type))
+				   (error "Unknown display type name:" name)))
+			     (default-display-type '() )))
 		       (if (null? args)
 			   '()
 			   (cdr args))))
@@ -160,7 +165,7 @@
 
 (define (default-display-type preferences)
   (define (fail)
-    (error "can't find usable display type"))
+    (error "Can't find any usable display type"))
 
   (define (find-any)
     (let ((types (editor-display-types)))
@@ -171,9 +176,7 @@
   (define (find-preferred display-type-names)
     (if (null? display-type-names)
 	(find-any)
-	(let ((next (name->display-type 
-		     (car display-type-names)
-		     false)))
+	(let ((next (name->display-type (car display-type-names))))
 	  (if (and next 
 		   (display-type/available? next))
 	      next
diff --git a/v7/src/edwin/win32.scm b/v7/src/edwin/win32.scm
index 90da26601..95cc92bce 100644
--- a/v7/src/edwin/win32.scm
+++ b/v7/src/edwin/win32.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: win32.scm,v 1.2 1994/11/02 19:16:53 adams Exp $
+;;;	$Id: win32.scm,v 1.3 1994/11/03 04:41:31 adams Exp $
 ;;;
 ;;;	Copyright (c) 1994 Massachusetts Institute of Technology
 ;;;
@@ -282,11 +282,14 @@
 
 (define win32-display-type)
 
+(define (win32-screen-available?)
+  (implemented-primitive-procedure? win32-screen-create!))
+
 (define (initialize-package!)
   (set! win32-display-type 
 	(make-display-type 'win32
-			   true
-			   true
+			   true        ; multiple screens?
+			   win32-screen-available?
 			   (lambda geometry
 			     geometry
 			     (make-win32-screen))
-- 
2.25.1