;;; Meta-arg argv processor in Scheme.
;;; Copyright (c) 1995 by Olin Shivers.
;;;
;;; This is a Scheme analog of the proc2.c meta-arg expander.

;;; Syntax of the line 2 argument line:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Arguments are white-space separated. The only special character is \,
;;; the knock-down character. \nnn, for three octal digits n, reads as the
;;; char whose ASCII code is nnn. \n is newline. \ followed by anything else
;;; is just that character -- including \, space, tab, and newline. It is an
;;; error if \ is followed by just 1 or 2 octal digits: \3Q doesn't mean
;;; "3Q" -- it's an error. A backslash-encoded char is always an argument
;;; constituent unless it is the nul char (\000).
;;; 
;;; The argument line is terminated by newline or end-of-file.
;;; 
;;; Nul bytes & empty strings -- completeness at all costs:
;;; Not that it is very useful, but how does one get empty arguments ("")
;;; with this syntax? Well, ASCII nuls are taken to terminate arguments
;;; -- this is a fairly deeply-embedded property of UNIX. Each nul
;;; encountered on the argument line immediately terminates the current
;;; argument. So, three nuls surrounded by whitespace produces 3 empty
;;; arguments in series. This nul termination happens after \nnn processing,
;;; so you can use a line like
;;;     #!/bin/interpreter \
;;;     foo \000bar \000\000baz\000 quux
;;; to generate the arg list ("foo" "" "bar" "" "" "baz" "quux").
;;; The rule is: a run of whitespace terminates an argument,
;;; but *each* individual nul terminates an argument.
;;; 
;;; \ followed by a nul is an error (it's not possible to knock-down nul
;;; in UNIX).

;;; (meta-arg-process-arglist args)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Expand out meta-args in argument lists.
;;;
;;; ARGS is an argument list -- a list of strings. If the first two elements
;;; are of the form ("\\" <filename> ...), then parse secondary arguments
;;; from line two of file <filename>, change the argument list to
;;;     (,@<secondary-args> <filename> ...)
;;; and loop.

(define (meta-arg-process-arglist args)
  (let lp ((args args))
    (if (and (pair? args)
	     (string=? (car args) "\\"))
	(lp (append (read-files-secondary-args (cadr args))
		    (cdr args)))
	args)))

;;; (read-files-secondary-args fname)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Open file FNAME, skip the first line, and read secondary args off of
;;; line two. Return these as a list of strings.

(define read-files-secondary-args
  (let ((non-newline (char-set-invert (char-set #\newline))))
    (lambda (fname)
      (call-with-input-file fname
	(lambda (port)
	  (skip-char-set non-newline port)	; Skip the first
	  (read-char port)			; line of text.
	  (read-secondary-args port))))))


;;; Read in a line of secondary args from PORT.

(define (read-secondary-args port)
  (let lp ((args '()))
    (skip-char-set char-set:meta-arg-separators port)
    (let ((c (peek-char port)))
      (if (or (eof-object? c) (char=? c #\newline))
	  (reverse args)
	  (lp (cons (read-secondary-arg port) args))))))


;;; Read in one secondary arg.

(define (read-secondary-arg port)
  (let lp ((chars '()))
    (let ((c (peek-char port)))
      (cond ((or (eof-object? c)
		 (char-set-contains? char-set:whitespace c))
	     (apply string (reverse chars)))		; Leave C in stream.

	    ((char=? c ascii/nul)
	     (read-char port)				; Consume C.
	     (apply string (reverse chars)))

	    ((char=? c #\\)
	     (read-char port)
	     (let ((c (read-backslash-sequence port)))
	       (if (char=? c ascii/nul)
		   (apply string (reverse chars))
		   (lp (cons c chars)))))

	    (else (lp (cons (read-char port) chars)))))))

(define (read-backslash-sequence port)
  (let ((c1 (read-char port))
	(eof-lose (lambda () (error "Premature EOF within backslash-sequence in meta-arg"))))
    (cond ((eof-object? c1) (eof-lose))

	  ((char=? c1 #\n) #\newline)

	  ((char=? c1 ascii/nul)
	   (error "Cannot backslash nul byte in meta-arg"))

	  ((char-set-contains? char-set:octal-digits c1)
	   (let ((c2 (read-char port)))
	     (if (eof-object? c2) (eof-lose)
		 (let ((c3 (read-char port)))
		   (if (eof-object? c3) (eof-lose)
		       (ascii->char (+ (octet->int c3)
				       (* 8 (+ (octet->int c2)
					       (* 8 (octet->int c1)))))))))))
		   

	  (else c1))))

(define (octet->int c) (- (char->ascii c) (char->ascii #\0)))

(define ascii/nul (ascii->char 0))

(define char-set:octal-digits (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))

(define char-set:meta-arg-separators (string->char-set " \t"))