Import Upstream version 2c0upstream/2c0

1 files changed, 48 insertions, 41 deletions

diff --git a/comparse.scm b/comparse.scm
index add47c8..9066e36 100644
--- a/comparse.scm
+++ b/comparse.scm
@@ -1,5 +1,5 @@
 ;;; "comparse.scm" Break command line into arguments.
-;Copyright (C) 1995 Aubrey Jaffer
+;Copyright (C) 1995, 1997 Aubrey Jaffer
 ;
 ;Permission to copy this software, to redistribute it, and to use it
 ;for any purpose is granted, subject to the following restrictions and
@@ -20,73 +20,80 @@
 ;;;; This is a simple command-line reader.  It could be made fancier
 ;;; to handle lots of `shell' syntaxes.
 
+;;; Albert L. Ting points out that a similar process can be used for
+;;; reading files of options -- therefore READ-OPTIONS-FILE.
+
 (require 'string-port)
-(define (read-command . port)
+(define (read-command-from-port port nl-term?)
   (define argv '())
   (define obj "")
   (define chars '())
-  (define eof #f)
   (define readc (lambda () (read-char port)))
   (define peekc (lambda () (peek-char port)))
   (define s-expression
     (lambda ()
       (splice-arg (call-with-output-string
 		   (lambda (p) (display (slib:eval (read port)) p))))))
-  (define (backslash goto)
-    (readc)
-    (cond ((char=? #\newline (peekc)) (readc) (goto (peekc)))
-	  (else (set! chars (cons (readc) chars))
-		(build-token (peekc)))))
+  (define backslash
+    (lambda (goto)
+      (readc)
+      (let ((c (readc)))
+	(cond ((eqv? #\newline c) (goto (peekc)))
+	      ((and (char-whitespace? c) (eqv? #\newline (peekc))
+		    (eqv? 13 (char->integer c)))
+	       (readc) (goto (peekc)))
+	      (else (set! chars (cons c chars)) (build-token (peekc)))))))
   (define loop
     (lambda (c)
       (case c
 	((#\\) (backslash loop))
 	((#\") (splice-arg (read port)))
 	((#\( #\') (s-expression))
-	((#\#)
-	 (do ((c (readc) (readc)))
-	     ((or (eof-object? c) (char=? #\newline c) c))))
-	((#\; #\newline) (readc))
-	(else
-	 (cond ((eof-object? c) c)
-	       ((char-whitespace? c) (readc) (loop (peekc)))
-	       (else (build-token c)))))))
+	((#\#) (do ((c (readc) (readc)))
+		   ((or (eof-object? c) (eqv? #\newline c))
+		    (if nl-term? c (loop (peekc))))))
+	((#\;) (readc))
+	((#\newline) (readc) (and (not nl-term?) (loop (peekc))))
+	(else (cond ((eof-object? c) c)
+		    ((char-whitespace? c) (readc) (loop (peekc)))
+		    (else (build-token c)))))))
   (define splice-arg
     (lambda (arg)
       (set! obj (string-append obj (list->string (reverse chars)) arg))
       (set! chars '())
       (build-token (peekc))))
+  (define buildit
+    (lambda ()
+      (readc)
+      (set! argv (cons (string-append obj (list->string (reverse chars)))
+		       argv))))
   (define build-token
     (lambda (c)
       (case c
 	((#\") (splice-arg (read port)))
 	((#\() (s-expression))
 	((#\\) (backslash build-token))
-	((#\newline #\;)
-	 (readc)
-	 (set! argv (cons (string-append
-			   obj (list->string (reverse chars)))
-			  argv)))
-	(else
-	 (cond ((or (eof-object? c)
-		    (char-whitespace? c))
-		(readc)
-		(set! argv (cons (string-append
-				  obj (list->string (reverse chars)))
-				 argv))
-		(set! obj "")
-		(set! chars '())
-		(loop (peekc)))
-	       (else (set! chars (cons (readc) chars))
-		     (build-token (peekc))))))))
-  (set! port
-	(cond ((null? port) (current-input-port))
-	      ((= 1 (length port)) (car port))
-	      (else
-	       (slib:error
-		'read-command-line
-		"Wrong Number of ARGs:"
-		port))))
+	((#\;) (buildit))
+	(else (cond ((or (eof-object? c) (char-whitespace? c))
+		     (buildit)
+		     (cond ((not (and nl-term? (eqv? c #\newline)))
+			    (set! obj "")
+			    (set! chars '())
+			    (loop (peekc)))))
+		    (else (set! chars (cons (readc) chars))
+			  (build-token (peekc))))))))
   (let ((c (loop (peekc))))
     (cond ((and (null? argv) (eof-object? c)) c)
 	  (else (reverse argv)))))
+
+(define (read-command . port)
+  (read-command-from-port (cond ((null? port) (current-input-port))
+				((= 1 (length port)) (car port))
+				(else
+				 (slib:error 'read-command
+					     "Wrong Number of ARGs:" port)))
+			  #t))
+
+(define (read-options-file filename)
+  (call-with-input-file filename
+    (lambda (port) (read-command-from-port port #f))))