Richard Suchenwirth 2007-08-17 - Looking at Tcl modules, I wanted to know how to produce such a sourceable module file which contains both Tcl scripts and one DLL (and thus does more than the Tcl module creation script). Here is my take, which
#!/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 $argv
I tested this on Windows with Tcl 8.4.1 and
/Tcl $ make_tm.tcl regtry 1.1 vecmath.tcl lib/reg1.1/tclreg11.dll registry
and 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
sbasi - 2016-05-30 19:14:15
An even more elaborate version.
This one can add any number of binary files and lets you specify on which platform(s) each file should be loaded or sourced.
#!/usr/bin/env tclsh # # mk_tmModule.tcl -- # # Create tm module from one or more files (binary and/or scripts). # package require Tcl 8.6 set usage "Create a tm module from one or more files, with multiplatform-support. Usage: $argv0 packagename version specstr: filename ?specstr: filename ...? packagename name of the package version version of the package specstr platform-{script|binary} platform is one of the values that \$tcl_platform(platform) chan have or \"any\". filename path to the file to add to the module " if {$argc < 3} { puts stderr "Wrong # args: must be $argv0 package version specstr: filename ?specstr: filename ...?" puts stderr "" puts stderr $usage exit 1 } set package lindex $argv 0 set version lindex $argv 1 # # Collect info about infiles # puts "Scanning infiles..." set dataDict dict create for {set i 2} {$i < $argc} {incr i} { set tmp lindex $argv $i if {incr i >= $argc} { puts stderr "Missing filename to go with specstr lindex $argv $i-1" exit 1 } if {string index $tmp end eq ":"} { set tmp string range $tmp 0 end-1 } set tmp split $tmp "-" if {llength $tmp != 2} { puts stderr "Malformed specstr lindex $argv $i-1: must be platform-{script|binary}:" exit 1 } if {lindex $tmp 0 ni {windows unix any}} { puts stderr "Unknown platform: lindex $tmp 0" exit 1 } set type lindex $tmp 1 if {$type ni {script binary}} { puts stderr "Wrong file type spec $type: should be script or binary" exit 1 } if {$type eq {binary} && lindex $tmp 0 eq {any}} { puts stderr "Platform independent binary file? This can't be right..." exit 1 } set filename lindex $argv $i if {catch {open $filename r} fd} { puts stderr "$fd. Skipping." continue } if {$type eq {binary}} { fconfigure $fd -translation binary } dict set dataDict $filename data read $fd dict set dataDict $filename tail file tail $filename dict set dataDict $filename platform lindex $tmp 0 dict set dataDict $filename type $type dict set dataDict $filename size [string length [dict get $dataDict $filename data] close $fd } if {dict size $dataDict == 0} { puts stderr "No infiles, nothing to do!" exit 1 } # # Write script part of module # puts "Generating script..." if {catch {open ${package}-${version}.tm w} tmfd} { puts stderr "Cannot create tm file: $tmfd" exit 1 } fconfigure $tmfd -translation lf puts $tmfd {# # -- tcl module generated by mk_tmModule # if {file exists "/tmp"} {set tmpdir "/tmp"} catch {set tmpdir $::env(TMP)} catch {set tmpdir $::env(TEMP)} set fd open [info script r] fconfigure $fd -translation binary set data read $fd close $fd set startIndex string first \u001A $data incr startIndex } set binaryFiles {} set scriptFiles {} foreach key dict keys $dataDict { if {dict get $dataDict $key type eq {script}} { lappend scriptFiles $key continue } else { lappend binaryFiles $key } puts $tmfd "#-- extract dict get $dataDict $key tail" puts $tmfd "set tmpFileName [file normalize [file join \$tmpdir \{dict get $dataDict $key tail\} \]\]" puts $tmfd {set fd open $tmpFileName w} puts $tmfd {fconfigure $fd -translation binary} puts $tmfd "puts -nonewline \$fd [string range \$data \$startIndex [incr startIndex dict get $dataDict $key size\]-1 \]" puts $tmfd {close $fd } puts $tmfd "if \{\$tcl_platform(platform) eq \{dict get $dataDict $key platform\}\} \{" puts $tmfd " load \$tmpFileName" puts $tmfd "\}" puts $tmfd {file delete $tmpFileName} puts $tmfd "" } # # Script files # puts "Adding scripts..." foreach file $scriptFiles { puts $tmfd "#-- From dict get $dataDict $file tail" if {dict get $dataDict $file platform ne {any}} { puts $tmfd "if \{\$tcl_platform(platform) eq \{dict get $dataDict $file platform\}\} \{" puts $tmfd dict get $dataDict $file data puts $tmfd "\}\n" } else { puts $tmfd dict get $dataDict $file data puts "" } } puts $tmfd "package provide ${package} ${version}" puts $tmfd "#-- End of script section" # # append binary data # puts "Writing binary data..." fconfigure $tmfd -translation binary puts -nonewline $tmfd "\u001A" foreach file $binaryFiles { puts -nonewline $tmfd dict get $dataDict $file data } close $tmfd puts "Done!" exit 0