diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2010-03-09 13:46:45 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2010-03-09 13:46:45 +0200 |
commit | 181a4133f334e38966b58afa5c79f2840637c98f (patch) | |
tree | 490022be00aecd6ff32edb5cfed5761a284f4659 | |
parent | 824e839071c1957344608bd031f3198dd76e551d (diff) | |
download | gamma-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-hacking | 2 | ||||
-rwxr-xr-x | scripts/bootstrap | 63 |
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 |