#!/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

#!/usr/bin/env tclsh

#
# mk_tm.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
}

#
# Create script to extract binary data
#
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_tm
#
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 ""
}

#
# Add 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