source: project/sbky/sbky.scm @ 7273

Last change on this file since 7273 was 7273, checked in by felix winkelmann, 13 years ago

updates

File size: 4.7 KB
Line 
1;;;; sbky.scm - driver for bky lib -*- Scheme -*-
2
3(let ((cmdtable '()))
4
5  (let-syntax
6      ((defcmd
7         (syntax-rules ()
8           ((_ (name . llist) body ...)
9            (set! cmdtable 
10              (alist-cons 
11               (symbol->string 'name) (lambda llist body ...)
12               cmdtable) ) )
13           ((_ name val)
14            (set! cmdtable 
15              (alist-cons 
16               (symbol->string 'name) val
17               cmdtable) ) ) ) ) 
18       (defalias 
19         (syntax-rules ()
20           ((_ new old)
21            (set! cmdtable
22              (alist-cons 
23               (symbol->string 'new)
24               (cdr (assoc (symbol->string 'old) cmdtable))
25               cmdtable) ) ) ) ) )
26
27    (define (help)
28      (print
29       "usage: sbky [ -v | -h | -n ] COMMAND ARGUMENT ...
30
31  sbky help
32  sbky init [ -b NAME | -m MSG ] ...
33  sbky commit [ -b NAME | -m MSG | -n | FILE1 ... ]
34  sbky checkout -A | ID
35  sbky diff [ ID | -p ID | ID ID ]
36  sbky status
37  sbky log [ -l NUM | ID ]
38  sbky tag [ TAG ]
39  sbky branchname [ NAME ]
40  sbky pull [ REPO ]
41  sbky push [ REPO ]
42  sbky incoming [ REPO ]
43  sbky outgoing [ REPO ]
44  sbky export DIRECTORY
45  sbky patchset [ ID ]
46  sbky save [ DESTINATION ]
47  sbky restore SOURCE
48") )
49
50    (define (usage code)
51      (cond ((string? code)
52             (print "usage: sbky " code)
53             (exit 1) )
54            (else
55             (print "usage: sbky [ -v | -V | -h | -n ] COMMAND ARGUMENT ...")
56             (exit code) ) ) )
57
58    (define (find-command cmd)
59      (let ((found
60             (filter
61              (lambda (x)
62                (let ((c (car x)))
63                  (string=?
64                   (substring c 0 (min (string-length c) (string-length cmd)))
65                   cmd) ) )
66              cmdtable) ) )
67        (case (length found)
68          ((1) (cdar found))
69          (else (usage 1)))))
70
71    (defcmd (help)
72      (help) )
73
74    (defcmd checkout
75      (match-lambda*
76        (("-A") (bky-checkout #f))
77        ((id) (bky-checkout id))
78        (_ (usage "checkout -A | ID")) ) )
79
80    (defcmd (diff . args)
81      (match args
82        (() (bky-diff #f #f))
83        (("-p" id) (bky-diff id #t))
84        ((id1 id2) (bky-diff id1 id2))
85        ((id) (bky-diff id #f))
86        (_ (usage "diff [ ID | -p ID | ID ID ]")) ) )
87
88    (defcmd status
89      (match-lambda*
90        (() (bky-status))
91        (_ (usage "status")) ) )
92
93    (defcmd (init . args)
94      (let ((bname #f)
95            (msg #t) )
96        (let loop ((args args))
97          (match args
98            (() (bky-init bname msg))
99            (("-b" n . more)
100             (set! bname n)
101             (loop more) )
102            (("-n" . more)
103             (set! msg "")
104             (loop more) )
105            (("-m" m . more)
106             (set! msg m)
107             (loop more) )
108            (_ (usage "init [ -b NAME | -m MSG ] ..."))))))
109
110    (defcmd (commit . args)
111      (let* ((bname #f)
112             (msg #t) 
113             (files 
114              (let loop ((args args))
115                (match args
116                  (() '())
117                  (("-m" m . more)
118                   (set! msg m)
119                   (loop more) )
120                  (("-b" n . more)
121                   (set! bname n)
122                   (loop more) )
123                  (("-n" . more)
124                   (set! msg #f)
125                   (loop more))
126                  ((file . more)
127                   (cons file (loop more)) ) ) ) ) )
128        (bky-commit files msg bname) ) )
129
130    (defalias ci commit)
131
132    (defcmd tag
133      (match-lambda*
134        (() (bky-tag #f))
135        ((tag) (bky-tag tag))
136        (_ (usage "tag [ ID ]")) ) )
137
138    (defcmd branchname
139      (match-lambda*
140        (() (bky-branchname #f))
141        ((name) (bky-branchname name))
142        (_ (usage "branchname [ NAME ]"))))
143
144    (defcmd log
145      (match-lambda*
146        (() (bky-log #f))
147        (("-l" (? string->number n))
148         (bky-log (string->number n)) )
149        ((id) (bky-log id))
150        (_ (usage "log [ -l NUM | ID ]"))))
151
152    (defcmd push
153      (match-lambda*
154        (() (bky-push #f))
155        ((repo) (bky-push repo))
156        (_ (usage "push [ REPO ]"))))
157
158    (defcmd pull
159      (match-lambda*
160        (() (bky-pull #f))
161        ((repo) (bky-pull repo))
162        (_ (usage "pull [ REPO ]"))))
163
164    (defcmd incoming
165      (match-lambda*
166        (() (bky-pull #f #t))
167        ((repo) (bky-pull repo #t))
168        (_ (usage "incoming [ REPO ]"))))
169
170    (defcmd outgoing
171      (match-lambda*
172        (() (bky-push #f #t))
173        ((repo) (bky-push repo #t))
174        (_ (usage "outgoing [ REPO ]"))))
175
176    (defcmd export
177      (match-lambda*
178        ((dest) (bky-export dest))
179        (_ (usage "export DIRECTORY"))))
180
181    (defcmd patchset
182      (match-lambda*
183        (() (bky-patchset #f))
184        ((id) (bky-patchset id))
185        (_ (usage "patchset [ ID ]"))))
186
187    (defcmd (save . dest)
188      (bky-save (optional dest #f)))
189
190    (defcmd (restore src)
191      (bky-restore src)
192      (bky-revert #f) )
193
194    (let loop ((args (command-line-arguments)))
195      (when (null? args) (usage 1))
196      (let ((arg (car args))
197            (rest (cdr args)) )
198        (cond ((string=? arg "-v")
199               (run-verbose #t)
200               (loop rest) )
201              ((string=? arg "-V")
202               (print "sbky " +version+))
203              ((string=? arg "-h")
204               (help) )
205              ((string=? arg "-n")
206               (dry-run #t) 
207               (run-verbose #t)
208               (loop rest))
209              ((char=? #\- (string-ref arg 0))
210               (usage 1) )
211              ((find-command arg) =>
212               (lambda (cmd) (apply cmd rest)) )
213              (else (usage 1)) ) ) )
214
215    ) )
216
217(exit)
Note: See TracBrowser for help on using the repository browser.