aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2010-03-09 13:46:45 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2010-03-09 13:46:45 +0200
commit181a4133f334e38966b58afa5c79f2840637c98f (patch)
tree490022be00aecd6ff32edb5cfed5761a284f4659 /scripts
parent824e839071c1957344608bd031f3198dd76e551d (diff)
downloadgamma-181a4133f334e38966b58afa5c79f2840637c98f.tar.gz
gamma-181a4133f334e38966b58afa5c79f2840637c98f.tar.bz2
Improve bootstrapping.
* README-hacking: Update. * scripts/bootstrap: New command line option -p (--parents). (mkdir-p, with-output-to-file-p): New functions. (write-modconfig, write-makefile): Use with-output-to-file-p.
Diffstat (limited to 'scripts')
-rwxr-xr-xscripts/bootstrap63
1 files changed, 59 insertions, 4 deletions
diff --git a/scripts/bootstrap b/scripts/bootstrap
index be7cef0..23fe96c 100755
--- a/scripts/bootstrap
+++ b/scripts/bootstrap
@@ -39,7 +39,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
"DO NOT EDIT! GENERATED AUTOMATICALLY!"))
(define reconfig-command "autoreconf -f -i -s")
(define files-from #f)
-
+(define create-parents #f)
+
(define grammar
`((topdir (single-char #\C) (value #t))
(moddir (value #t))
@@ -49,6 +50,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(modconfig-defun (value #t))
(reconfigure (value #t))
(files-from (single-char #\T) (value #t))
+ (parents (single-char #\p (value #t)))
(help)))
(define (usage)
@@ -62,7 +64,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(format #t " --modconfig-file FILE module configuration file [~A]~%" modconfig-file)
(format #t " --modconfig-defun FUNC name of the module configuration defun [~A]~%" modconfig-defun)
(format #t " --reconfigure CMD reconfigure command [~A]~%" reconfig-command)
- (display " -T, --files-from FILE read files from FILE\n"))
+ (display " -T, --files-from FILE read files from FILE\n")
+ (display " -p, --parents create parent directories as needed\n"))
(define progname #f)
@@ -75,6 +78,56 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(apply format (cons #t (cons fmt args)))
(newline))))
+(define (mkdir-p dir . rest)
+ (let ((mode (if (null? rest) #o777 (car rest)))
+ (path #f))
+ (for-each
+ (lambda (subdir)
+ (let ((full-name
+ (if path
+ (string-append path (if (string-suffix? "/" path)
+ "" "/")
+ subdir)
+ subdir)))
+ (if (not (file-exists? full-name))
+ (catch 'system-error
+ (lambda ()
+ (mkdir full-name mode))
+ (lambda args
+ (format #t "ARGS: ~A~%" args)
+ (apply throw (append (list-head args 2)
+ (list
+ (string-append
+ "~A: "
+ (list-ref args 2)))
+ (list
+ (cons
+ full-name
+ (list-ref args 3)))
+ (list-tail args 4))))))
+ (set! path full-name)))
+ (string-split dir #\/))))
+
+(define (with-output-to-file-p file thunk)
+ (if create-parents
+ (mkdir-p (dirname file)))
+ (catch 'system-error
+ (lambda ()
+ (with-output-to-file file thunk))
+ (lambda args
+ (let ((errno (car (list-ref args 4))))
+ (cond
+ ((and (not create-parents) (= errno 2))
+ (with-output-to-port
+ (current-error-port)
+ (lambda ()
+ (apply format (append (list #t (list-ref args 2))
+ (list-ref args 3)))
+ (format #t ": try using --parents~%")
+ (exit 1))))
+ (else
+ (apply throw args)))))))
+
(define section-header-rx (make-regexp "^(.*):[ \t]*$"))
(define (read-module-file file)
@@ -274,7 +327,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(define (write-modconfig modules)
(format #t "~A: writing module configuration file ~A~%"
progname modconfig-file)
- (with-output-to-file
+ (with-output-to-file-p
modconfig-file
(lambda ()
(write-autogenerated-header "# " #f)
@@ -329,7 +382,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(define (write-makefile modules)
(format #t "~A: writing makefile ~A~%"
progname makefile)
- (with-output-to-file
+ (with-output-to-file-p
makefile
(lambda ()
(write-autogenerated-header "# " #f)
@@ -449,6 +502,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(set! reconfig-command (cdr x)))
((files-from)
(set! files-from (cdr x)))
+ ((parents)
+ (set! create-parents (cdr x)))
(else
(error "unhandled option: ~A" x))))
(getopt-long args grammar))

Return to:

Send suggestions and report system problems to the System administrator.