Add optional argument to LOAD-OPTION; this is a flag that says to not
authorChris Hanson <org/chris-hanson/cph>
Sat, 8 Oct 1994 08:56:09 +0000 (08:56 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 8 Oct 1994 08:56:09 +0000 (08:56 +0000)
signal an error if the option is unknown.

v7/src/runtime/option.scm

index 93f5fd9e5c6de3b8604bd43b17a8644795e81444..2789332fdb09419ca2ff7d5e4c057a7089dc89ab 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: option.scm,v 14.30 1994/10/03 17:30:36 adams Exp $
+$Id: option.scm,v 14.31 1994/10/08 08:56:09 cph Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -37,7 +37,7 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-(define *initial-options-file*  #F)
+(define *initial-options-file* #F)
 
 (define (initial-load-options)
   (or *initial-options-file*
@@ -61,41 +61,40 @@ MIT in each case. |#
   (set! *parent* place)
   unspecific)
 
-(define (load-option name)
+(define (load-option name #!optional no-error?)
+  (let ((no-error? (and (not (default-object? no-error?)) no-error?)))
 
-  (define (load-entry entry)
-    (for-each (lambda (thunk) (thunk)) (cdr entry))
-    (set! loaded-options (cons name loaded-options))
-    unspecific)
+    (define (find-option)
+      (cond ((assq name *options*) => load-entry)
+           ((force* *parent*)     => search-parent)
+           (else (error "Unknown option name:" name))))
 
-  (define (search-parent file)
-    (fluid-let ((*options* '())
-               (*parent*  #F))
-      (fluid-let ((load/suppress-loading-message? #T))
-       (load-latest (merge-pathnames file (library-directory-pathname ""))
-                    (make-load-environment)
-                    system-global-syntax-table
-                    #F))
-      (find-option)))
+    (define (load-entry entry)
+      (for-each (lambda (thunk) (thunk)) (cdr entry))
+      (set! loaded-options (cons name loaded-options))
+      unspecific)
 
-  (define (make-load-environment)
-    (eval '(LET () (THE-ENVIRONMENT))  system-global-environment))
+    (define (search-parent file)
+      (fluid-let ((*options* '())
+                 (*parent*  #F))
+       (fluid-let ((load/suppress-loading-message? #T))
+         (load-latest (merge-pathnames file (library-directory-pathname ""))
+                      (make-load-environment)
+                      system-global-syntax-table
+                      #F))
+       (find-option)))
 
-  (define (find-option)
-    (cond ((assq name *options*) => load-entry)
-         ((force* *parent*)     => search-parent)
-         (else
-          (error "Unknown option name:" name))))
+    (define (make-load-environment)
+      (eval '(LET () (THE-ENVIRONMENT)) system-global-environment))
 
-  (if (not (memq name loaded-options))
-      (find-option))
-  name)
+    (if (not (memq name loaded-options))
+       (find-option))
+    name))
 
 (define loaded-options  '())
 (define *options* '())                 ; Current options.
 (define *parent*  initial-load-options)        ; A thunk or a pathname/string or #F.
-
-
+\f
 (define (library-file? library-internal-path)
   (let* ((library    (library-directory-pathname ""))
         (pathname   (merge-pathnames library-internal-path library)))
@@ -158,4 +157,4 @@ MIT in each case. |#
           (fluid-let ((load/suppress-loading-message? true))
             (load (merge-pathnames
                    (library-directory-pathname "shared")
-                   shared-library))))))))
+                   shared-library))))))))
\ No newline at end of file