[RS] from [Tcl chatroom], 2008-10-17: [patthoyts] To make tkchat.zkit I cd tkchat.vfs ; zip -r ..\tkchat.zip . ; cd .. ; makeziptm tkchat.zip tkchat.zkit If you renamed it .tm it can be a tcl module, for instance a tls.tm module could be done like this I beleve ====== ::set HEADER { -*- tcl -*- @echo off echo %~0 %~f0 if "%OS%" == "Windows_NT" goto WinNT tclsh "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9 goto EOF :WinNT @rem this works for XP - probably not for 2k or NT tclsh %~f0 %* goto EOF } # [make_zip_tm /zipfile/ /outfile/] # Prefixes the specified zipfile with the tclmodule mounter stub and writes # out 'outfile' # # [make_sfx_zip /zipfile/ /outfile/ /sfxstub/] # Adds an arbitrary 'sfx' to a zip file, and adjusts the central directory # and file items to compensate for this extra data. proc make_zip_tm { zipfile outfile } { set sfx_stub {#!/usr/bin/env tclkit # This is a zip-based Tcl Module # Copyright (C) 2005 Pat Thoyts package require vfs::zip vfs::zip::Mount [info script] [info script] if {[file exists [file join [info script] main.tcl]]} { source [file join [info script] main.tcl] } } append sfx_stub \x1A make_sfx_zip $zipfile $outfile $sfx_stub } proc make_sfx_zip { zipfile outfile sfx_stub } { set in [open $zipfile r] fconfigure $in -translation binary -encoding binary set out [open $outfile w+] fconfigure $out -translation binary -encoding binary puts -nonewline $out $sfx_stub set offset [tell $out] lappend report "sfx stub size: $offset" fcopy $in $out set size [tell $out] # Now seek in $out to find the end of directory signature: # The structure itself is 24 bytes long, followed by a maximum of # 64Kbytes text if { $size < 65559 } { set seek 0 } else { set seek [expr { $size - 65559 } ] } #flush $out seek $out $seek #puts "$seek [tell $out]" set data [read $out] set start_of_end [string last "\x50\x4b\x05\x06" $data] set start_of_end [expr {$start_of_end + $seek}] lappend report "SEO: $start_of_end ([expr {$start_of_end-$size}])\ [string length $data]" seek $out $start_of_end set end_of_ctrl_dir [read $out] binary scan $end_of_ctrl_dir issssiis \ eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \ eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) \ eocd(comment_len) lappend report "End of central directory: [array get eocd]" seek $out [expr {$start_of_end+16}] #adjust offset of start of central directory by the length of our sfx stub puts -nonewline $out [binary format i [expr {$eocd(diroffset)+$offset}]] flush $out seek $out $start_of_end set end_of_ctrl_dir [read $out] binary scan $end_of_ctrl_dir issssiis \ eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \ eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) \ eocd(comment_len) lappend report "New dir offset: $eocd(diroffset)" lappend report "Adjusting $eocd(totalnum) zip file items." seek $out $eocd(diroffset) for {set i 0} {$i <$eocd(totalnum)} {incr i} { set current_file [tell $out] set fileheader [read $out 46] binary scan $fileheader is2sss2ii2s3ssii \ x(sig) x(version) x(flags) x(method) \ x(date) x(crc32) x(sizes) x(lengths) \ x(diskno) x(iattr) x(eattr) x(offset) if { $x(sig) != 33639248 } { error "Bad file header signature at item $i: $x(sig)" } foreach size $x(lengths) var {filename extrafield comment} { if { $size > 0 } { set x($var) [read $out $size] } else { set x($var) "" } } set next_file [tell $out] lappend report "file $i: $x(offset) $x(sizes) $x(filename)" seek $out [expr {$current_file+42}] puts -nonewline $out [binary format i [expr {$x(offset)+$offset}]] #verify: flush $out seek $out $current_file set fileheader [read $out 46] lappend report "old $x(offset) + $offset" binary scan $fileheader is2sss2ii2s3ssii \ x(sig) x(version) x(flags) x(method) \ x(date) x(crc32) x(sizes) x(lengths) \ x(diskno) x(iattr) x(eattr) x(offset) lappend report "new $x(offset)" seek $out $next_file } #puts [join $report \n] } if {!$tcl_interactive} { set r [catch {eval [linsert $argv 0 make_zip_tm]} err] puts $err exit $r } # --- end --- # \ :EOF