source: project/sbky/sbky.scm @ 7185

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

renamed update to revert

File size: 4.9 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 revert -A | ID
35  sbky diff [ -l | -s ] [ 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 revert 
75      (match-lambda*
76        (("-A") (bky-revert #f))
77        ((id) (bky-revert id))
78        (_ (usage "revert -A | ID")) ) )
79
80    (defcmd (diff . args)
81      (let ((style #f))
82        (let loop ((args args))
83          (match args
84            (() (bky-diff #f #f style))
85            (("-l" . more)
86             (set! style 'list)
87             (loop more) )
88            (("-s" . more)
89             (set! style 'histo)
90             (loop more) )
91            (("-p" id) (bky-diff id #t style))
92            ((id1 id2) (bky-diff id1 id2 style))
93            ((id) (bky-diff id #f style))
94            (_ (usage "diff [ -l | -s ] [ ID | -p ID | ID ID ]")) ) ) ) )
95
96    (defcmd status
97      (match-lambda*
98        (() (bky-status))
99        (_ (usage "status")) ) )
100
101    (defcmd (init . args)
102      (let ((bname #f)
103            (msg #t) )
104        (let loop ((args args))
105          (match args
106            (() (bky-init bname msg))
107            (("-b" n . more)
108             (set! bname n)
109             (loop more) )
110            (("-n" . more)
111             (set! msg "")
112             (loop more) )
113            (("-m" m . more)
114             (set! msg m)
115             (loop more) )
116            (_ (usage "init [ -b NAME | -m MSG ] ..."))))))
117
118    (defcmd (commit . args)
119      (let* ((bname #f)
120             (msg #t) 
121             (files 
122              (let loop ((args args))
123                (match args
124                  (() '())
125                  (("-m" m . more)
126                   (set! msg m)
127                   (loop more) )
128                  (("-b" n . more)
129                   (set! bname n)
130                   (loop more) )
131                  (("-n" . more)
132                   (set! msg #f)
133                   (loop more))
134                  ((file . more)
135                   (cons file (loop more)) ) ) ) ) )
136        (bky-commit files msg bname) ) )
137
138    (defalias ci commit)
139    (defalias checkout update)
140
141    (defcmd tag
142      (match-lambda*
143        (() (bky-tag #f))
144        ((tag) (bky-tag tag))
145        (_ (usage "tag [ ID ]")) ) )
146
147    (defcmd branchname
148      (match-lambda*
149        (() (bky-branchname #f))
150        ((name) (bky-branchname name))
151        (_ (usage "branchname [ NAME ]"))))
152
153    (defcmd log
154      (match-lambda*
155        (() (bky-log #f))
156        (("-l" (? string->number n))
157         (bky-log (string->number n)) )
158        ((id) (bky-log id))
159        (_ (usage "log [ -l NUM | ID ]"))))
160
161    (defcmd push
162      (match-lambda*
163        (() (bky-push #f))
164        ((repo) (bky-push repo))
165        (_ (usage "push [ REPO ]"))))
166
167    (defcmd pull
168      (match-lambda*
169        (() (bky-pull #f))
170        ((repo) (bky-pull repo))
171        (_ (usage "pull [ REPO ]"))))
172
173    (defcmd incoming
174      (match-lambda*
175        (() (bky-pull #f #t))
176        ((repo) (bky-pull repo #t))
177        (_ (usage "incoming [ REPO ]"))))
178
179    (defcmd outgoing
180      (match-lambda*
181        (() (bky-push #f #t))
182        ((repo) (bky-push repo #t))
183        (_ (usage "outgoing [ REPO ]"))))
184
185    (defcmd export
186      (match-lambda*
187        ((dest) (bky-export dest))
188        (_ (usage "export DIRECTORY"))))
189
190    (defcmd patchset
191      (match-lambda*
192        (() (bky-patchset #f))
193        ((id) (bky-patchset id))
194        (_ (usage "patchset [ ID ]"))))
195
196    (defcmd (save . dest)
197      (bky-save (optional dest #f)))
198
199    (defcmd (restore src)
200      (bky-restore src)
201      (bky-revert #f) )
202
203    (let loop ((args (command-line-arguments)))
204      (when (null? args) (usage 1))
205      (let ((arg (car args))
206            (rest (cdr args)) )
207        (cond ((string=? arg "-v")
208               (run-verbose #t)
209               (loop rest) )
210              ((string=? arg "-V")
211               (print "sbky " +version+))
212              ((string=? arg "-h")
213               (help) )
214              ((string=? arg "-n")
215               (dry-run #t) 
216               (run-verbose #t)
217               (loop rest))
218              ((char=? #\- (string-ref arg 0))
219               (usage 1) )
220              ((find-command arg) =>
221               (lambda (cmd) (apply cmd rest)) )
222              (else (usage 1)) ) ) )
223
224    ) )
225
226(exit)
Note: See TracBrowser for help on using the repository browser.