source: trunk/kitgen/setupvfs.tcl@ 199

Last change on this file since 199 was 195, checked in by demin, 10 years ago

add Tktable and registry, update tcllib, sqlite and zlib

File size: 9.7 KB
Line 
1# setupvfs.tcl -- new tclkit-{cli,gui} generation bootstrap
2#
3# jcw, 2006-11-16
4
5proc history {args} {} ;# since this runs so early, all debugging support helps
6
7if {[lindex $argv 0] ne "-init-"} {
8 puts stderr "setupvfs.tcl has to be run by kit-cli with the '-init-' flag"
9 exit 1
10}
11
12set argv [lrange $argv 2 end] ;# strip off the leading "-init- setupvfs.tcl"
13
14set debugOpt 0
15set encOpt 0
16set msgsOpt 0
17set threadOpt 0
18set tzOpt 0
19
20while {1} {
21 switch -- [lindex $argv 0] {
22 -d { incr debugOpt }
23 -e { incr encOpt }
24 -m { incr msgsOpt }
25 -t { incr threadOpt }
26 -z { incr tzOpt }
27 default { break }
28 }
29 set argv [lrange $argv 1 end]
30}
31
32if {[llength $argv] != 2} {
33 puts stderr "Usage: [file tail [info nameofexe]] -init- [info script]\
34 ?-d? ?-e? ?-m? ?-t? ?-z? destfile (cli|gui)
35 -d output some debugging info from this setup script
36 -e include all encodings i.s.o. 7 basic ones (encodings/)
37 -m include all localized message files (tcl 8.5, msgs/)
38 -t include the thread extension as shared lib in vfs
39 -z include timezone data files (tcl 8.5, tzdata/)"
40 exit 1
41}
42
43set tcl_library ../tcl/library
44source ../tcl/library/init.tcl ;# for tcl::CopyDirectory
45
46package require platform
47
48set platform [lindex [split [platform::generic] -] 0]
49
50load {} zlib
51load {} vfs
52load {} sqlite3
53load {} xotcl
54load {} tdom
55load {} g2lite
56load {} usb
57load {} swt
58load {} csr
59
60# map of proper version numbers to replace @ markers in paths given to vfscopy
61# this relies on having all necessary extensions already loaded at this point
62set versmap [list tcl8@ tcl$tcl_version tk8@ tk$tcl_version \
63 zlib1@ zlib[package require zlib] \
64 vfs1@ vfs[package require vfs] \
65 sqlite3@ sqlite[package require sqlite3] \
66 xotcl1@ xotcl[package require XOTcl] \
67 tdom0@ tdom[package require tdom] \
68 g2lite0@ g2lite[package require g2lite] \
69 usb0@ usb[package require usb] \
70 swt0@ swt[package require swt] \
71 csr0@ csr[package require csr]]
72
73if {[string equal $platform win32]} {
74 load {} registry
75 lappend versmap registry1@ registry[package require registry]
76}
77
78if {$debugOpt} {
79 puts "Starting [info script]"
80 puts " exe: [info nameofexe]"
81 puts " argv: $argv"
82 puts " tcltk: $tcl_version"
83 puts " loaded: [info loaded]"
84 puts " versmap: $versmap"
85 puts ""
86}
87
88# Create package index files for the static extensions.
89set exts [list swt csr usb g2lite XOTcl zlib]
90if {[string equal $platform win32]} {
91 lappend exts registry
92}
93foreach ext $exts {
94 load {} $ext
95 set dst [file join lib "[string tolower $ext][package provide $ext]" pkgIndex.tcl]
96 puts $dst
97 set index($dst) "package ifneeded $ext [package provide $ext] {load {} [string tolower $ext]}"
98}
99set index(lib/sqlite[package provide sqlite3]/pkgIndex.tcl) "package ifneeded sqlite3 [package provide sqlite3] {load {} sqlite3}"\
100
101set clifiles {
102 boot.tcl
103 config.tcl
104 lib/tcl8@/auto.tcl
105 lib/tcl8@/history.tcl
106 lib/tcl8@/init.tcl
107 lib/tcl8@/opt0.4
108 lib/tcl8@/package.tcl
109 lib/tcl8@/parray.tcl
110 lib/tcl8@/safe.tcl
111 lib/tcl8@/tclIndex
112 lib/tcl8@/word.tcl
113 lib/vfs1@/mk4vfs.tcl
114 lib/vfs1@/pkgIndex.tcl
115 lib/vfs1@/starkit.tcl
116 lib/vfs1@/vfslib.tcl
117 lib/vfs1@/vfsUtils.tcl
118 lib/vfs1@/zipvfs.tcl
119 lib/sqlite3@/pkgIndex.tcl
120 lib/xotcl1@/pkgIndex.tcl
121 lib/tdom0@/pkgIndex.tcl
122 lib/tdom0@/tdom.tcl
123 lib/g2lite0@/pkgIndex.tcl
124 lib/usb0@/pkgIndex.tcl
125 lib/swt0@/pkgIndex.tcl
126 lib/csr0@/pkgIndex.tcl
127 lib/zlib1@/pkgIndex.tcl
128 lib/tcllib1.16/pkgIndex.tcl
129 lib/tcllib1.16/asn
130 lib/tcllib1.16/base64
131 lib/tcllib1.16/comm
132 lib/tcllib1.16/cmdline
133 lib/tcllib1.16/csv
134 lib/tcllib1.16/fileutil
135 lib/tcllib1.16/ldap
136 lib/tcllib1.16/log
137 lib/tcllib1.16/math
138 lib/tcllib1.16/snit
139 lib/tcllib1.16/struct
140 lib/tcllib1.16/uri
141}
142
143if {[string equal $platform win32]} {
144 lappend clifiles lib/registry1@/pkgIndex.tcl
145}
146
147set guifiles {
148 tclkit.ico
149 lib/tk8@/bgerror.tcl
150 lib/tk8@/button.tcl
151 lib/tk8@/choosedir.tcl
152 lib/tk8@/clrpick.tcl
153 lib/tk8@/comdlg.tcl
154 lib/tk8@/console.tcl
155 lib/tk8@/dialog.tcl
156 lib/tk8@/entry.tcl
157 lib/tk8@/focus.tcl
158 lib/tk8@/listbox.tcl
159 lib/tk8@/menu.tcl
160 lib/tk8@/mkpsenc.tcl
161 lib/tk8@/msgbox.tcl
162 lib/tk8@/msgs
163 lib/tk8@/obsolete.tcl
164 lib/tk8@/optMenu.tcl
165 lib/tk8@/palette.tcl
166 lib/tk8@/panedwindow.tcl
167 lib/tk8@/pkgIndex.tcl
168 lib/tk8@/safetk.tcl
169 lib/tk8@/scale.tcl
170 lib/tk8@/scrlbar.tcl
171 lib/tk8@/spinbox.tcl
172 lib/tk8@/tclIndex
173 lib/tk8@/tearoff.tcl
174 lib/tk8@/text.tcl
175 lib/tk8@/tk.tcl
176 lib/tk8@/tkfbox.tcl
177 lib/tk8@/unsupported.tcl
178 lib/tk8@/xmfbox.tcl
179 lib/BLT2.4/pkgIndex.tcl
180 lib/BLT2.4/graph.tcl
181 lib/BLT2.4/tabnotebook.tcl
182 lib/BLT2.4/treeview.cur
183 lib/BLT2.4/treeview.xbm
184 lib/BLT2.4/treeview.tcl
185 lib/BLT2.4/treeview_m.xbm
186 lib/BLT2.4/bltCanvEps.pro
187 lib/BLT2.4/bltGraph.pro
188 lib/Tktable2.10/pkgIndex.tcl
189 lib/Tktable2.10/tkTable.tcl
190}
191
192if {$encOpt} {
193 lappend clifiles lib/tcl8@/encoding
194} else {
195 lappend clifiles lib/tcl8@/encoding/ascii.enc \
196 lib/tcl8@/encoding/cp1251.enc \
197 lib/tcl8@/encoding/cp1252.enc \
198 lib/tcl8@/encoding/iso8859-1.enc \
199 lib/tcl8@/encoding/iso8859-2.enc \
200 lib/tcl8@/encoding/iso8859-15.enc \
201 lib/tcl8@/encoding/koi8-r.enc \
202 lib/tcl8@/encoding/macRoman.enc
203}
204
205if {$threadOpt} {
206 lappend clifiles lib/[glob -tails -dir build/lib thread2*]
207}
208
209if {$tcl_version eq "8.4"} {
210 lappend clifiles lib/tcl8@/http2.5 \
211 lib/tcl8@/ldAout.tcl \
212 lib/tcl8@/msgcat1.3 \
213 lib/tcl8@/tcltest2.2
214} else {
215 lappend clifiles lib/tcl8 \
216 lib/tcl8@/clock.tcl \
217 lib/tcl8@/tm.tcl
218
219 lappend guifiles lib/tk8@/ttk
220
221 if {$msgsOpt} {
222 lappend clifiles lib/tcl8@/msgs
223 }
224 if {$tzOpt} {
225 lappend clifiles lib/tcl8@/tzdata
226 }
227}
228
229# look for a/b/c in three places:
230# 1) build/files/b-c
231# 2) build/files/a/b/c
232# 3) build/a/b/c
233
234proc timet_to_dos {time_t} {
235 set s [clock format $time_t -format {%Y %m %e %k %M %S}]
236 scan $s {%d %d %d %d %d %d} year month day hour min sec
237 expr {(($year-1980) << 25) | ($month << 21) | ($day << 16)
238 | ($hour << 11) | ($min << 5) | ($sec >> 1)}
239}
240
241proc walk {path} {
242 set result {}
243 set files [glob -nocomplain -types f -directory $path *]
244 foreach file $files {
245 set excluded 0
246 foreach glob $excludes {
247 if {[string match $glob $file]} {
248 set excluded 1
249 break
250 }
251 }
252 if {!$excluded} {lappend result $file}
253 }
254 foreach dir [glob -nocomplain -types d -directory $path $match] {
255 set subdir [walk $dir $excludes $match]
256 if {[llength $subdir]>0} {
257 set result [concat $result $dir $subdir]
258 }
259 }
260 return $result
261}
262
263proc mkzipfile {zipchan dst {comment {}}} {
264 global index
265
266 set mtime [timet_to_dos [clock seconds]]
267 set utfpath [encoding convertto utf-8 $dst]
268 set utfcomment [encoding convertto utf-8 $comment]
269 set flags [expr {(1<<10)}] ;# use utf-8
270 set method 0 ;# store 0, deflate 8
271 set attr 0 ;# text or binary (default binary)
272 set extra ""
273 set crc 0
274 set csize 0
275 set version 20
276
277 if {[info exists index($dst)]} {
278 set data $index($dst)
279 } else {
280 set a [file split $dst]
281 set src build/files/[lindex $a end-1]-[lindex $a end]
282 if {[file exists $src]} {
283 if {$::debugOpt} {
284 puts " $src ==> $dst"
285 }
286 } else {
287 set src build/files/$dst
288 if {[file exists $src]} {
289 if {$::debugOpt} {
290 puts " $src ==> $dst"
291 }
292 } else {
293 set src build/$dst
294 }
295 }
296 if {[file isfile $src]} {
297 set mtime [timet_to_dos [file mtime $src]]
298 set fin [open $src r]
299 fconfigure $fin -translation binary -encoding binary
300 set data [read $fin]
301 close $fin
302 } else {
303 error "cannot find $src"
304 }
305 }
306
307 set attrex 0x81b60000 ;# 0o100666 (-rw-rw-rw-)
308 if {[file extension $dst] eq ".tcl"} {
309 set attr 1 ;# text
310 }
311
312 set size [string length $data]
313 set crc [zlib crc32 $data]
314 set cdata [zlib deflate $data]
315 if {[string length $cdata] < $size} {
316 set method 8
317 set data $cdata
318 }
319 set csize [string length $data]
320
321
322 set local [binary format a4sssiiiiss PK\03\04 \
323 $version $flags $method $mtime $crc $csize $size \
324 [string length $utfpath] [string length $extra]]
325 append local $utfpath $extra
326
327 set offset [tell $zipchan]
328 puts -nonewline $zipchan $local
329 puts -nonewline $zipchan $data
330
331 set hdr [binary format a4ssssiiiisssssii PK\01\02 0x0317 \
332 $version $flags $method $mtime $crc $csize $size \
333 [string length $utfpath] [string length $extra]\
334 [string length $utfcomment] 0 $attr $attrex $offset]
335 append hdr $utfpath $extra $utfcomment
336
337 return $hdr
338}
339
340# copy file to vfs
341proc vfscopy {zf argv} {
342 global versmap count cd
343
344 foreach f $argv {
345 set dst [string map $versmap $f]
346
347 if {[file isdirectory build/$dst]} {
348 vfscopy $zf [glob -nocomplain -tails -directory build $dst/*]
349 continue
350 }
351
352 append cd [mkzipfile $zf $dst]
353 incr count
354 }
355}
356
357set zf [open [lindex $argv 0] a]
358fconfigure $zf -translation binary -encoding binary
359
360set count 0
361set cd ""
362
363switch [lindex $argv 1] {
364 cli {
365 vfscopy $zf $clifiles
366 }
367 gui {
368 vfscopy $zf $clifiles
369 vfscopy $zf $guifiles
370 }
371 default {
372 puts stderr "Unknown type, must be cli or gui"
373 exit 1
374 }
375}
376
377set cdoffset [tell $zf]
378set endrec [binary format a4ssssiis PK\05\06 0 0 \
379 $count $count [string length $cd] $cdoffset 0]
380puts -nonewline $zf $cd
381puts -nonewline $zf $endrec
382close $zf
383
384if {$debugOpt} {
385 puts "\nDone with [info script]"
386}
Note: See TracBrowser for help on using the repository browser.