diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:25 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:25 -0800 |
commit | db04688faa20f3576257c0fe41752ec435beab9a (patch) | |
tree | 6d638c2e1f65afd5f49d20b2d22ce35bd74705ff /build | |
parent | 1edcb9b62a1a520eddae8403c19d841c9b18737f (diff) | |
download | scm-fa3c5b99da02d5af2454b1e1cb7bf250c5efdaa2.tar.gz scm-fa3c5b99da02d5af2454b1e1cb7bf250c5efdaa2.zip |
Import Upstream version 5c3upstream/5c3
Diffstat (limited to 'build')
-rwxr-xr-x | build | 59 |
1 files changed, 59 insertions, 0 deletions
@@ -0,0 +1,59 @@ +#!/bin/sh +:;exec scmlit -f $0 -e"(bi)" build $* + +(require 'build) +(require 'getopt) +(require 'getopt-parameters) + +(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)) + (cond + ((pair? argv) + (set! *optind* (+ 1 *optind*)) + ((make-command-server build '*commands*) + command + (lambda (comname comval options positions arities types + defaulters checks aliases) + (let* ((params (getopt->parameter-list + argc argv options arities types aliases)) + (fparams (fill-empty-parameters defaulters params))) + (cond ((not (list? params)) #f) + ((not (check-parameters checks fparams)) #f) + ((not (check-arities (map arity->arity-spec arities) fparams)) + (slib:error 'build-from-argv "arity error" fparams) #f) + (else (comval fparams)))))))))) + +(define (build-from-whole-argv argv) + (set! *optind* 0) + (set! *optarg* #f) + (build-from-argv argv)) + +(define b build-from-whole-argv) + +(define (b*) + (require 'read-command) + (do ((e (read-command) (read-command))) + ((eof-object? e)) + (cond ((null? e)) + (else + (cond ((not (string-ci=? (car e) "build")) + (set! e (cons "build" e)))) + (write (build-from-whole-argv e)) + (newline))) + (display "build> ") + (force-output))) + +(define (bi) (build-from-argv *argv*)) + +(cond (*interactive* + (display "type (b \"build <command-line>\") to build") (newline) + (display "type (b*) to enter build command loop") (newline))) + +;;; Local Variables: +;;; mode:scheme +;;; End: |