Fossil SCM
|
1
|
## -*- tcl -*-
|
|
2
|
# # ## ### ##### ######## ############# #####################
|
|
3
|
## Copyright (c) 2008 Mark Janssen.
|
|
4
|
#
|
|
5
|
# This software is licensed as described in the file LICENSE, which
|
|
6
|
# you should have received as part of this distribution.
|
|
7
|
#
|
|
8
|
# This software consists of voluntary contributions made by many
|
|
9
|
# individuals. For exact contribution history, see the revision
|
|
10
|
# history and logs, available at http://fossil-scm.hwaci.com/fossil
|
|
11
|
# # ## ### ##### ######## ############# #####################
|
|
12
|
|
|
13
|
## Command line user interface for tclfossil.
|
|
14
|
|
|
15
|
# # ## ### ##### ######## ############# #####################
|
|
16
|
## Requirements
|
|
17
|
|
|
18
|
package require Tcl 8.5 ; # Required runtime.
|
|
19
|
package require snit ; # OO system.
|
|
20
|
package require vc::fossil::cmd::clone 1.0 ; # Clone command
|
|
21
|
package require vc::fossil::cmd::new 1.0 ; # New command
|
|
22
|
|
|
23
|
package provide vc::fossil::ui 1.0
|
|
24
|
|
|
25
|
# # ## ### ##### ######## ############# #####################
|
|
26
|
##
|
|
27
|
|
|
28
|
namespace eval ::vc::fossil {
|
|
29
|
snit::type ui {
|
|
30
|
typevariable argv
|
|
31
|
typevariable argc
|
|
32
|
typevariable command
|
|
33
|
typevariable fSqlTrace
|
|
34
|
typevariable fUser
|
|
35
|
|
|
36
|
typemethod run {args} {
|
|
37
|
|
|
38
|
# TODO parse options
|
|
39
|
set argv $args
|
|
40
|
set argc [llength $args]
|
|
41
|
|
|
42
|
if {$argc < 2} {
|
|
43
|
ui usage "COMMAND ..."
|
|
44
|
}
|
|
45
|
|
|
46
|
# TODO better command searching so prefixes work
|
|
47
|
set command [lindex $argv 1]
|
|
48
|
set commands [vc::fossil::cmd list]
|
|
49
|
|
|
50
|
if {[lsearch $commands $command] < 0} {
|
|
51
|
puts "unknown command: $command"
|
|
52
|
puts {use "help" for more information}
|
|
53
|
exit 1
|
|
54
|
}
|
|
55
|
vc::fossil::cmd::$command {*}[lrange $argv 1 end]
|
|
56
|
return
|
|
57
|
}
|
|
58
|
|
|
59
|
typemethod usage {str} {
|
|
60
|
puts stderr "Usage: [lrange $argv 0 1] $str"
|
|
61
|
exit 1
|
|
62
|
}
|
|
63
|
|
|
64
|
typemethod panic {str} {
|
|
65
|
puts stderr "[lindex $argv 0]: $str"
|
|
66
|
exit 1
|
|
67
|
}
|
|
68
|
|
|
69
|
|
|
70
|
typemethod argc {} {
|
|
71
|
return $argc
|
|
72
|
}
|
|
73
|
|
|
74
|
typemethod argv {} {
|
|
75
|
return $argv
|
|
76
|
}
|
|
77
|
}
|
|
78
|
} |