1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
###
# A toplevel project that is a collection of other projects
###
::clay::define ::practcl::project {
superclass ::practcl::module
method _MorphPatterns {} {
return {{@name@} {::practcl::@name@} {::practcl::project.@name@} {::practcl::project}}
}
constructor args {
my variable define
if {[llength $args] == 1} {
set rawcontents [lindex $args 0]
} else {
set rawcontents $args
}
if {[catch {uplevel 1 [list subst $rawcontents]} contents]} {
set contents $rawcontents
}
###
# The first instance of ::practcl::project (or its descendents)
# registers itself as the ::practcl::MAIN. If a project other
# than ::practcl::LOCAL is created, odds are that was the one
# the developer intended to be the main project
###
if {$::practcl::MAIN eq "::practcl::LOCAL"} {
set ::practcl::MAIN [self]
}
# DEFS fields need to be passed unchanged and unsubstituted
# as we need to preserve their escape characters
foreach field {TCL_DEFS DEFS TK_DEFS} {
if {[dict exists $rawcontents $field]} {
dict set contents $field [dict get $rawcontents $field]
}
}
my graft module [self]
array set define $contents
::practcl::toolset select [self]
my initialize
}
method add_object object {
my link object $object
}
method add_project {pkg info {oodefine {}}} {
::practcl::debug [self] add_project $pkg $info
set os [my define get TEACUP_OS]
if {$os eq {}} {
set os [::practcl::os]
my define set os $os
}
set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]]
if {[dict exists $info os] && ($os ni [dict get $info os])} return
# Select which tag to use here.
# For production builds: tag-release
set profile [my define get profile release]:
if {[dict exists $info profile $profile]} {
dict set info tag [dict get $info profile $profile]
}
dict set info USEMSVC [my define get USEMSVC 0]
dict set info debug [my define get debug 0]
set obj [namespace current]::PROJECT.$pkg
if {[info command $obj] eq {}} {
set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0 class subproject.binary] $info]]
}
my link object $obj
oo::objdefine $obj $oodefine
$obj define set masterpath $::CWD
$obj go
return $obj
}
method add_tool {pkg info {oodefine {}}} {
::practcl::debug [self] add_tool $pkg $info
set info [dict merge [::practcl::local_os] $info]
set os [dict get $info TEACUP_OS]
set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]]
if {[dict exists $info os] && ($os ni [dict get $info os])} return
# Select which tag to use here.
# For production builds: tag-release
set profile [my define get profile release]:
if {[dict exists $info profile $profile]} {
dict set info tag [dict get $info profile $profile]
}
set obj ::practcl::OBJECT::TOOL.$pkg
if {[info command $obj] eq {}} {
set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]]
}
my link add tool $obj
oo::objdefine $obj $oodefine
$obj define set masterpath $::CWD
$obj go
return $obj
}
###
# Compile the Tcl core. If the define [emph tk] is true, compile the
# Tk core as well
###
method build-tclcore {} {
set os [my define get TEACUP_OS]
set tcl_config_opts [::practcl::platform::tcl_core_options $os]
set tk_config_opts [::practcl::platform::tk_core_options $os]
lappend tcl_config_opts --prefix [my define get prefix] --exec-prefix [my define get prefix]
set tclobj [my tclcore]
if {[my define get debug 0]} {
$tclobj define set debug 1
lappend tcl_config_opts --enable-symbols=true
}
$tclobj define set config_opts $tcl_config_opts
$tclobj go
$tclobj compile
set _TclSrcDir [$tclobj define get localsrcdir]
my define set tclsrcdir $_TclSrcDir
if {[my define get tk 0]} {
set tkobj [my tkcore]
lappend tk_config_opts --with-tcl=[::practcl::file_relative [$tkobj define get builddir] [$tclobj define get builddir]]
if {[my define get debug 0]} {
$tkobj define set debug 1
lappend tk_config_opts --enable-symbols=true
}
$tkobj define set config_opts $tk_config_opts
$tkobj compile
}
}
method child which {
switch $which {
delegate -
organs {
# A library can be a project, it can be a module. Any
# subordinate modules will indicate their existance
return [list project [self] module [self]]
}
}
}
method linktype {} {
return project
}
# Exercise the methods of a sub-object
method project {pkg args} {
set obj [namespace current]::PROJECT.$pkg
if {[llength $args]==0} {
return $obj
}
${obj} {*}$args
}
method tclcore {} {
if {[info commands [set obj [my clay delegate tclcore]]] ne {}} {
return $obj
}
if {[info commands [set obj [my project TCLCORE]]] ne {}} {
my graft tclcore $obj
return $obj
}
if {[info commands [set obj [my project tcl]]] ne {}} {
my graft tclcore $obj
return $obj
}
if {[info commands [set obj [my tool tcl]]] ne {}} {
my graft tclcore $obj
return $obj
}
# Provide a fallback
set obj [my add_tool tcl {
tag release class subproject.core
fossil_url http://core.tcl.tk/tcl
}]
my graft tclcore $obj
return $obj
}
method tkcore {} {
if {[set obj [my clay delegate tkcore]] ne {}} {
return $obj
}
if {[set obj [my project tk]] ne {}} {
my graft tkcore $obj
return $obj
}
if {[set obj [my tool tk]] ne {}} {
my graft tkcore $obj
return $obj
}
# Provide a fallback
set obj [my add_tool tk {
tag release class tool.core
fossil_url http://core.tcl.tk/tk
}]
my graft tkcore $obj
return $obj
}
method tool {pkg args} {
set obj ::practcl::OBJECT::TOOL.$pkg
if {[llength $args]==0} {
return $obj
}
${obj} {*}$args
}
}
|
