Add the following command-line options to Scheme. They are processed

before the init file (typically called ".scheme.init") is loaded:

  Option Keyword	Effect
  --------------	------

  -eval			EVALuate the expressions following the keyword
			in the USER-INITIAL-ENVIRONMENT, up to (but
			not including) the next option that starts
			with a hyphen.

  -load			LOAD the files following the keyword, up to
			(but not including) the next option that
			starts with a hyphen.

  -no-init-file		Do not load the init file.  Name chosen to be
			consistent with Emacs.

diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm
index 9f8f63dc402991f59c2f9f7fa772ab4f5b8dda11..ff23db38998d2f57f4aa12a2cd3c9b9e87d6a803 100644 (file)
--- a/v7/src/runtime/load.scm
+++ b/v7/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.22 1991/05/03 17:54:29 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.23 1991/08/20 22:01:33 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -39,6 +39,7 @@ MIT in each case. |#
 \f
 (define (initialize-package!)
   (set! hook/process-command-line default/process-command-line)
+  (set! load-init-file? true)
   (set! load-noisily? false)
   (set! load/loading? false)
   (set! load/suppress-loading-message? false)
@@ -47,9 +48,11 @@ MIT in each case. |#
   (set! fasload/default-types '("com" "bin"))
   (add-event-receiver! event:after-restart
                       (lambda ()
-                        (load-init-file)
-                        (process-command-line))))
+                        (process-command-line)
+                        (if load-init-file?
+                            (load-init-file)))))
 
+(define load-init-file?)
 (define load-noisily?)
 (define load/loading?)
 (define load/suppress-loading-message?)
@@ -306,5 +309,47 @@ MIT in each case. |#
 (define hook/process-command-line)
 
 (define (default/process-command-line unused-command-line)
-  (if (positive? (vector-length unused-command-line))
-      (warn "unused command-line arguments" unused-command-line)))
\ No newline at end of file
+  (letrec ((unused-command-line-length (vector-length unused-command-line))
+          (unused-for-each
+           (lambda (proc start end)
+             (if (< start end)
+                 (begin (proc (vector-ref unused-command-line start))
+                        (unused-for-each proc (1+ start) end)))))
+          (find-first-dash
+           (lambda (index)
+             (let loop ((index index))
+               (if (= index unused-command-line-length)
+                   unused-command-line-length
+                   (let ((first (vector-ref unused-command-line index)))
+                     (cond ((zero? (string-length first))
+                            (loop (1+ index)))
+                           ((char=? (string-ref first 0) #\-)
+                            index)
+                           (else (loop (1+ index))))))))))
+    (let process-next-option ((index 0)
+                             (unhandled-options '()))
+      (if (= index unused-command-line-length)
+         (if (not (null? unhandled-options))
+             (warn "Unhandled command line options:"
+                   (reverse unhandled-options)))
+         (let ((option (string-downcase (vector-ref unused-command-line index))))
+           (cond ((string=? "-no-init-file" option)
+                  (set! load-init-file? false)
+                  (process-next-option (1+ index) unhandled-options))
+                 ((string=? "-eval" option)
+                  (let ((next-option (find-first-dash (1+ index))))
+                    (unused-for-each
+                     (lambda (string)
+                       (eval (with-input-from-string string read)
+                             user-initial-environment))
+                     (1+ index)
+                     next-option)
+                    (process-next-option next-option unhandled-options)))
+                 ((string=? "-load" option)
+                  (let ((next-option (find-first-dash (1+ index))))
+                    (unused-for-each load (1+ index) next-option)
+                    (process-next-option next-option unhandled-options)))
+                 (else (process-next-option
+                        (1+ index)
+                        (cons (vector-ref unused-command-line index)
+                              unhandled-options)))))))))
\ No newline at end of file

diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm
index acbbc6f7facf9e8bd0653434566d872a0b7c2306..059050707c0b367df6e6e45394b2e1c1f8e2afc1 100644 (file)
--- a/v8/src/runtime/load.scm
+++ b/v8/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.22 1991/05/03 17:54:29 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.23 1991/08/20 22:01:33 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -39,6 +39,7 @@ MIT in each case. |#
 \f
 (define (initialize-package!)
   (set! hook/process-command-line default/process-command-line)
+  (set! load-init-file? true)
   (set! load-noisily? false)
   (set! load/loading? false)
   (set! load/suppress-loading-message? false)
@@ -47,9 +48,11 @@ MIT in each case. |#
   (set! fasload/default-types '("com" "bin"))
   (add-event-receiver! event:after-restart
                       (lambda ()
-                        (load-init-file)
-                        (process-command-line))))
+                        (process-command-line)
+                        (if load-init-file?
+                            (load-init-file)))))
 
+(define load-init-file?)
 (define load-noisily?)
 (define load/loading?)
 (define load/suppress-loading-message?)
@@ -306,5 +309,47 @@ MIT in each case. |#
 (define hook/process-command-line)
 
 (define (default/process-command-line unused-command-line)
-  (if (positive? (vector-length unused-command-line))
-      (warn "unused command-line arguments" unused-command-line)))
\ No newline at end of file
+  (letrec ((unused-command-line-length (vector-length unused-command-line))
+          (unused-for-each
+           (lambda (proc start end)
+             (if (< start end)
+                 (begin (proc (vector-ref unused-command-line start))
+                        (unused-for-each proc (1+ start) end)))))
+          (find-first-dash
+           (lambda (index)
+             (let loop ((index index))
+               (if (= index unused-command-line-length)
+                   unused-command-line-length
+                   (let ((first (vector-ref unused-command-line index)))
+                     (cond ((zero? (string-length first))
+                            (loop (1+ index)))
+                           ((char=? (string-ref first 0) #\-)
+                            index)
+                           (else (loop (1+ index))))))))))
+    (let process-next-option ((index 0)
+                             (unhandled-options '()))
+      (if (= index unused-command-line-length)
+         (if (not (null? unhandled-options))
+             (warn "Unhandled command line options:"
+                   (reverse unhandled-options)))
+         (let ((option (string-downcase (vector-ref unused-command-line index))))
+           (cond ((string=? "-no-init-file" option)
+                  (set! load-init-file? false)
+                  (process-next-option (1+ index) unhandled-options))
+                 ((string=? "-eval" option)
+                  (let ((next-option (find-first-dash (1+ index))))
+                    (unused-for-each
+                     (lambda (string)
+                       (eval (with-input-from-string string read)
+                             user-initial-environment))
+                     (1+ index)
+                     next-option)
+                    (process-next-option next-option unhandled-options)))
+                 ((string=? "-load" option)
+                  (let ((next-option (find-first-dash (1+ index))))
+                    (unused-for-each load (1+ index) next-option)
+                    (process-next-option next-option unhandled-options)))
+                 (else (process-next-option
+                        (1+ index)
+                        (cons (vector-ref unused-command-line index)
+                              unhandled-options)))))))))
\ No newline at end of file