summaryrefslogtreecommitdiffstats
path: root/build
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commitc7d035ae1a729232579a0fe41ed5affa131d3623 (patch)
treefb387f7c2a8e01cf603d4c75fbbaa68f711df986 /build
parentdeda2c0fd8689349fea2a900199a76ff7ecb319e (diff)
downloadscm-c7d035ae1a729232579a0fe41ed5affa131d3623.tar.gz
scm-c7d035ae1a729232579a0fe41ed5affa131d3623.zip
Import Upstream version 5d9upstream/5d9
Diffstat (limited to 'build')
-rwxr-xr-xbuild64
1 files changed, 41 insertions, 23 deletions
diff --git a/build b/build
index cde6729..dd43759 100755
--- a/build
+++ b/build
@@ -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)))