Fossil SCM

tclfossil: initial directory structure and package split up

mjanssen 2008-02-19 18:05 UTC tclfossil-1
Commit 2b9c6df430776725bde3d45e0bdbbcb3c1f29548
Parent 60b40f293ade26b…
8 files changed -42 -19 +52 +43 +82 +19 +74 +32
- tools/tclfossil/clone.tcl - tools/tclfossil/lib/tf_db.tcl + tools/tclfossil/lib/vc/fossil/blob-1.0.tm + tools/tclfossil/lib/vc/fossil/cmd-1.0.tm + tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm + tools/tclfossil/lib/vc/fossil/db-1.0.tm + tools/tclfossil/lib/vc/fossil/ui-1.0.tm + tools/tclfossil/tf
D tools/tclfossil/clone.tcl
-42
--- a/tools/tclfossil/clone.tcl
+++ b/tools/tclfossil/clone.tcl
@@ -1,42 +0,0 @@
1
-package require http
2
-package require zlib
3
-package require sha1
4
-
5
-proc login_card {userid password message} {
6
- # calculates the login card for the specific user for this msg
7
-
8
- set nonce [sha1::sha1 -hex $message]
9
- set signature [sha1::sha1 -hex $nonce$password]
10
- return "login $userid $nonce $signature\n"
11
-}
12
-
13
-proc http_req {url user password message} {
14
- set login_card [login_card $user $password $message]
15
- set message [blob_compress "$login_card$message"]
16
- return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
17
-}
18
-
19
-
20
-proc blob_compress {data} {
21
- set n [string length $data]
22
- set data [zlib compress $data 9]
23
- set header [binary format I $n]
24
-
25
- return $header$data
26
-}
27
-
28
-proc blob_decompress {data} {
29
- binary scan $data I length
30
- return [zlib decompress [string range $data 4 end] $length ]
31
-}
32
-
33
-# send buffer starts with 4 bytes (big endian) containing the length of the blob
34
-
35
-
36
-set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
37
-http::wait $tok
38
-set body [blob_decompress [http::data $tok]]
39
-set lines [split $body \n]
40
-puts $body
41
-puts "Received:\t[string length $body] bytes,\t[llength $lines] messages"
42
-
--- a/tools/tclfossil/clone.tcl
+++ b/tools/tclfossil/clone.tcl
@@ -1,42 +0,0 @@
1 package require http
2 package require zlib
3 package require sha1
4
5 proc login_card {userid password message} {
6 # calculates the login card for the specific user for this msg
7
8 set nonce [sha1::sha1 -hex $message]
9 set signature [sha1::sha1 -hex $nonce$password]
10 return "login $userid $nonce $signature\n"
11 }
12
13 proc http_req {url user password message} {
14 set login_card [login_card $user $password $message]
15 set message [blob_compress "$login_card$message"]
16 return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
17 }
18
19
20 proc blob_compress {data} {
21 set n [string length $data]
22 set data [zlib compress $data 9]
23 set header [binary format I $n]
24
25 return $header$data
26 }
27
28 proc blob_decompress {data} {
29 binary scan $data I length
30 return [zlib decompress [string range $data 4 end] $length ]
31 }
32
33 # send buffer starts with 4 bytes (big endian) containing the length of the blob
34
35
36 set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
37 http::wait $tok
38 set body [blob_decompress [http::data $tok]]
39 set lines [split $body \n]
40 puts $body
41 puts "Received:\t[string length $body] bytes,\t[llength $lines] messages"
42
--- a/tools/tclfossil/clone.tcl
+++ b/tools/tclfossil/clone.tcl
@@ -1,42 +0,0 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
D tools/tclfossil/lib/tf_db.tcl
-19
--- a/tools/tclfossil/lib/tf_db.tcl
+++ b/tools/tclfossil/lib/tf_db.tcl
@@ -1,19 +0,0 @@
1
-package require Tcl 8.5
2
-package require sqlite3
3
-package require snit
4
-
5
-snit::type ::vc::fossil::db {
6
- variable db
7
- method open_repository {{name {}}} {
8
- sqlite3 db1 c:/src/fossil.fsl
9
- set db db1
10
- }
11
- method revlist {} {
12
- $db eval {select uuid from blob}
13
- }
14
-}
15
-
16
-vc::fossil::db create fossildb
17
-
18
-fossildb open_repository
19
-puts [fossildb revlist]
--- a/tools/tclfossil/lib/tf_db.tcl
+++ b/tools/tclfossil/lib/tf_db.tcl
@@ -1,19 +0,0 @@
1 package require Tcl 8.5
2 package require sqlite3
3 package require snit
4
5 snit::type ::vc::fossil::db {
6 variable db
7 method open_repository {{name {}}} {
8 sqlite3 db1 c:/src/fossil.fsl
9 set db db1
10 }
11 method revlist {} {
12 $db eval {select uuid from blob}
13 }
14 }
15
16 vc::fossil::db create fossildb
17
18 fossildb open_repository
19 puts [fossildb revlist]
--- a/tools/tclfossil/lib/tf_db.tcl
+++ b/tools/tclfossil/lib/tf_db.tcl
@@ -1,19 +0,0 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
A tools/tclfossil/lib/vc/fossil/blob-1.0.tm
+52
--- a/tools/tclfossil/lib/vc/fossil/blob-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/blob-1.0.tm
@@ -0,0 +1,52 @@
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
+## Commands for creating and managing fossil blobs.
14
+
15
+# # ## ### ##### ######## ############# #####################
16
+## Requirements
17
+
18
+package require Tcl 8.5 ; # Required runtime.
19
+package require sqlite3 ; # Fossil database access
20
+package require snit ; # OO system.
21
+package require zlib
22
+
23
+package provide vc::fossil::blob 1.0
24
+
25
+# # ## ### ##### ######## ############# #####################
26
+##
27
+
28
+namespace eval ::vc::fossil {
29
+ namespace export blob
30
+ snit::type blob {
31
+ option -data ""
32
+
33
+ constructor {args} {
34
+ $self configurelist $args
35
+ }
36
+
37
+ method compress {} {
38
+ set data [$self cget -data]
39
+ set n [string length $data]
40
+ set data [zlib compress $data 9]
41
+ set header [binary format I $n]
42
+ return $header$data
43
+ }
44
+
45
+ method decompress {} {
46
+ set data [$self cget -data]
47
+ binary scan $data I length
48
+ return [zlib decompress [string range $data 4 end] $length ]
49
+ }
50
+ }
51
+}
52
+
--- a/tools/tclfossil/lib/vc/fossil/blob-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/blob-1.0.tm
@@ -0,0 +1,52 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/tclfossil/lib/vc/fossil/blob-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/blob-1.0.tm
@@ -0,0 +1,52 @@
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 ## Commands for creating and managing fossil blobs.
14
15 # # ## ### ##### ######## ############# #####################
16 ## Requirements
17
18 package require Tcl 8.5 ; # Required runtime.
19 package require sqlite3 ; # Fossil database access
20 package require snit ; # OO system.
21 package require zlib
22
23 package provide vc::fossil::blob 1.0
24
25 # # ## ### ##### ######## ############# #####################
26 ##
27
28 namespace eval ::vc::fossil {
29 namespace export blob
30 snit::type blob {
31 option -data ""
32
33 constructor {args} {
34 $self configurelist $args
35 }
36
37 method compress {} {
38 set data [$self cget -data]
39 set n [string length $data]
40 set data [zlib compress $data 9]
41 set header [binary format I $n]
42 return $header$data
43 }
44
45 method decompress {} {
46 set data [$self cget -data]
47 binary scan $data I length
48 return [zlib decompress [string range $data 4 end] $length ]
49 }
50 }
51 }
52
A tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
+43
--- a/tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
@@ -0,0 +1,43 @@
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
+## Fossil subcommand managment.
14
+
15
+# # ## ### ##### ######## ############# #####################
16
+## Requirements
17
+
18
+package require Tcl 8.5 ; # Required runtime.
19
+package require sqlite3 ; # Fossil database access
20
+package require snit ; # OO system.
21
+
22
+
23
+package provide vc::fossil::cmd 1.0
24
+
25
+# # ## ### ##### ######## ############# #####################
26
+##
27
+
28
+namespace eval ::vc::fossil {
29
+ namespace export cmd
30
+ snit::type cmd {
31
+ typevariable commands ""
32
+
33
+ typemethod add {command} {
34
+ lappend commands $command
35
+
36
+ }
37
+
38
+ typemethod list {} {
39
+ return $commands
40
+ }
41
+ }
42
+}
43
+
--- a/tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
@@ -0,0 +1,43 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/cmd-1.0.tm
@@ -0,0 +1,43 @@
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 ## Fossil subcommand managment.
14
15 # # ## ### ##### ######## ############# #####################
16 ## Requirements
17
18 package require Tcl 8.5 ; # Required runtime.
19 package require sqlite3 ; # Fossil database access
20 package require snit ; # OO system.
21
22
23 package provide vc::fossil::cmd 1.0
24
25 # # ## ### ##### ######## ############# #####################
26 ##
27
28 namespace eval ::vc::fossil {
29 namespace export cmd
30 snit::type cmd {
31 typevariable commands ""
32
33 typemethod add {command} {
34 lappend commands $command
35
36 }
37
38 typemethod list {} {
39 return $commands
40 }
41 }
42 }
43
A tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
+82
--- a/tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
@@ -0,0 +1,82 @@
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
+
14
+# # ## ### ##### ######## ############# #####################
15
+## Requirements
16
+
17
+package require Tcl 8.5 ; # Required runtime.
18
+package require snit ; # OO system.
19
+package require vc::fossil::cmd 1.0 ; # Subcommand management
20
+package require vc::fossil::blob 1.0
21
+
22
+package provide vc::fossil::cmd::clone 1.0
23
+
24
+# # ## ### ##### ######## ############# #####################
25
+## Imports
26
+
27
+namespace import ::vc::fossil::blob
28
+
29
+
30
+# # ## ### ##### ######## ############# #####################
31
+##
32
+
33
+vc::fossil::cmd add clone
34
+
35
+namespace eval ::vc::fossil::cmd {
36
+ proc clone {args} {
37
+ if {[ui argc] != 4} {
38
+ ui usage "FILE-OR-URL NEW-REPOSITORY"
39
+ }
40
+
41
+ set local_file [lindex [ui argv] 3]
42
+ if {[file exists $local_file]} {
43
+ ui panic "file already exists: $local_file"
44
+ }
45
+ puts "cloning: $args"
46
+ package require http
47
+ package require sha1
48
+ package require autoproxy
49
+
50
+ autoproxy::init
51
+ puts [autoproxy::configure]
52
+
53
+ proc login_card {userid password message} {
54
+ # calculates the login card for the specific user for this msg
55
+
56
+ set nonce [sha1::sha1 -hex $message]
57
+ set signature [sha1::sha1 -hex $nonce$password]
58
+ return "login $userid $nonce $signature\n"
59
+ }
60
+
61
+ proc http_req {url user password message} {
62
+ set login_card [login_card $user $password $message]
63
+ blob blob_a -data $login_card$message
64
+ set message [blob_a compress]
65
+ blob_a destroy
66
+ return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
67
+ }
68
+
69
+
70
+ set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
71
+ http::wait $tok
72
+ set zip_body [http::data $tok]
73
+ blob blob_a -data $zip_body
74
+ set body [blob_a decompress]
75
+ blob_a destroy
76
+ set lines [split $body \n]
77
+ puts $body
78
+ puts "Received:\t[string length $body] ([string length $zip_body]) bytes,\t[llength $lines] messages"
79
+
80
+
81
+ }
82
+}
--- a/tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
@@ -0,0 +1,82 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm
@@ -0,0 +1,82 @@
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
14 # # ## ### ##### ######## ############# #####################
15 ## Requirements
16
17 package require Tcl 8.5 ; # Required runtime.
18 package require snit ; # OO system.
19 package require vc::fossil::cmd 1.0 ; # Subcommand management
20 package require vc::fossil::blob 1.0
21
22 package provide vc::fossil::cmd::clone 1.0
23
24 # # ## ### ##### ######## ############# #####################
25 ## Imports
26
27 namespace import ::vc::fossil::blob
28
29
30 # # ## ### ##### ######## ############# #####################
31 ##
32
33 vc::fossil::cmd add clone
34
35 namespace eval ::vc::fossil::cmd {
36 proc clone {args} {
37 if {[ui argc] != 4} {
38 ui usage "FILE-OR-URL NEW-REPOSITORY"
39 }
40
41 set local_file [lindex [ui argv] 3]
42 if {[file exists $local_file]} {
43 ui panic "file already exists: $local_file"
44 }
45 puts "cloning: $args"
46 package require http
47 package require sha1
48 package require autoproxy
49
50 autoproxy::init
51 puts [autoproxy::configure]
52
53 proc login_card {userid password message} {
54 # calculates the login card for the specific user for this msg
55
56 set nonce [sha1::sha1 -hex $message]
57 set signature [sha1::sha1 -hex $nonce$password]
58 return "login $userid $nonce $signature\n"
59 }
60
61 proc http_req {url user password message} {
62 set login_card [login_card $user $password $message]
63 blob blob_a -data $login_card$message
64 set message [blob_a compress]
65 blob_a destroy
66 return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
67 }
68
69
70 set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
71 http::wait $tok
72 set zip_body [http::data $tok]
73 blob blob_a -data $zip_body
74 set body [blob_a decompress]
75 blob_a destroy
76 set lines [split $body \n]
77 puts $body
78 puts "Received:\t[string length $body] ([string length $zip_body]) bytes,\t[llength $lines] messages"
79
80
81 }
82 }
A tools/tclfossil/lib/vc/fossil/db-1.0.tm
+19
--- a/tools/tclfossil/lib/vc/fossil/db-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/db-1.0.tm
@@ -0,0 +1,19 @@
1
+package require Tcl 8.5
2
+package require sqlite3
3
+package require snit
4
+
5
+snit::type ::vc::fossil::db {
6
+ variable db
7
+ method open_repository {{name {}}} {
8
+ sqlite3 db1 c:/src/fossil.fsl
9
+ set db db1
10
+ }
11
+ method revlist {} {
12
+ $db eval {select uuid from blob}
13
+ }
14
+}
15
+
16
+vc::fossil::db create fossildb
17
+
18
+fossildb open_repository
19
+puts [fossildb revlist]
--- a/tools/tclfossil/lib/vc/fossil/db-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/db-1.0.tm
@@ -0,0 +1,19 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/tclfossil/lib/vc/fossil/db-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/db-1.0.tm
@@ -0,0 +1,19 @@
1 package require Tcl 8.5
2 package require sqlite3
3 package require snit
4
5 snit::type ::vc::fossil::db {
6 variable db
7 method open_repository {{name {}}} {
8 sqlite3 db1 c:/src/fossil.fsl
9 set db db1
10 }
11 method revlist {} {
12 $db eval {select uuid from blob}
13 }
14 }
15
16 vc::fossil::db create fossildb
17
18 fossildb open_repository
19 puts [fossildb revlist]
A tools/tclfossil/lib/vc/fossil/ui-1.0.tm
+74
--- a/tools/tclfossil/lib/vc/fossil/ui-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/ui-1.0.tm
@@ -0,0 +1,74 @@
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
+
22
+package provide vc::fossil::ui 1.0
23
+
24
+# # ## ### ##### ######## ############# #####################
25
+##
26
+
27
+namespace eval ::vc::fossil {
28
+ snit::type ui {
29
+ typevariable argv
30
+ typevariable argc
31
+ typevariable command
32
+ typevariable fSqlTrace
33
+ typevariable fUser
34
+
35
+ typemethod run {args} {
36
+
37
+ # TODO parse options
38
+ set argv $args
39
+ set argc [llength $args]
40
+
41
+ if {$argc < 2} {
42
+ ui usage "COMMAND ..."
43
+ }
44
+
45
+ # TODO better command searching so prefixes work
46
+ set command [lindex $argv 1]
47
+ set commands [vc::fossil::cmd list]
48
+
49
+ if {[lsearch $commands $command] < 0} {
50
+ puts "unknown command: $command"
51
+ puts {use "help" for more information}
52
+ exit 1
53
+ }
54
+ vc::fossil::cmd::$command {*}[lrange $argv 1 end]
55
+ return
56
+ }
57
+
58
+ typemethod usage {str} {
59
+ puts stderr "Usage: [lrange $argv 0 1] $str"
60
+ exit 1
61
+ }
62
+
63
+ typemethod panic {str} {
64
+ puts stderr "[lindex $argv 0]: $str"
65
+ exit 1
66
+ }
67
+
68
+
69
+ typemethod argc {} {
70
+ return $argc
71
+ }
72
+
73
+ typemethod argv {} {
74
+
--- a/tools/tclfossil/lib/vc/fossil/ui-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/ui-1.0.tm
@@ -0,0 +1,74 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/tclfossil/lib/vc/fossil/ui-1.0.tm
+++ b/tools/tclfossil/lib/vc/fossil/ui-1.0.tm
@@ -0,0 +1,74 @@
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
22 package provide vc::fossil::ui 1.0
23
24 # # ## ### ##### ######## ############# #####################
25 ##
26
27 namespace eval ::vc::fossil {
28 snit::type ui {
29 typevariable argv
30 typevariable argc
31 typevariable command
32 typevariable fSqlTrace
33 typevariable fUser
34
35 typemethod run {args} {
36
37 # TODO parse options
38 set argv $args
39 set argc [llength $args]
40
41 if {$argc < 2} {
42 ui usage "COMMAND ..."
43 }
44
45 # TODO better command searching so prefixes work
46 set command [lindex $argv 1]
47 set commands [vc::fossil::cmd list]
48
49 if {[lsearch $commands $command] < 0} {
50 puts "unknown command: $command"
51 puts {use "help" for more information}
52 exit 1
53 }
54 vc::fossil::cmd::$command {*}[lrange $argv 1 end]
55 return
56 }
57
58 typemethod usage {str} {
59 puts stderr "Usage: [lrange $argv 0 1] $str"
60 exit 1
61 }
62
63 typemethod panic {str} {
64 puts stderr "[lindex $argv 0]: $str"
65 exit 1
66 }
67
68
69 typemethod argc {} {
70 return $argc
71 }
72
73 typemethod argv {} {
74
A tools/tclfossil/tf
+32
--- a/tools/tclfossil/tf
+++ b/tools/tclfossil/tf
@@ -0,0 +1,32 @@
1
+#!/bin/sh
2
+## -*- tcl -*- \
3
+exec tclsh "$0" ${1+"$@"}
4
+
5
+# # ## ### ##### ######## ############# #####################
6
+## Copyright (c) 2008 Mark Janssen.
7
+#
8
+# This software is licensed as described in the file LICENSE, which
9
+# you should have received as part of this distribution.
10
+#
11
+# This software consists of voluntary contributions made by many
12
+# individuals. For exact contribution history, see the revision
13
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
14
+# # ## ### ##### ######## ############# #####################
15
+
16
+## Command line application wrapped around the import packages.
17
+
18
+# # ## ### ##### ######## ############# #####################
19
+## Requirements, extended package management for local packages.
20
+
21
+::tcl::tm::path add [file normalize [file join [file dirname [info script]] lib]]
22
+
23
+package require Tcl 8.5 ; # Required runtime.
24
+package require vc::fossil::ui ; # Main functionality.
25
+
26
+# # ## ### ##### ######## ############# #####################
27
+## Execution
28
+
29
+vc::fossil::ui run $::argv0 {*}$argv
30
+exit 0
31
+
32
+# # ## ### ##### ######## ############# #####################
--- a/tools/tclfossil/tf
+++ b/tools/tclfossil/tf
@@ -0,0 +1,32 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/tclfossil/tf
+++ b/tools/tclfossil/tf
@@ -0,0 +1,32 @@
1 #!/bin/sh
2 ## -*- tcl -*- \
3 exec tclsh "$0" ${1+"$@"}
4
5 # # ## ### ##### ######## ############# #####################
6 ## Copyright (c) 2008 Mark Janssen.
7 #
8 # This software is licensed as described in the file LICENSE, which
9 # you should have received as part of this distribution.
10 #
11 # This software consists of voluntary contributions made by many
12 # individuals. For exact contribution history, see the revision
13 # history and logs, available at http://fossil-scm.hwaci.com/fossil
14 # # ## ### ##### ######## ############# #####################
15
16 ## Command line application wrapped around the import packages.
17
18 # # ## ### ##### ######## ############# #####################
19 ## Requirements, extended package management for local packages.
20
21 ::tcl::tm::path add [file normalize [file join [file dirname [info script]] lib]]
22
23 package require Tcl 8.5 ; # Required runtime.
24 package require vc::fossil::ui ; # Main functionality.
25
26 # # ## ### ##### ######## ############# #####################
27 ## Execution
28
29 vc::fossil::ui run $::argv0 {*}$argv
30 exit 0
31
32 # # ## ### ##### ######## ############# #####################

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button