Last change
on this file since 7369 was
7369,
checked in by felix winkelmann, 13 years ago
|
slight changes in branch maker
|
File size:
1.8 KB
|
Line | |
---|
1 | ;;;; make-branch.scm - Copy egg directories into release branch - felix |
---|
2 | ; |
---|
3 | ; (call without arguments for usage information) |
---|
4 | |
---|
5 | |
---|
6 | (use utils runcmd miscmacros srfi-1) |
---|
7 | |
---|
8 | |
---|
9 | (run-verbose #t) |
---|
10 | |
---|
11 | (define *repository* |
---|
12 | "https://galinha.ucpel.tche.br/svn/chicken-eggs") |
---|
13 | |
---|
14 | (define *ignore* |
---|
15 | '("maintenance" |
---|
16 | "release" |
---|
17 | "doc-indices" |
---|
18 | "wiki" |
---|
19 | "salmonella-custom-feeds" |
---|
20 | "chicken") ) |
---|
21 | |
---|
22 | (define *release* #f) |
---|
23 | (define *eggs* #f) |
---|
24 | |
---|
25 | (let loop ((args (command-line-arguments))) |
---|
26 | (match args |
---|
27 | (() #f) |
---|
28 | (("--dry-run" . more) |
---|
29 | (dry-run #t) |
---|
30 | (loop more) ) |
---|
31 | ((x . more) |
---|
32 | (cond (*release* |
---|
33 | (push! x *eggs*) |
---|
34 | (loop more) ) |
---|
35 | (else |
---|
36 | (set! *release* (make-pathname "release" x)) |
---|
37 | (loop more) ) ) ) ) ) |
---|
38 | |
---|
39 | (unless *release* |
---|
40 | (print "usage: make-branch.scm [--dry-run] RELEASE [FILENAME ...]") |
---|
41 | (exit 1)) |
---|
42 | |
---|
43 | (unless (file-exists? *release*) |
---|
44 | (error "no such release or invalid working directory" *release*)) |
---|
45 | |
---|
46 | (unless *eggs* |
---|
47 | (set! *eggs* |
---|
48 | (lset-difference |
---|
49 | string=? |
---|
50 | (filter directory? (directory ".")) |
---|
51 | *ignore*))) |
---|
52 | |
---|
53 | (unless (dry-run) |
---|
54 | (print* "\nCopying " (length *eggs*) " eggs into release branch " *release* |
---|
55 | ".\n\n Do you want to continue? ") |
---|
56 | (unless (string=? "yes" (read-line)) |
---|
57 | (print "aborted.") |
---|
58 | (exit) ) ) |
---|
59 | |
---|
60 | (for-each |
---|
61 | (lambda (egg) |
---|
62 | (cond ((file-exists? (make-pathname *release* egg)) |
---|
63 | (print egg ": branch already exists") ) |
---|
64 | (else |
---|
65 | (when (and (not (null? (directory egg))) |
---|
66 | (or (file-exists? (make-pathname egg "trunk")) |
---|
67 | (file-exists? (make-pathname egg egg "setup")) |
---|
68 | (begin |
---|
69 | (print* "\n`" egg "' doesn't seem to be an egg. Copy? ") |
---|
70 | (string=? "yes" (read-line)))) ) |
---|
71 | (run (svn cp ,(make-pathname *repository* egg) |
---|
72 | ,(make-pathname (list *repository* *release*) egg) ) ) ) ) ) ) |
---|
73 | (reverse *eggs*)) |
---|
Note: See
TracBrowser
for help on using the repository browser.