- first writes all specified Tcl scripts to the output file
- then, if a DLL is specified, generates loader code, puts a Ctrl-Z to terminate sourceing
- and finally appends the DLL in binary translation
#!/usr/bin/env tclsh
set usage {
usage: make_tm package version ?tclfile...? ?dllfile initfunc?
Creates a Tcl module file 'outfilename' from the specified tclfiles
and/or maximally one DLL.
}
if {[llength $argv] == 0} {puts stderr $usage; exit 1}
proc main argv {
set package [lindex $argv 0]
set version [lindex $argv 1]
set outf [open ${package}-${version}.tm w]
fconfigure $outf -translation lf
puts $outf "package provide [lindex $argv 0] [lindex $argv 1]"
foreach a [lrange $argv 2 end] {
switch -- [file extension $a] {
.tcl {
puts $outf "\#-- from $a"
set f [open $a]
fcopy $f $outf
close $f
}
.dll {
set f [open $a]
fconfigure $f -translation binary
puts $outf "\#-- from $a"
puts $outf "set tmp \[open \$env(TMP)\\[file tail $a] w\]"
puts $outf {
set f [open [info script]]
fconfigure $f -translation binary
set data [read $f][close $f]
set ctrlz [string first \u001A $data]
fconfigure $tmp -translation binary
puts -nonewline $tmp [string range $data [incr ctrlz] end]
close $tmp
}
puts $outf "load \$env(TMP)/[file tail $a] [lindex $argv end]"
puts -nonewline $outf \u001A
fconfigure $outf -translation binary
fcopy $f $outf
close $f
break
}
default {error "cannot handle file $a"}
}
}
close $outf
}
main $argvI tested this on Windows with Tcl 8.4.1 and
/Tcl $ make_tm.tcl regtry 1.1 vecmath.tcl lib/reg1.1/tclreg11.dll registryand it worked nicely, as far as I can tell - the registry command is usable after sourcing. One can even edit the resulting .tm file with emacs, without damage to the embedded DLL :^)MJ - Some remarks
- the / slash after the TEMP directory gives me an 'access denied' error when loading the dll. With \\ it works. (changed)
- if the line terminator of the Tcl scripts is CRLF I cannot edit it with emacs or vim on windows. With LF it's fine. (changed)
- changed the command line parameters and added a package provide
