diff options
Diffstat (limited to 'build')
| -rwxr-xr-x | build | 64 |
1 files changed, 41 insertions, 23 deletions
@@ -1,24 +1,29 @@ #! /bin/sh -:;exec scmlit -f $0 -e"(bi)" build $* +:;exec ./scmlit -no-init-file -f $0 -e"(bi)" build $* -(require (in-vicinity (program-vicinity) "build.scm")) (require 'getopt) (require 'getopt-parameters) +(require-if 'compiling 'posix) +(require-if 'compiling 'fluid-let) +(require-if 'compiling 'read-command) +(require-if 'compiling 'common-list-functions) +(load (in-vicinity (program-vicinity) "build.scm")) +;@ (define (make-features-txi) (call-with-output-file "features.txi" (lambda (port) - ((((build 'open-table) 'features #f) 'for-each-row) + (((open-table build 'features) 'for-each-row-in-order) (lambda (row) (apply (lambda (name spec documentation) (display "@item " port) (display name port) (newline port) (display "@cindex " port) (display name port) (newline port) (display documentation port) (newline port) (newline port)) row)))))) - +;@ (define (print-manifest port) (display "@multitable @columnfractions .22 .78" port) (newline port) - ((((build 'open-table) 'manifest #f) 'for-each-row) + (((open-table build 'manifest) 'for-each-row-in-order) (lambda (row) (apply (lambda (file format category documentation) (display (string-append "@item @code{" file) port) @@ -34,7 +39,7 @@ ((negative? n) (close-port cat)) (newline cat))) (system (string-append "info -f " path " -n '" node "' -o - >> " afile))) - +;@ (define (make-readme) (require 'posix) (let ((pipe (open-output-pipe "makeinfo --no-headers -o README")) @@ -49,7 +54,7 @@ Revised^5 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. SCM runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Unix and similar systems. -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} @section Manifest " @@ -66,22 +71,29 @@ NOS/VE, Unicos, VMS, Unix and similar systems. (append-info-node scm-info "Testing" "README"))) (define build:csv (make-command-server build '*commands*)) -(define (build-from-argv argv) - (cond ((string? argv) - (require 'read-command) - (set! argv (call-with-input-string argv read-command)))) - (let () - (define command (string->symbol (list-ref argv *optind*))) - (define argc (length argv)) +(define (build-from-argv) + (define command (string->symbol (list-ref *argv* *optind*))) + (define getopt- getopt--) + (require 'fluid-let) + (fluid-let ((getopt-- + (lambda (optstring) + (let* ((opt (getopt- (string-append optstring "f:-:")))) + (cond ((eqv? #\f opt) + (let () + (require 'read-command) + (require 'common-list-functions) + (set! *argv* (append (butnthcdr *optind* *argv*) + (read-options-file *optarg*) + (nthcdr *optind* *argv*)))))) + opt)))) (cond - ((pair? argv) + ((pair? *argv*) (set! *optind* (+ 1 *optind*)) (build:csv command (lambda (comname comval options positions arities types defaulters checks aliases) - (let* ((params (getopt->parameter-list - argc argv options arities types aliases)) + (let* ((params (getopt->parameter-list options arities types aliases)) (fparams (and params (fill-empty-parameters defaulters params)))) (cond ((not (list? params)) ;;(slib:warn 'build-from-argv 'not-parameters? fparams) @@ -90,16 +102,24 @@ NOS/VE, Unicos, VMS, Unix and similar systems. (slib:warn 'build-from-argv 'check-parameters 'failed) #f) ((not (check-arities (map arity->arity-spec arities) fparams)) - (slib:error 'build-from-argv "arity error" fparams) #f) + (slib:error 'build-from-argv 'bad 'arity fparams) #f) (else (comval fparams)))))))))) - +;@ (define (build-from-whole-argv argv) + (if (string? argv) + (let () + (require 'read-command) + (set! argv (call-with-input-string argv read-command)))) (set! *optind* 0) (set! *optarg* #f) - (build-from-argv argv)) + (set! *argv* argv) + (build-from-argv)) +;;;@ Used when invoked as script +(define (bi) (exit (and (build-from-argv) #t))) +;@ (define b build-from-whole-argv) - +;@ (define (b*) (require 'read-command) (do ((e (read-command) (read-command))) @@ -113,8 +133,6 @@ NOS/VE, Unicos, VMS, Unix and similar systems. (display "build> ") (force-output))) -(define (bi) (if (build-from-argv *argv*) #t (exit #f))) - (cond (*interactive* (display "type (b \"build <command-line>\") to build") (newline) (display "type (b*) to enter build command loop") (newline))) |