146 lines
5.3 KiB
Scheme
146 lines
5.3 KiB
Scheme
;;; 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:
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; - The only special chars are space, tab, newline, and \.
|
|
;;; - Every space char terminates an argument.
|
|
;;; Multiple spaces therefore introduce empty-string arguments.
|
|
;;; - A newline terminates the argument list, and will also terminate a
|
|
;;; non-empty argument (but a newline following a space does not introduce
|
|
;;; a final "" argument; it only terminates the argument list).
|
|
;;; - Tab is not allowed.
|
|
;;; This is to prevent you from being screwed by thinking you had several
|
|
;;; spaces where you really had a tab, and vice-versa.
|
|
;;; - The only other special character is \, the knock-down character.
|
|
;;; \ escapes \, space, tab, and newline, turning off their special
|
|
;;; functions. The ANSI C escapes sequences, such as \n and \t are
|
|
;;; supported; these also produce argument-constituents -- \n doesn't act
|
|
;;; like a terminating newline. \nnn for *exactly* three octal digits reads
|
|
;;; as the char whose ASCII code is nnn. It is an error if \ is followed by
|
|
;;; just 1 or 2 octal digits: \3Q is an error. Octal-escapes are always
|
|
;;; constituent chars. \ followed by other chars is not allowed (so we can
|
|
;;; extend the escape-code space later if we like).
|
|
;;;
|
|
;;; You have to construct these line-2 arg lines carefully. For example,
|
|
;;; beware of trailing spaces at the end of the line. They'll give you
|
|
;;; extra trailing empty-string args.
|
|
|
|
;;; (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
|
|
|
|
; WARNING JMG HACK
|
|
|
|
; (read-char port) ; JMG this should kill the newline
|
|
; but since skip-char-set is corrupt
|
|
; (it eats the last char)
|
|
; I omit the read-char to hack around
|
|
|
|
(read-secondary-args port))))))
|
|
|
|
|
|
;;; Read in a line of secondary args from PORT.
|
|
|
|
(define (read-secondary-args port)
|
|
(let lp ((args '()))
|
|
(let* ((args (cons (read-secondary-arg port) args))
|
|
(c (read-char port)))
|
|
(if (or (eof-object? c) (char=? c #\newline))
|
|
(reverse args)
|
|
(lp args)))))
|
|
|
|
;;; Read in one secondary arg, but not its delimiting space or newline.
|
|
|
|
(define (read-secondary-arg port)
|
|
(let lp ((chars '()))
|
|
(let ((c (peek-char port)))
|
|
(cond ((or (eof-object? c)
|
|
(char=? c #\newline)
|
|
(char=? c #\space))
|
|
(apply string (reverse chars)))
|
|
|
|
((char=? c tab)
|
|
(error "Illegal tab character in meta-arg argument line."))
|
|
|
|
(else (lp (cons ((cond ((char=? c #\\)
|
|
(read-char port)
|
|
read-backslash-sequence)
|
|
(else 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 argument line")))
|
|
(octet->int (lambda (c)
|
|
(cond ((eof-object? c) (eof-lose))
|
|
((char-set-contains? char-set:octal-digits c)
|
|
(- (char->ascii c) (char->ascii #\0)))
|
|
(else (error "Non-octal-digit in \\nnn escape sequence in meta-arg argument line." c))))))
|
|
|
|
(cond ((eof-object? c1) (eof-lose))
|
|
|
|
;; This would be better handled by a char-map abstraction.
|
|
((char=? c1 #\n) #\newline)
|
|
((char=? c1 #\r) carriage-return)
|
|
((char=? c1 #\t) tab)
|
|
((char=? c1 #\b) backspace)
|
|
((char=? c1 #\a) alert)
|
|
((char=? c1 #\f) form-feed)
|
|
((char=? c1 #\v) vertical-tab)
|
|
|
|
;; \, space, tab, newline.
|
|
((char-set-contains? char-set:simple-knockdown c1) c1)
|
|
|
|
((char-set-contains? char-set:octal-digits c1)
|
|
(let* ((o64 (octet->int c1))
|
|
(o8 (octet->int (read-char port)))
|
|
(o1 (octet->int (read-char port))))
|
|
(ascii->char (+ o1 (* 8 (+ o8 (* 8 o64)))))))
|
|
|
|
|
|
(else (error "Illegal \\ escape sequence in meta-arg argument line."
|
|
c1)))))
|
|
|
|
(define char-set:octal-digits (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
|
|
|
|
(define char-set:simple-knockdown (string->char-set "\\ \n\t"))
|
|
|
|
;;; Yechh.
|
|
(define tab (ascii->char 9))
|
|
(define carriage-return (ascii->char 13))
|
|
(define backspace (ascii->char 8))
|
|
(define alert (ascii->char 7))
|
|
(define form-feed (ascii->char 12))
|
|
(define vertical-tab (ascii->char 11))
|