From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 18 Aug 2000 20:23:03 +0000 (+0000)
Subject: Add loaders for SOS and IMAIL.
X-Git-Tag: 20090517-FFI~3295
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9e8eb8613d4e0c62372595717fa431b9e5ed2547;p=mit-scheme.git

Add loaders for SOS and IMAIL.
---

diff --git a/v7/dist/optiondb.scm b/v7/dist/optiondb.scm
index cc17d75ad..e431865f5 100644
--- a/v7/dist/optiondb.scm
+++ b/v7/dist/optiondb.scm
@@ -1,3 +1,30 @@
 ;; -*- Scheme -*-
 
+(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 '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