From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 16 Oct 2000 18:00:55 +0000 (+0000)
Subject: Moved from dist directory.
X-Git-Tag: 20090517-FFI~3267
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=90e6e14bd2a449155a03de4a52ffec522415bb67;p=mit-scheme.git

Moved from dist directory.
---

diff --git a/v7/src/etc/optiondb.scm b/v7/src/etc/optiondb.scm
new file mode 100644
index 000000000..727740a6d
--- /dev/null
+++ b/v7/src/etc/optiondb.scm
@@ -0,0 +1,52 @@
+#| -*-Scheme-*-
+
+$Id: optiondb.scm,v 1.1 2000/10/16 18:00:55 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+(define (guarded-system-loader package-name place #!optional filename)
+  (let ((directory
+	 (merge-pathnames place
+			  (directory-pathname (current-load-pathname)))))
+    (lambda ()
+      (if (not (name->package package-name))
+	  (with-working-directory-pathname directory
+	    (lambda ()
+	      (load
+	       (let ((test
+		      (lambda (name)
+			(or (file-exists? name)
+			    (there-exists? load/default-types
+			      (lambda (type)
+				(file-exists?
+				 (pathname-new-type name (car type)))))))))
+		 (cond ((not (default-object? filename)) filename)
+		       ((test "make") "make")
+		       ((test "load") "load")
+		       (else (error "Can't find loader.")))))))))))
+
+(define-load-option 'CREF
+  (guarded-system-loader '(cross-reference) "cref"))
+
+(define-load-option 'SOS
+  (guarded-system-loader '(runtime object-system) "sos"))
+
+(define-load-option 'IMAIL
+  (guarded-system-loader '(edwin imail) "imail"))
+
+(further-load-options standard-load-options)
\ No newline at end of file