From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 8 Mar 2005 20:43:09 +0000 (+0000)
Subject: Treat MITSCHEME_LOAD_OPTIONS as specifying a potential options file
X-Git-Tag: 20090517-FFI~1369
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=724aca28107587cd3e44b563017245635bb64d01;p=mit-scheme.git

Treat MITSCHEME_LOAD_OPTIONS as specifying a potential options file
rather than a required one.
---

diff --git a/v7/src/runtime/option.scm b/v7/src/runtime/option.scm
index 121421195..53a4fe57b 100644
--- a/v7/src/runtime/option.scm
+++ b/v7/src/runtime/option.scm
@@ -1,8 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: option.scm,v 14.43 2003/02/14 18:28:33 cph Exp $
+$Id: option.scm,v 14.44 2005/03/08 20:43:09 cph Exp $
 
-Copyright (c) 1988-2002 Massachusetts Institute of Technology
+Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
+Copyright 1994,1995,1997,1998,2001,2002 Massachusetts Institute of Technology
+Copyright 2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -74,7 +76,9 @@ USA.
 
 (define (initial-load-options)
   (or *initial-options-file*
-      (get-environment-variable "MITSCHEME_LOAD_OPTIONS")
+      (confirm-pathname
+       (merge-pathnames (get-environment-variable "MITSCHEME_LOAD_OPTIONS")
+			(user-homedir-pathname)))
       (local-load-options)))
 
 (define (local-load-options)
@@ -87,16 +91,16 @@ USA.
       "optiondb"))
 
 (define (library-file? library-internal-path)
-  (let* ((library (library-directory-pathname ""))
-	 (pathname (merge-pathnames library-internal-path library)))
-    (let loop ((file-types load/default-types))
-      (and (not (null? file-types))
-	   (let ((full-pathname
-		  (pathname-new-type pathname (caar file-types))))
-	     (if (file-exists? full-pathname)
-		 ;; not full-pathname to allow load-latest
-		 pathname		
-		 (loop (cdr file-types))))))))
+  (confirm-pathname
+   (merge-pathnames library-internal-path (library-directory-pathname ""))))
+
+(define (confirm-pathname pathname)
+  (let loop ((file-types load/default-types))
+    (and (pair? file-types)
+	 (let ((full-pathname (pathname-new-type pathname (caar file-types))))
+	   (if (file-exists? full-pathname)
+	       pathname			; not FULL-PATHNAME
+	       (loop (cdr file-types)))))))
 
 (define loaded-options '())
 (define *options* '())			; Current options.