diff options
| author | Jim Pick <jim@jimpick.com> | 1998-03-08 23:05:22 -0800 | 
|---|---|---|
| committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 | 
| commit | b21cac3362022718634f7086964208b2eed8e897 (patch) | |
| tree | 16f4b2e70645c0e8e2202023170b5a94baa967e3 /comparse.scm | |
| parent | 3796d2595035e192ed4bf1c9a6bfdb13c3c9d261 (diff) | |
| parent | f24b9140d6f74804d5599ec225717d38ca443813 (diff) | |
| download | slib-b21cac3362022718634f7086964208b2eed8e897.tar.gz slib-b21cac3362022718634f7086964208b2eed8e897.zip  | |
Import Debian changes 2c0-3debian/2c0-3
slib (2c0-3) unstable; urgency=low
  * New maintainer.
  * slibconfig script to automatically configure guile.
  * Fix type in description, closes: Bug#18996
slib (2c0-2) unstable; urgency=low
  * Minor fix for debian/rules targets
slib (2c0-1) unstable; urgency=low
  * New upstream source
  * New maintainer
Diffstat (limited to 'comparse.scm')
| -rw-r--r-- | comparse.scm | 89 | 
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))))  | 
