[AMG]: Bug fixes and enhancements to SDX version 20110317:

======none
diff -ur old/lib/app-sdx/mkpack.tcl new/lib/app-sdx/mkpack.tcl
--- old/lib/app-sdx/mkpack.tcl        2017-08-09 19:43:50.089879453 -0500
+++ new/lib/app-sdx/mkpack.tcl        2017-08-08 19:07:52.495423972 -0500
@@ -3,7 +3,7 @@
 # Re-pack a starkit/starpack or MK datafile (header is kept intact)
 # Jan 2004, jcw@equi4.com
 
-proc fail {msg} { puts stderr "${::inf}: $msg"; exit 1 }
+proc fail {msg} { variable inf; puts stderr "$inf: $msg"; exit 1 }
 
 if {[llength $argv] != 2} {
   set inf usage
diff -ur old/lib/app-sdx/mksplit.tcl new/lib/app-sdx/mksplit.tcl
--- old/lib/app-sdx/mksplit.tcl        2017-08-09 19:43:50.090879452 -0500
+++ new/lib/app-sdx/mksplit.tcl        2017-08-08 19:07:52.495423972 -0500
@@ -4,7 +4,7 @@
 # derived from mkinfo.tcl code
 # Jan 2004, jcw@equi4.com
 
-proc fail {msg} { puts stderr "${::filename}: $msg"; exit 1 }
+proc fail {msg} { variable filename; puts stderr "$filename: $msg"; exit 1 }
 
 if {[llength $argv] < 1} {
   set filename usage
diff -ur old/lib/app-sdx/ratarx.tcl new/lib/app-sdx/ratarx.tcl
--- old/lib/app-sdx/ratarx.tcl        2017-08-09 19:43:50.092879451 -0500
+++ new/lib/app-sdx/ratarx.tcl        2017-08-08 19:07:52.496423972 -0500
@@ -60,7 +60,8 @@
 close $fd
 
 proc cleandir {{d ""}} {
-  set f [expr {![info exists ::dirs($d/)]}]
+  variable dirs
+  set f [expr {![info exists dirs($d/)]}]
   foreach x [glob -nocomplain [file join $d *]] {
     incr f [expr {[file isdir $x] ? [cleandir $x] : 1}]
   }
diff -ur old/lib/app-sdx/wrap.tcl new/lib/app-sdx/wrap.tcl
--- old/lib/app-sdx/wrap.tcl        2017-08-09 19:43:50.095879453 -0500
+++ new/lib/app-sdx/wrap.tcl        2017-08-09 19:26:22.948879456 -0500
@@ -64,16 +64,6 @@
     puts stderr "file in use, cannot be prefix: [file normalize $filename]"
     exit 1
   }
-  set size [file size $filename]
-  catch {
-    package require vfs::mk4
-    vfs::mk4::Mount $filename hdr -readonly
-    # we only look for an icon if the runtime is called *.exe (!)
-    if {[string tolower [file extension $filename]] == ".exe"} {
-      catch { set ::origicon [readfile hdr/tclkit.ico] }
-    }
-  }
-  catch { vfs::unmount $filename }
   return [readfile $filename]
 }
 
@@ -110,11 +100,19 @@
       set pfile [lindex $argv 2]
       if {$pfile == $out} {
               set reusefile 1
-      } else {
-              set header [LoadHeader $pfile]
       }
+      set header [LoadHeader $pfile]
       set argv [lreplace $argv 1 2]
       set prefix 1
+      catch {
+        package require vfs::mk4
+        vfs::mk4::Mount $pfile $pfile -readonly
+        # we only look for an icon if the runtime is called *.exe (!)
+        if {[string tolower [file extension $pfile]] == ".exe"} {
+          catch { set origicon [readfile [file join $pfile tclkit.ico]] }
+        }
+      }
+      catch { vfs::unmount $pfile }
     }
     -writable -
     -writeable {
@@ -223,7 +221,15 @@
       }
     }
   }
-  writefile $out $header
+  if {$reusefile} {
+    set fd [open $out a+]
+    fconfigure $fd -translation binary
+    seek $fd 0
+    puts -nonewline $fd $header
+    close $fd
+  } else {
+    writefile $out $header
+  }
 }
 
 # 2005-03-15 added AF's code to customize version/description strings in exe's
@@ -278,13 +284,21 @@
 
     # 2003-06-19: new "-uncomp name" option to store specific file(s)
     #                    in uncompressed form, even if the rest is compressed
-  set o $vfs::mk4::compress
-  set vfs::mk4::compress 0
+  if {[info exists vfs::mk4::compress]} {
+    set o $vfs::mk4::compress
+  }
+  if {[namespace exists vfs::mk4]} {
+    set vfs::mk4::compress 0
+  }
   foreach f $explist {
     file delete -force [file join $out $f]
     file copy [file join $idir $f] [file join $out $f]
   }
-  set vfs::mk4::compress $o
+  if {[info exists o]} {
+    set vfs::mk4::compress $o
+  } elseif {[namespace exists vfs::mk4]} {
+    unset vfs::mk4::compress
+  }
 
   vfs::unmount $out
 } elseif {![catch { package require vlerq }]} {
======

Improved "sdx" package, better enabling SDX to be used as a utility library:

======
# sdx.tcl
#
# This package is an alternative to sdx.kit's lib/sdx/sdx.tcl.  Namespaces, not
# slave interpreters, are used to sandbox the SDX scripts because the Starkit
# infrastructure is not given the opportunity to initialize slave interpreters
# to the point where SDX can function reliably.

# Create namespace variables.
namespace eval ::sdx {
    # Directory in which the SDX scripts are located.
    variable SdxDir
}

# Create stdout/stderr interception mechanism.
namespace eval ::sdx::Intercept {
    proc initialize {chan mode} {info procs}
    proc finalize {chan} {}
    proc clear {chan} {}
    proc flush {chan} {}
    proc write {chan data} {append ::sdx::Intercept::Output $data; return}
    namespace export *
    namespace ensemble create
}

# Analyze the app-sdx package.
apply {{} {
    variable ::sdx::SdxDir

    # Force all package information to be loaded.
    catch {package require {}}

    # Find the load script for the latest version of app-sdx.
    set script [package ifneeded app-sdx [lindex [lsort\
            -command {package vcompare} [package versions app-sdx]] end]]

    # Extract the directory from the app-sdx load script.
    set SdxDir [file dirname [lindex $script end]]

    # Create aliases for each available SDX command.
    foreach file [glob -tails -directory $SdxDir *.tcl] {
        if {$file ni {pkgIndex.tcl sdx.tcl}} {
            set command [file rootname $file]
            interp alias {} ::sdx::$command {} ::sdx::sdx $command
        }
    }
}}

# ::sdx::sdx --
# Invokes the SDX application as a script command.
proc ::sdx::sdx {command args} {
    variable ::sdx::Intercept::Output {} SdxDir

    # Compute name of SDX script file.
    set script [file join $SdxDir $command.tcl]

    # Confirm the SDX script exists.
    if {![file exists $script]} {
        foreach file [lsort [glob -tails -directory $SdxDir *.tcl]] {
            if {$file ni {pkgIndex.tcl sdx.tcl}} {
                lappend commands [file rootname $file]
            }
        }
        return -code error "unknown subcommand \"$command\":\
                must be [join $commands ", "]"
    }

    # Get the list of mounted filesystems.  This allows automatically unmounting
    # filesystems left mounted by SDX.
    set filesystems [vfs::filesystem info]

    # Get the list of file channels.  This allows automatically closing channels
    # left open by SDX.
    set channels [chan names]

    # Prepare to restore the current working directory, should SDX change it.
    set pwd [pwd]

    # Collect everything written to stdout and stderr into the Output variable.
    chan push stdout ::sdx::Intercept
    chan push stderr ::sdx::Intercept

    # Intercept [exit] and convert it to an error with a custom "-exit" option.
    rename ::exit ::sdx::RealExit
    set token [interp alias {} ::exit {} apply {{{exit 0}} {
        return -code error -exit $exit [string trim $::sdx::Intercept::Output]
    }}]

    # Create temporary sandbox namespace in which to execute SDX command.  This
    # namespace will collect any variables and commands created by SDX.  It is
    # kept separate from the ::sdx namespace so that commands in ::sdx (such as
    # [eval]) do not interfere with the operation of the underlying SDX command.
    namespace eval ::sdx::Sandbox [list set argv0 [list ::sdx::sdx $command]]
    namespace eval ::sdx::Sandbox [list set argv $args]

    # Prepare to handle SDX errors.
    set options {-code return}
    try {
        # Run the requested SDX script.
        namespace eval ::sdx::Sandbox [list source $script]
    } on error {value options} {
        # Handle errors and intercepted [exit], which was converted to an error.
        if {![dict exists $options -exit]} {
            set Output $value\n$Output
        } elseif {[dict get $options -exit]} {
            set Output "SDX exit code [dict get $options -exit]\n$Output"
        } else {
            dict set options -code return
        }
    } finally {
        # Delete sandbox namespace.
        namespace delete ::sdx::Sandbox

        # Restore original [exit] command.
        interp alias {} $token {}
        rename ::sdx::RealExit ::exit

        # Stop intercepting stdout/stderr.
        chan pop stdout
        chan pop stderr

        # Return to the original working directory.
        cd $pwd

        # Close leftover channels.
        foreach chan [chan names] {
            if {$chan ni $channels} {
                chan close $chan
            }
        }

        # Unmount leftover filesystems.
        foreach filesystem [vfs::filesystem info] {
            if {$filesystem ni $filesystems} {
                vfs::filesystem unmount $filesystem
            }
        }
    }

    # The return value is the intercepted stdout/stderr text.
    dict set options -level 0
    return {*}$options [string trim $Output[set Output {}]]
}

# vim: set sts=4 sw=4 tw=80 et ft=tcl:
======

----
[PYK] 2017-08-09:  How about publishing your changes as a fossil repository on [chisel]?

[AMG]: At this point I don't want to go so far as to take ownership of SDX.

[PYK] 2017-08-09:  It's pretty fair these days to publish forks into a [scm] system without asserting a claim of ongoing maintenance.  If it's not in a repository, there's a much lower change that change history will be captured as the source code changes hands, and that history can be valuable.  FWIW, [jcw] responded quickly when made a pull request on [https://github.com/jcw%|%github] last year for [metakit].  Also, publishing a diff makes you the new owner every bit as much as publishing a fossil repository would ;)

[aspect]: There is already a repository on chiselapp, linked at the very top of [SDX].  I've created a ticket - if anyone feels like attaching a fossil bundle I'd be much obliged :).

<<categories>> Tclkit | Wikit