From 90ba284584d9dc1f56787fd91c0fd7f9d4d5f72f Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Fri, 20 Feb 2004 15:27:29 +0000
Subject: [PATCH] Revert last check-in. Reading again through the manual, I now
 think that it's maybe better to complain if -e was specified without -sfd or
 -s.

---
 scsh/top.scm | 175 +++++++++++++++++++++++----------------------------
 1 file changed, 78 insertions(+), 97 deletions(-)

diff --git a/scsh/top.scm b/scsh/top.scm
index 42f3621..4ae6c7b 100644
--- a/scsh/top.scm
+++ b/scsh/top.scm
@@ -107,7 +107,7 @@
 (define (parse-scsh-args args)
   (let lp ((args (meta-arg-process-arglist args))
 	   (switches '())	; A list of handler thunks
-	   (top-entry #f)	; -e <entry>
+	   (top-entry #f)	; -t <entry>
 	   (need-script? #f))	; Found a -ds, -dm, or -de?
 ;    (display args    (current-output-port))
     (if (pair? args)
@@ -115,47 +115,31 @@
 	      (args (cdr args)))
 
 	  (cond ((string=? arg "-c")
-                 (cond ((not (pair? args))
-                        (bad-arg "-c switch requires argument"))
-                       (top-entry
-                        (bad-arg "-c switch used with -e switch"))
-                       (need-script?
-                        (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
-                       (else
-                        (values (reverse switches) 'c (car args)
-                                top-entry (cdr args)))))
+		 (if (or need-script? top-entry (not (pair? args)))
+		     (bad-arg)
+		     (values (reverse switches) 'c (car args)
+			     top-entry (cdr args))))
 
 		((string=? arg "-s")
-		 (cond ((not (pair? args))
-                        (bad-arg "-s switch requires argument"))
-                       (top-entry
-                        (bad-arg "-s switch used with -e switch"))
-                       (need-script?
-                        (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
-                       (else
-                        (values (reverse switches) 's (car args)
-                                top-entry (cdr args)))))
+		 (if (not (pair? args))
+		     (bad-arg "-s switch requires argument")
+		     (values (reverse switches) 's (car args)
+			     top-entry (cdr args))))
 
 		;; -sfd <num>
 		((string=? arg "-sfd")
-                 (cond ((not (pair? args))
-                        (bad-arg "-sfd switch requires argument"))
-                       (top-entry
-                        (bad-arg "-sdf switch used with -e switch"))
-                       (else
-                        (let* ((fd (string->number (car args)))
-                               (p (fdes->inport fd)))
-                          (release-port-handle p)	; Unreveal the port.
-                          (values (reverse switches) 'sfd p
-                                  top-entry (cdr args))))))
+		 (if (not (pair? args))
+		     (bad-arg "-sfd switch requires argument")
+		     (let* ((fd (string->number (car args)))
+			    (p (fdes->inport fd)))
+		       (release-port-handle p)	; Unreveal the port.
+		       (values (reverse switches) 'sfd p
+			       top-entry (cdr args)))))
 
 		((string=? arg "--")
-		 (cond (need-script?
-                        (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
-                       (top-entry
-                        (bad-arg "-- switch used with -e switch"))
-                       (else
-                        (values (reverse switches) #f #f top-entry args))))
+		 (if need-script?
+		     (bad-arg "-ds, -dm, or -de switch requires -s <script>")
+		     (values (reverse switches) #f #f top-entry args)))
 
 		((or (string=? arg "-ds")
 		     (string=? arg "-dm")
@@ -202,10 +186,8 @@
 		     (string->symbol (car args)) need-script?))
 
 	    (else (bad-arg "Unknown switch" arg))))
-        (cond (need-script?
-               (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
-              (else
-               (values (reverse switches) #f #f top-entry '()))))))
+
+	(values (reverse switches) #f #f top-entry '()))))
 
 ;;; Do each -ds, -dm, -de, -o, -n, -m, -l/lm/ll, +lp/+lpe/lp+/lpe+, or
 ;;; -lp-clear/lp-default switch, and return the final result package and a
@@ -359,69 +341,68 @@
 (define (parse-switches-and-execute all-args context)
   (receive (switches term-switch term-val top-entry args)
       (parse-scsh-args (cdr all-args))
-    (let ((interactive? (not (or term-switch top-entry))))
-      (with-handler 
-       (lambda (cond more)
-         (if (warning? cond)
-             (more)
-             (with-handler
-              (lambda (c m)
-                (scheme-exit-now 1))
-              (lambda ()
-                (call-exit-hooks-and-narrow (lambda () #t))
-                (more)))))
-       (lambda ()
-         (with-scsh-initialized
-          interactive? context args
-          (lambda ()
-            ;; Have to do these before calling DO-SWITCHES, because actions
-            ;; performed while processing the switches may use these guys.
-            (set-command-line-args!
-             (cons (if (eq? term-switch 's)
-                       term-val         ; Script file.
-                       (if (eq? term-val 'sfd)
-                           "file-descriptor-script" ; -sfd <num>
-                           (car all-args)))
-                   args))
+    (with-handler 
+     (lambda (cond more)
+       (if (warning? cond)
+	   (more)
+	   (with-handler
+	    (lambda (c m)
+	      (scheme-exit-now 1))
+	    (lambda ()
+	      (call-exit-hooks-and-narrow (lambda () #t))
+	      (more)))))
+     (lambda ()
+       (with-scsh-initialized
+	(not term-switch) context args
+	(lambda ()
+	  ;; Have to do these before calling DO-SWITCHES, because actions
+	  ;; performed while processing the switches may use these guys.
+	  (set-command-line-args!
+	   (cons (if (eq? term-switch 's)
+                     term-val	; Script file.
+                     (if (eq? term-val 'sfd)
+			 "file-descriptor-script" ; -sfd <num>
+                         (car all-args)))
+		 args))
 	 
-            (let* ((script-loaded?  (do-switches switches term-val)))
-              (if (not script-loaded?) ; There wasn't a -ds, -dm, or -de,
-                  (if (eq? term-switch 's) ; but there is a script,
-                      (load-quietly term-val ; so load it now.
-                                    (interaction-environment))
-                      (if (eq? term-switch 'sfd)
-                          (load-port-quietly term-val (interaction-environment)))))
+	  (let* ((script-loaded?  (do-switches switches term-val)))
+	    (if (not script-loaded?) ; There wasn't a -ds, -dm, or -de,
+                (if (eq? term-switch 's) ; but there is a script,
+                    (load-quietly term-val; so load it now.
+                                  (interaction-environment))
+                    (if (eq? term-switch 'sfd)
+                        (load-port-quietly term-val (interaction-environment)))))
 	   
-              (cond (interactive?
-                     (scsh-exit-now ;; TODO: ,exit will bypass this
-                      (restart-command-processor 
-                       args 
-                       context 
-                       (lambda ()
-                         (display (string-append 
-                                   "Welcome to scsh "
-                                   scsh-version-string
-                                   " (" scsh-release-name ")")
-                                  (current-output-port))
-                         (newline (current-output-port))
-                         (display "Type ,? for help."
-                                  (current-output-port))
-                         (newline (current-output-port))
-                         (in-package (user-environment) '())))))
+	    (cond ((not term-switch)	; -- interactive
+		   (scsh-exit-now       ;; TODO: ,exit will bypass this
+		    (restart-command-processor 
+		     args 
+		     context 
+		     (lambda ()
+		       (display (string-append 
+				 "Welcome to scsh "
+				 scsh-version-string
+				 " (" scsh-release-name ")")
+				(current-output-port))
+		       (newline (current-output-port))
+		       (display "Type ,? for help."
+				(current-output-port))
+		       (newline (current-output-port))
+		       (in-package (user-environment) '())))))
 
-                    ((eq? term-switch 'c)
-                     (let ((result (eval (read-exactly-one-sexp-from-string term-val)
-                                         (interaction-environment))))
-                       (scsh-exit-now 0)))
+		  ((eq? term-switch 'c)
+		   (let ((result (eval (read-exactly-one-sexp-from-string term-val)
+				       (interaction-environment))))
+		     (scsh-exit-now 0)))
 		 
-                    (top-entry		; There was a -e <entry>.
-                     ((eval top-entry (interaction-environment))
-                      (command-line))
-                     (scsh-exit-now 0))
+		  (top-entry		; There was a -e <entry>.
+		   ((eval top-entry (interaction-environment))
+		    (command-line))
+		   (scsh-exit-now 0))
 		 
-                    ;; Otherwise, the script executed as it loaded,
-                    ;; so we're done.
-                    (else (scsh-exit-now 0)))))))))))
+		  ;; Otherwise, the script executed as it loaded,
+		  ;; so we're done.
+		  (else (scsh-exit-now 0))))))))))
 
 
 (define (read-exactly-one-sexp-from-string s)