Source for [Windows SDX Shell Fix]
----
 package provide app-wsf 1.01
 # Windows Shell Fix - WSF
 # Modifys Windows Shell command's filenames to remove
 # the path and then call sdx.
 # 
 # ====================================
 # 
 # See 'Windows SDX Shell Fix" on the TCL'ers Wiki at  
 # http://wiki.tcl.tk/9073 
 #
 # sdx fails with Windows Shell Commands since the sdx.kit 
 # doesn't like the "\"s that the Windows Shell Uses
 # c:\folder1\folder 2\sub folder\filename.ext
 #
 # It turns out that since windows will set the current directory
 # to the folder in which the file was right clicked
 # All that really needs to be done is to strip off the path
 # of the last parameter.
 # 
 # Windows Shell Fix does this and then calls the SDX program.
 # So the scheme for Actions for a .KIT "File Type" is 
 # Action  Command
 # -----------------------------------------------------
 # List    "<path>tclkit-win32.upx.exe" wsp.kit lsk    {%1}
 # UnWrap  "<path>tclkit-win32.upx.exe" wsp.kit unwrap {%1}
 # Wrap    "<path>tclkit-win32.upx.exe" wsp.kit wrap   {%1}
 # Update  "<path>tclkit-win32.upx.exe" wsp.kit update {%1}
 #   
 # where <path> looks something like "D:\@umark\dl\Starkit\"
 #   
 # wsf:
 #  -receives the parameters
 #  -adjusts the last one which has the <path>filename.ext
 #     so that it just has filename.ext
 #  -calls sdx passing the parameters
 #  -provides an Exit button to Avoid the Orhan Process problem
 #
 # It also checks to make sure:
 #  -it's running under Windows
 #  -the last parameter is a filespec
 #  -the file exists (gives error if not)
 #  -that sdx.kit is in the same folder as wsf.kit
 # 
 # ====================================
 # By The ZipGuy     email: zipguy@nonags dot com
 #                 website: http://www.zipguy.net
 #
 # This is released to the public Domain as is with no warranty.
 # Use this code completely at your own risk.
 # 
 ####################################################
 # Change Log
 #+-----------------------------------------------------------------------------+
 #|Version Notes
 #+-----+----------+------------------------------------------------------------+
 #+Ver  |MM/DD/YYYY| Description                           
 #+-----+----------+------------------------------------------------------------+
 #+1.00 |06/06/2003| Zipguy - First version Released            
 #+-----+----------+------------------------------------------------------------+
 #+1.01 |06/07/2003| Zipguy - Small code cleanup and change leftover old name 
 #+     |          | 'fsp' to 'wsf' in some comments and messages
 #+     |          | procified to display exit window and exit messages for
 #+     |          | errors... added exit messages to errors
 #+     |          | Exit after 5 minutes in case they just close the console
 #+-----+----------+------------------------------------------------------------+
 #+     |          |                                                           
 #+-----+----------+------------------------------------------------------------+
 #


 # ==================================
 # ========= Procs Start ============

  proc dbgputs { out } { 
  # ===========================================================     
  # dbgputs - displays passed messages prefixed "WSF: " 
  #           if $debugmsgs is set to 1. 
  # ===========================================================     
    global debugmsgs
    if { $debugmsgs } {
      puts "WSF: $out"
    } ;# END-IF
  } ;# END-PROC

  proc showvar { a {c ""} } {
  # ===========================================================     
  # showvar - Displays a variables Contents - uses dbgputs
  #           Optional text can follow as second parameter
  #             (default is blank)
  # ===========================================================     
    upvar $a  b
    dbgputs "Variable $a is :\[$b\]  $c"
  } ;# END-PROC

  proc plist { a } {
  # ===========================================================     
  # Displays a variables Contents - uses dbgputs
  # ===========================================================     
    upvar $a  b
    dbgputs "List $a Contains [llength $b] Item(s):"
    dbgputs "=============================="
    set i 0
    foreach c $b {
      dbgputs "Item $i=\[$c\]"
      incr i
    } ;# END-FOR
    dbgputs "=============================="
  } ;# END-PROC


  proc exit_window { } {
  # ===========================================================     
  # provide an easy way to exit application
  # ===========================================================     
    button .exit -text Exit -command exit
    eval pack [winfo children .] -side bottom -fill both -expand 1
  } ;# END-PROC
  proc remap_exit_window { } {
  # ===========================================================     
  # Remap window . by deiconifying it to recover from sdx since
  # sdx does "window withdraw ."  
  # ===========================================================     
    after 500 wm deiconify .
  } ;# END-PROC

  proc exit_msg { } {
  # ===========================================================     
  # exit_msg - Display exit message. Used after Error
  # ===========================================================     
    puts " 
 DO NOT just close this Window,

 Click the 'Exit' button 
  (OR Type 'exit' in this Window, and hit Enter)"

    exit_window
  } ;# END-PROC

  proc fix_last_arg {  } {
  # ===========================================================     
  # fix_last_arg - Retrieves last arg, changing "\"s to "/"s.
  #                Does Validation edits on that parameter. 
  #                Makes sure sdx.kit is in same folder as wsf.
  #                Calls SDX if evertying is ok.
  #                Provides Exit Button in Window "." for after
  #                  sdx exits. Window users may just close
  #                  console creating Zombie interpreter.
  # ===========================================================
    global argv argc argerr

    # get the last parameter replacing back slashes with slashes
    set lastparm [string map {\\ /} [lindex $argv end] ]

    if { [string length $lastparm] < 4 } { 
      puts "WSF: Error - Last Parameter is Too short! $lastparm"
      exit_msg
      return
    } ;# END-IF
    # Trim Leading and Trailing brackets { } (if any)
    # This may no longer be necessary
    set lastparm [string trim $lastparm "\{\}"]

    # Does lastparm begin with "x:/" like a windows filespec? 
    if {[string range $lastparm 1 2] != ":/"} { 
      puts "\

 WSF: Error - second and third charcters of the last parameter:
 $lastparm
  ^^ 
  || <--- Should be :/ and they aren't
  :/       
 Make sure you enclosed the %1 in quotes \"%1\" in the 'Command'
 for 'Action': \[[lindex $argv end-1]\]"
       exit_msg
       return
     } ;# END-IF 

     # Get the proper long name (Shell may uppercase everything)
     set lastparm [file attribute [file tail $lastparm] -longname]  

     if { [file exists $lastparm] } {
       # Replace the Last Parameter with $lastparm 
       set argv     [lreplace $argv end end $lastparm]
       # Get full path and Name of sdx.kit - Should be in same Folder!
       set sdx  [file join [file dirname $starkit::topdir] sdx.kit] 
       # Is SDX there?
       if { [file exists $sdx] } { 
         # Yes - all set so get ready to run sdx -  

         # Create window with "Exit" button to stop script 
         exit_window
         puts "WSF: Done....Calling sdx.kit with args: \[$argv\]
 - - - - - - - - - - - - - - - - - - - - - - - "

         source $sdx 
         # Give sdx Exit Message  
         puts "\


 DO NOT just close this Window. 

 After sdx finishes, Click the 'Exit' button 
   (OR Type 'exit' in this Window, and hit Enter)"  

         remap_exit_window
         return
 
       } else {
         # No  - Give Error message

         puts "WSF: Error sdx.kit should be in the same folder as wsf.kit
 WSF: wsf.kit is in folder [file dirname $starkit::topdir]"

         exit_msg
         return
       } ;# END-IF

     } else {
       puts "WSF: File $lastparm Not Found! Exiting."
       exit_msg
       return
     } ;# END-IF

   } ;# END-PROC

 # ==========Procs end ==============
 # ==================================

 # ==================================
 # ======== Main Code Start =========
 
   package require Tk

   # 0-No messages 1-Messages 
   set debugmsgs 1 

   # Display the Console
   catch {console show}
   # Display the received arguments on the console in a formatted style
   plist argv
   # are we on windows? 
   if {[string compare $tcl_platform(platform) "windows"]  } {
     # Nope give error 

     puts "WSF: Error Not running on Windows. WSF is for Windows. 
 WSF: Platform is \[$tcl_platform(platform)\]." 

     exit_msg

   } else {
     fix_last_arg
     # Exit after 5 minutes in case they just close the console
     after 300000 exit
   } ;# END-IF

 # End of wsf.tcl code

 # ======== Main Code Start =========
 # ==================================
----
[Category TCLkit] - [Category Windows]