aboutsummaryrefslogtreecommitdiff
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
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.
-rw-r--r--README-hacking2
-rwxr-xr-xscripts/bootstrap63
2 files changed, 60 insertions, 5 deletions
diff --git a/README-hacking b/README-hacking
index 47fc61a..c8a633f 100644
--- a/README-hacking
+++ b/README-hacking
@@ -33,3 +33,3 @@ You do this as follows:
- scripts/bootstrap --moddir modules
+ scripts/bootstrap --moddir modules --parents
diff --git a/scripts/bootstrap b/scripts/bootstrap
index be7cef0..23fe96c 100755
--- a/scripts/bootstrap
+++ b/scripts/bootstrap
@@ -41,3 +41,4 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(define files-from #f)
-
+(define create-parents #f)
+
(define grammar
@@ -51,2 +52,3 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(files-from (single-char #\T) (value #t))
+ (parents (single-char #\p (value #t)))
(help)))
@@ -64,3 +66,4 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(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"))
@@ -77,2 +80,52 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
+(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]*$"))
@@ -276,3 +329,3 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
progname modconfig-file)
- (with-output-to-file
+ (with-output-to-file-p
modconfig-file
@@ -331,3 +384,3 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
progname makefile)
- (with-output-to-file
+ (with-output-to-file-p
makefile
@@ -451,2 +504,4 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
(set! files-from (cdr x)))
+ ((parents)
+ (set! create-parents (cdr x)))
(else

Return to:

Send suggestions and report system problems to the System administrator.