punkshell/src/modules/punk/winrun-999999.0a1.0.tm

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) J.M.Noble 2023
#
# @@ Meta Begin
# Application punk::winrun 999999.0a1.0
# Meta platform     tcl
# Meta license      BSD
# @@ Meta End



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
##e.g package require frobz
#package require twapi ;#not loaded here because as of 2023-11 load is *very* slow. Todo - query APN re return to faster partial loading facility for twapi subsets.
#update 2024 - while twapi is slower to load than other packages - it's not *that* bad. Earlier tests were on a machine which may have had disk issues, and made twapi's relative difference noticeable.
#slow twapi load at startup can be ameliorated by async loading the dll in another thread in circumstances where it's not needed immediately anyway - but this doesn't help for filters where we need twapi functionality asap.

#see also: https://daviddeley.com/autohotkey/parameters/parameters.htm#WINNOSTANDARD
#https://learn.microsoft.com/en-gb/archive/blogs/twistylittlepassagesallalike/everyone-quotes-command-line-arguments-the-wrong-way

#see also: Tip 424: Improving [exec]
#https://core.tcl-lang.org/tips/doc/trunk/tip/424.md


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::winrun {
    namespace export *
    proc twapi_exec {cmdline args} {
        package require twapi
        set psinfo [twapi::create_process {} -cmdline $cmdline {*}$args]
    }

    proc readchild_handler {chan hpid} {
        #fileevent $chan readable {}
        set data [read $chan 4096]
        while {![chan blocked $chan] && ![eof $chan]} {
            append data [read $chan 4096]
        }
        puts stdout "-->$data eof:[eof $chan] chan blocked [chan blocked $chan]"
        flush stdout
        if {![eof $chan]} {
            puts stdout "not eof $chan [fconfigure $chan] chan blocked:[chan blocked $chan]"
            #fileevent $chan readable [list punk::winrun::readchild_handler $chan $hpid]
        } else {
            #puts "eof: waiting exit process"
            set punk::winrun::waitresult [twapi::wait_on_handle $hpid -wait -1]
        }
    }
    proc readchilderr_handler {chan} {
        fileevent $chan readable {}
        set data [read $chan]
        puts stderr "err: $data"
        flush stderr
        if {![eof $chan]} {
            fileevent $chan readable [list punk::winrun::readchild_handler $chan]
        }
    }

    proc testrun {cmdline} {
        #twapi::create_file to redirect?
        package require twapi
        set cmdid [clock millis]
        set childout [twapi::namedpipe_server [string map [list %id% $cmdid ] {//./pipe/tcl-stdout-%id%}] -access write]
        set childerr [twapi::namedpipe_server [string map [list %id% $cmdid ] {//./pipe/tcl-stderr-%id%}] -access write]
        set childin  [twapi::namedpipe_server [string map [list %id% $cmdid ] {//./pipe/tcl-stdin-%id%}] -access read]


        set psinfo [twapi::create_process {} -cmdline $cmdline -returnhandles 1 -detached 0 -newconsole 1 -showwindow hidden -inherithandles 1 -stdchannels [list $childin $childout $childerr]]
        puts stdout "psinfo:$psinfo"
        lassign $psinfo _pid _tid hpid htid

        set readout [twapi::namedpipe_client [string map [list %id% $cmdid ] {//./pipe/tcl-stdout-%id%}] -access read]
        set readerr [twapi::namedpipe_client [string map [list %id% $cmdid ] {//./pipe/tcl-stderr-%id%}] -access read]
        set writein [twapi::namedpipe_client [string map [list %id% $cmdid ] {//./pipe/tcl-stdin-%id%}] -access write]

        #after 1000
        chan configure $readout -blocking 0
        fileevent $readout readable [list readchild_handler $readout $hpid]
        puts stdout "input: [chan configure $writein]"
        puts $writein "puts stdout blah;"
        flush $writein
        puts $writein "flush stdout"
        flush $writein
        puts $writein "puts exiting" 
        puts $writein "after 10;exit 4"
        flush $writein
        #puts stdout x--[read $readout]

        #if the cmdline is a pipeline - the wait will return as soon as the first process returns... not the entire pipeline. :/
        #set waitresult [twapi::wait_on_handle $hpid -wait -1]
        #e.g timeout, signalled

        close $childout
        close $childerr
        close $childin

        #after 1 [list wait_on $hpid]
        variable waitresult
        vwait punk::winrun::waitresult
        if {$waitresult eq "timeout"} {
            puts stderr "tw_run: timeout waiting for process"
        }
        fileevent $readout readable {}
        fileevent $readerr readable {}

        set code [twapi::get_process_exit_code $hpid]
        twapi::close_handle $htid
        twapi::close_handle $hpid
        return [dict create exitcode $code] 
    }
    proc wait_on {hpid} {
        set punk::winrun::waitresult [twapi::wait_on_handle $hpid -wait -1]
    }
    proc tw_run {cmdline} {
        #twapi::create_file to redirect?
        package require twapi
        set psinfo [twapi::create_process {} -cmdline $cmdline -returnhandles 1]
        lassign $psinfo _pid _tid hpid htid
        set waitresult [twapi::wait_on_handle $hpid -wait -1]
        #e.g timeout, signalled
        if {$waitresult eq "timeout"} {
            puts stderr "tw_run: timeout waiting for process"
        }
        set code [twapi::get_process_exit_code $hpid]
        twapi::close_handle $htid
        twapi::close_handle $hpid
        return [dict create exitcode $code] 
    }

    #completely raw to windows createprocess API - caller will really need to understand what they're doing.
    proc runraw {args} {
        foreach w $args {
            append cmdline $w " "
        }
        set cmdline [string range $cmdline 0 end-1]
        #puts stdout --$cmdline
        tw_run $cmdline
    }


    #apparently there is no windows API function to do the reverse of CommandLineToArgvW
    proc quote_win {args} {
        #The algorithm used here is that shown in ArgvQuote from the following article:
        #https://learn.microsoft.com/en-gb/archive/blogs/twistylittlepassagesallalike/everyone-quotes-command-line-arguments-the-wrong-way
        # -- --- ---- --- --- --- --- --- --- --- ---
        set splitargs [internal::get_run_opts $args]
        set runopts [dict get $splitargs runopts]
        set cmdargs [dict get $splitargs cmdargs]
        set quiet 0
        if {"-quiet" in $runopts} {
            set quiet 1
        }
        set verbose 0
        if {"-verbose" in $runopts} {
            set verbose 1
        }
        # -- --- ---- --- --- --- --- --- --- --- ---


        set raw_cmdline ""
        set tcl_list [list]
        set i 0
        foreach a $cmdargs {
            set copy [internal::objclone $a]
            append raw_cmdline "$copy "
            lappend tcl_list $copy
            if {$i == 0 && !$quiet} {
                if {"[string index $copy 0][string index $copy end]" eq {""}} {
                    #review legit reasons to call with quoted first arg. Such users can use the -q flag so that this warning can remain to help in general debugging
                    puts stderr "WARNING: quote_win first argument should not be pre-quoted if it is to be interpreted correctly on windows (e.g with CommandLineToArgvW)"
                }
            }
            incr i
        }
        if {[llength $cmdargs] > 0} {
            set raw_cmdline [string range $raw_cmdline 0 end-1] ;#trim 1 trailing space
        }
        if {$verbose} {
            puts stdout "==raw_cmdline== $raw_cmdline" ;# string built from list elements is different to string rep of original list which potentially has Tcl escapes visible
        }

        #don't run regexp on the list rep
        #set wordranges [regexp -inline -all -indices {\S+} $raw_cmdline]
        #set raw_parts  [list]
        #foreach range $wordranges {
        #    set word [string range $raw_cmdline {*}$range]
        #    lappend raw_parts [internal::objclone $word]
        #}


        set cmdline ""
        set i 0
        foreach w $tcl_list {
            #puts "== processing word $w"
            if {$w ne "" && [string first " " $w] < 0 && [string first \t $w] < 0 && [string first \n $w] < 0 && [string first {"} $w] < 0 && [string first \v $w] < 0} {
                append cmdline "$w "
                continue
            }
            append cmdline {"}
            set chars [split $w ""]
            set wordlen [string length $w]
            set nlast [expr {$wordlen -1}] 
            for {set n 0} {$n<$wordlen} {incr n} {
                set char [lindex $chars $n]
                set num_backslashes 0     
                while {$char eq "\\" && $n<$nlast} {
                    incr num_backslashes
                    incr n
                    set char [lindex $chars $n]
                }
                if {$n > $nlast} {
                    append cmdline [string repeat "\\" [expr {$num_backslashes * 2}]]
                    break 
                } elseif {$char eq {"}} {
                    #escape all backslashes and the following double-quote
                    append cmdline [string repeat "\\" [expr {$num_backslashes * 2 + 1}]] $char
                } else {
                    append cmdline [string repeat "\\" $num_backslashes] $char
                }

            }
            append cmdline {" }
            incr i
        }
        set cmdline [string range $cmdline 0 end-1]
        # -----------------
        if {$verbose} {
            puts stdout --cmdline->$cmdline
        }
        # -----------------
        #tw_run $cmdline 
        #assertion - can be treated as tcl list ?
        return $cmdline
    }
    interp alias "" [namespace current]::quote_wintcl    "" ::punk::winrun::quote_win ;#just for symmetry with unquote_wintcl

    proc unquote_win {standard_quoted_cmdline} {
        #This twapi call uses the windows api function:  CommandLineToArgvW  (Twapi_CommandLineToArgv calls it and handles the winchars conversion)
        # - a quoted first word such as the following will not turn out well: "\"cmd\""
        # - First word on commandline is expected to be the program name - and not wrapped in extra double quotes even if it contains spaces.
        twapi::get_command_line_args $standard_quoted_cmdline
    }

    #equivalent of unquote_win implemented in Tcl - for testing if assumptions are correct, and whether the api does something different between os versions.
    #There are differences in particular with repeated double quotes.
    #This function seems to behave in alignment with how tclsh gets it's argv parameters - whereas Twapi 4.7.2 CommandLineToArgvW splits differently
    #e.g for commandline: cmd """a b c""" etc
    #unquote_wintcl and tclsh ::argv give 2 args, "a b c" , etc
    #CommandLineToArgvW gives 4 args   "a , b , c" , etc
    #
    #NOTE: used by flagfilter for splitting dispatchrecord raw element
    proc unquote_wintcl {standard_quoted_cmdline} {
        #with reference to https://daviddeley.com/autohotkey/parameters/parameters.htm post2008 ms C/C++ commandline parameter parsing algorithm (section 5.10)
        set paramlist [list]
        set remainder $standard_quoted_cmdline
        set lastremlen [string length $standard_quoted_cmdline]
        #note 1st arg (program name) - anything up to first whitespace or anything within first 2 double-quotes encountered - so escaped doublequotes can't be part of first word.
        while {[string length $remainder]} {
            if {[llength $paramlist] == 0} {
                set pinfo [get_firstparam_wintcl $remainder]
            } else {
                set pinfo [get_nextparam_wintcl $remainder]
            }
            if {[dict get $pinfo status] ne "ok"} {
                puts stderr "paramlist so far: '$paramlist'"
                error "unquote_wintcl error [dict get $pinfo status]"
            }
            lappend paramlist [dict get $pinfo param]
            set remainder [dict get $pinfo remainder]
            set remainder [string trimleft $remainder " \t"]
            set remlen [string length $remainder]
            if {$remlen && ($remlen >= $lastremlen)} {
                #sanity check
                error "unquote_wintcl failed to progress in parsing cmdline $standard_quoted_cmdline - stuck with remainder $remlen"
            }
            set lastremlen $remlen
        }
        return $paramlist
    }

    #get 'program name' first word under different rules to subsequent arguments in the cmdline
    proc get_firstparam_wintcl {cmdline} {
        set in_doublequote_part 0
        set chars [split $cmdline ""]
        set chunklen [llength $chars]
        set n 0
        set p ""
        if {[lindex $chars 0] eq {"}} {
            set in_doublequote_part  1
        }  else {
            append p [lindex $chars 0]
        }
        incr n

        while {$n<$chunklen && ($in_doublequote_part || ([lindex $chars $n] ni [list " " \t]))} {
            if {[lindex $chars $n] eq {"}} {
                break
            }
            append p [lindex $chars $n]
            incr n
        }
        set rem [string range $cmdline $n+1 end]
        #puts "----p>$p<------r>$rem<-----"
        return [dict create status "ok" param $p remainder $rem]
    }

    #non first-word parsing.
    proc get_nextparam_wintcl {cmdline} {
        #post 2008 windows double-quote handling system.
        set chars [split $cmdline ""]
        set chunklen [llength $chars]
        set status "parsing"
        set p ""
        set in_doublequote_part 0
        #allow n to go 1 above highest index in $chars for this algorithm
        for {set n 0} {$n<=$chunklen} {incr n} {
            set copychar true
            set num_backslashes 0
            while {[lindex $chars $n] eq "\\"} {
                incr num_backslashes
                incr n
            }
            if {[lindex $chars $n] eq {"}} {
                if {$num_backslashes % 2 == 0} {
                    #even
                    if {$in_doublequote_part} {
                        if {[lindex $chars $n+1] eq {"}} {
                            incr n ;#move to second {"}
                        } else {
                            set copychar false 
                            set in_doublequote_part 0    
                        }
                    } else {
                        set copychar false
                        set in_doublequote_part 1
                    }
                }
                #whether odd or even, dividing by 2 does what we need
                set num_backslashes [expr {$num_backslashes / 2}]
            }
            append p [string repeat "\\" $num_backslashes]
            if {$n == $chunklen || (!$in_doublequote_part && [lindex $chars $n] in [list " " \t])} {
                set status "ok"
                break
            }
            if {$copychar} {
                append p [lindex $chars $n] 
            }
        }
        set rem [string range $cmdline $n+1 end]
        #puts "----p>$p<------r>$rem<-----"
        return [dict create status $status param $p remainder $rem]
    }

    proc runwin {args} {
        tw_run [quote_win {*}$args]
    }

    #an experiment - this is essentially an identity transform unless flags are set. - result afer cmd.exe processes escapes is the same as running raw with no quoting 
    #this follows the advice of 'don't let cmd see any double quotes unescaped' - but that's effectively a pretty useless strategy.
    #The -useprequoted and -usepreescaped flags are the only difference
    #these rely on the fact we can prepend a caret to each argument without affecting the resulting string - and use that as an indicator to treat specific input 'arguments' differently i.e by keeping existing escapes only.
    proc quote_cmd {args} {
        lassign [internal::get_run_opts $args] _r runopts _c cmdargs
        set use_prequoted  [expr {"-useprequoted" in $runopts}]
        set use_preescaped [expr {"-usepreescaped" in $runopts}]
        set verbose [expr {"-verbose" in $runopts}]
        #As this quoting scheme allows & > < etc to execute depending on quote state - it doesn't make sense to default to blocking %var% or !var! here.
        set disallowvars [expr {"-disallowvars" in $runopts}]

        if {![llength $cmdargs]} {
            return "Usage: quote_cmd ?runopt? ... ?--? ?cmd? ?cmdarg? ..."
        }
        foreach a $cmdargs {
            set copy [internal::objclone $a]
            append raw_cmdline "$copy "
            lappend tcl_list $copy
        }

        set cmdline ""
        set i 0
        set meta_chars [list {"} "(" ")" ^ < > & |] 
        #note that %var% and !var! work the same whether within a double quote section or not
        if {$disallowvars} {
            lappend meta_chars % !
        }

        #unbalanced quotes in %varname% will affect output - but aren't seen by this parser - which means they will only result in double escaping - not exiting escape mode. (this is good)
        #!varname! with delayed expansion (cmd.exe /v /c ...) seems to be safer as it doesn't appear to allow breakage of quoting
        set cmd_in_quotes 0
        #todo - transition of cmd_in_quotes from 0 -> 1 only is affected by number of carets preceding quote!
        foreach w $tcl_list {
            set qword ""
            set wordlen [string length $w]
            set nlast [expr {$wordlen -1}] 
            set chars [split $w ""] 
            set wordlen [string length $w]
            set nlast [expr {$wordlen -1}]

            if {$use_prequoted} {
                if {[string range $w 0 1] eq {^"}} {
                    #pass entire argument (less leading caret) through with existing quoting - no adjustment to cmd_in_quotes state.
                    append cmdline [string range $w 1 end] " "
                    continue
                }
            }
            if {$use_preescaped} {
                if {[string index $w 0] eq {^}} {
                    #pass entire argument (less leading caret) through with existing quoting - no adjustment to cmd_in_quotes state.
                    append cmdline [string range $w 1 end] " "
                    continue
                }
            }


            for {set n 0} {$n<$wordlen} {incr n} {
                set char [lindex $chars $n]
                set num_carets 0
                while {$char eq "^" && $n<$nlast} {
                    incr num_carets
                    incr n
                    set char [lindex $chars $n]
                }

                if {$char eq {"}} {
                    if {$cmd_in_quotes} {
                        append qword [string repeat "^" [expr {$num_carets *2 + 1}]] {"}
                        set cmd_in_quotes [expr {!$cmd_in_quotes}]
                    } else {
                        #cmd.exe echo behaviour:
                        # ^"    -> "
                        # ^^"   -> ^"
                        # ^^^"  -> ^"
                        # ^^^^" -> ^^"
                        if {$num_carets % 2} {
                            set cmd_in_quotes 0 ;#odd number of preceding carets make this dquote a literal stay out of quotes mode
                            append qword [string repeat "^" [expr {$num_carets}]] {"} ;#
                        } else {
                            set cmd_in_quotes 1; #carets all refer to each other - quote is uncareted.
                            append qword [string repeat "^" [expr {$num_carets + 1}]] {"} ;#
                        }
                    }
                    #set cmd_in_quotes [expr {!$cmd_in_quotes}]
                } else {
                    if {$cmd_in_quotes} {
                        if {$char in $meta_chars} {
                            append qword [string repeat "^" [expr {$num_carets *2 + 1}]] $char ;#
                        } else {
                            append qword [string repeat "^" [expr {$num_carets *2}]] $char ;#
                        }
                    } else {
                        if {$char in $meta_chars} {
                            append qword [string repeat "^" [expr {$num_carets}]] $char
                        } else {
                            append qword [string repeat "^" [expr {$num_carets}]] $char
                        }
                    }
                }
            }

            append cmdline $qword " "
            incr i
        }
        set cmdline [string range $cmdline 0 end-1]
        if {$verbose} {
            puts stdout --cmdline->$cmdline
        }
        return $cmdline
    }

    #This does essentially what Sebres has implemented for Tcl's exec already - pass through that works for non builtins that are run via cmd.exe and require standard argv parsing
    #
    #tracked blocking of vars.  After winquoting, when in quotes;prefix % with (unslashed) quote.  When outside quotes - prefix with ^
    #(always using unslashed quotes considered - seems more likely to cause problems with the argv parsing)
    # ! can't be blocked with carets ... always use quotes
    #other cmd specials - block only outside of quotes
    #existing carets?
    #note that cmd.exe's /v flag changes the way carets go through - we need twice as many ^ when /v in place e.g x^^^^y to get x^y vs x^^y to get x^y when /v not present  - review - can we sensibly detect /v?
    #don't caret quotes.
    proc quote_cmdpassthru {args} {
        lassign [internal::get_run_opts $args] _r runopts _c cmdargs
        set allowvars   [expr {"-allowvars" in $runopts}]
        set verbose     [expr {"-verbose" in $runopts}]
        #review - may need to force quoting of barewords by quote_win to ensure proper behaviour if bareword contains cmd specials?
        #?always treatable as a list? review
        set tcl_list [lmap v $cmdargs {internal::objclone $v}]
        set meta_chars [list {<} {>} & |] ;#caret-quote when outside of cmd.exe's idea of a quoted section - carets will disappear from passed on string
        set cmdline ""
        set in_quotes 0
        foreach w $tcl_list {
            set winquoted [quote_win x $w] ;#pass bogus app-name as first word - as first word subject to different rules
            set chars [split [string range $winquoted 2 end] ""]  ;# strip bogus before splitting
            set had_quotes 0
            if {{"} in $chars} {
                set had_quotes 1
            }
            set wordlen [llength $chars]
            #set nlast [expr {$wordlen -1}]
            set qword ""
            for {set n 0} {$n<$wordlen} {incr n} {
                set num_slashes 0
                if {[lindex $chars $n] eq {"}} {
                    set in_quotes [expr {!$in_quotes}]
                    append qword {"}
                } elseif {[lindex $chars $n] in [list "%"]} {
                    if {$allowvars} {
                        set tail [lrange $chars $n+1 end]
                        #??
                    }
                    #if %var% was in original string - a variable named %"var"% can be substituted after we have done our quoting.
                    #no matter what quoting scheme we use - there will be a corresponding string between %'s that can in theory be exploited if 
                    if {$in_quotes} {
                        #note that the *intended* quoting will be opposite to the resultant quoting from wrapping with quote_win
                        #therefore, counterintuitively we can  enable the var when in_quotes is true here, and &cmd won't run.
                        #double quotes in the var don't seem to cause cmd.exe to change it's concept of in_quotes so &cmd also won't run
                        #However.. backspace can can break quoting.   e.g   \b&cmd  
                        if {$allowvars} {
                           append qword [lindex $chars $n] 
                        } else {
                            append qword {"} [lindex $chars $n] {"} ;#add in pairs so we don't disturb structure for argv
                        }
                    } else {
                        #allow vars here is also dangerous we need to lookahead and scan the value and quote accordingly
                        if {$allowvars} {

                            append qword [lindex $chars $n]
                        } else {
                            append qword {^} [lindex $chars $n]
                        }
                    }
                } elseif {[lindex $chars $n] eq "!"} {
                    if {$allowvars} {
                        append qword "!"
                    } else {
                        append qword {"} {!} {"}
                    }
                } elseif {[lindex $chars $n] eq "^"} {
                    if {$in_quotes} {
                        append qword {"^^"} ;#add quotes in pairs so we don't disturb structure for argv
                    } else {
                        append qword {^^} 
                    }
                } else {
                    if {[lindex $chars $n] in $meta_chars} {
                        if {$in_quotes} {
                            append qword [lindex $chars $n]
                        } else {
                            append qword "^" [lindex $chars $n]
                        }
                    } else {
                        append qword [lindex $chars $n]
                    }
                }
            }
            append cmdline $qword " "
            
        }
        set cmdline [string range $cmdline 0 end-1]
        if {$verbose} {
            puts stdout --cmdline->$cmdline
        }
        return $cmdline
    }
    # - This approach with repeated double quotes gives inconsistent behaviour between twapi CommandLineToArgvW and tclsh  - 
    #prepare arguments that are given to cmd.exe such that they will be passed through to an executable that uses standard windows commandline parsing such as CommandLineToArgvW
    #for each arg:
    #double up any backslashes that precede double quotes, double up existing double quotes - then wrap in a single set of double quotes if argument had any quotes in it.
    #This doesn't use \" or ^ style escaping - but the 2008+ argv processing on windows supposedly does what we want with doubled-up quotes and slashes, and cmd.exe passes them through
    #In practice - it seems less consistent/reliable 
    proc quote_cmdpassthru_test {args} {
        lassign [internal::get_run_opts $args] _r runopts _c cmdargs
        set allowvars   [expr {"-allowvars" in $runopts}]
        set verbose     [expr {"-verbose" in $runopts}]

        set tcl_list [lmap v $cmdargs {internal::objclone $v}]
        set meta_chars [list {"} "(" ")" ^ < > & |] 
        if {!$allowvars} {
            lappend meta_chars % !
        }
        set cmdline ""
        foreach w $tcl_list {
            set chars [split $w ""] 
            set wordlen [llength $chars]
            #set nlast [expr {$wordlen -1}]
            set qword ""
            for {set n 0} {$n<$wordlen} {incr n} {
                set num_slashes 0
                while {[lindex $chars $n] eq "\\" && $n<$wordlen} {
                    incr num_slashes 
                    incr n
                }
                if {[lindex $chars $n] eq {"}} {
                    append qword [string repeat "\\" [expr {$num_slashes *2}]] {""} ;#double up both
                } else {
                    #don't double up slashes if not followed by dquote
                    append qword [string repeat "\\" $num_slashes] [lindex $chars $n]
                }
            }
            if {[string first {"} $qword] >=0} {
                append cmdline {"} $qword {"} " "
            } else {
                append cmdline $qword " "
            }
        }
        set cmdline [string range $cmdline 0 end-1]
        if {$verbose} {
            puts stdout --cmdline->$cmdline
        }
        return $cmdline
    }

    #caret quoting of all meta_chars 
    proc quote_cmdblock {args} {
        lassign [internal::get_run_opts $args] _r runopts _c cmdargs
        set allowvars   [expr {"-allowvars" in $runopts}]
        set allowquotes [expr {"-allowquotes" in $runopts}]
        set verbose     [expr {"-verbose" in $runopts}]
        set tcl_list [lmap v $cmdargs {internal::objclone $v}]
        set cmdline ""
        set i 0
        set meta_chars [list "(" ")" ^ < > & |] 
        if {!$allowvars} {
            lappend meta_chars % !
        }
        if {!$allowquotes} {
            lappend meta_chars {"}
        }
        foreach w $tcl_list {
            set wordlen [string length $w]
            set nlast [expr {$wordlen -1}] 
            set chars [split $w ""] 
            foreach char $chars {
                if {$char in $meta_chars} {
                    append cmdline "^$char"
                } else {
                    append cmdline $char
                }
            }
            append cmdline " "
            incr i
        }
        set cmdline [string range $cmdline 0 end-1]
        if {$verbose} {
            puts stdout --cmdline->$cmdline
        }
        return $cmdline
    }

    proc quote_cmd2 {args} {
        set cmdargs $args
        set tcl_list [lmap v $cmdargs {internal::objclone $v}]

        set cmdline ""
        set i 0
        set meta_chars [list {"} "(" ")" ^ < > & |] ;#deliberately don't include % - it should work quoted or not.
        #unbalanced quotes in %varname% will affect output - but aren't seen by this parser - which means they will only result in double escaping - not exiting escape mode. (this is good)
        set cmd_in_quotes 0
        foreach w $tcl_list {
            set wordlen [string length $w]
            set nlast [expr {$wordlen -1}] 
            set chars [split $w ""] 
            foreach char $chars {
                if {$char eq {"}} {
                    append cmdline {^"}
                    set cmd_in_quotes [expr {!$cmd_in_quotes}]
                } else {
                    if {$cmd_in_quotes} {
                        if {$char in $meta_chars} {
                            append cmdline "^$char"
                        } else {
                            append cmdline $char
                        }
                    } else {
                        append cmdline $char
                    }
                }
            }
            append cmdline " "
            incr i
        }
        set cmdline [string range $cmdline 0 end-1]
        puts stdout --cmdline->$cmdline
        return $cmdline
    }

    proc runcmd {args} {
        set cmdline [quote_cmd {*}$args]
        tw_run $cmdline
    }
    proc runcmdpassthru {args} {
        set cmdline [quote_cmdpassthru {*}$args]
        tw_run $cmdline
    }
    proc runcmdblock {args} {
        set cmdline [quote_cmdblock {*}$args]
        tw_run $cmdline
    }


    #round-trip test
    #use standard(!) win arg quoting first - then deconstruct using the win32 api, and the tcl implementation 
    proc testrawline {rawcmdline} {
        puts "input string                              : $rawcmdline"
        set win_argv    [unquote_win $rawcmdline]
        puts "unquote_win CommandLineToArgvW            : $win_argv"
        set wintcl_argv [unquote_wintcl $rawcmdline]
        puts "unquote_wintcl                            : $wintcl_argv"
        return $win_argv
    }
    proc testlineargs {args} {
        puts "input list                                : $args"
        puts "                          argument count  : [llength $args]"
        puts "input string                              : [join $args " "]"
        puts [string repeat - 20]
        set standard_escape_line [quote_win {*}$args]
        set argv_from_win32 [unquote_win $standard_escape_line]
        puts "quote_win win                             : $standard_escape_line"
        puts "unquote_win CommandLineToArgvW            : $argv_from_win32"
        puts "                          argument count  : [llength $argv_from_win32]"
        #so far - gives same output as windows api - this may vary by os version?
        #set argv_from_wintcl [unquote_wintcl $standard_escape_line]
        #puts "unquote_wintcl tcl implementation : $argv_from_win32"
        puts [string repeat - 20]

        puts "quote_cmd cmd.exe style quoting           : [quote_cmd {*}$args]"
        puts [string repeat - 20]

        set cline_blocked [quote_cmdblock {*}$args]
        set cline_blocked_argv [unquote_win $cline_blocked]
        puts "quote_cmdblock cmd.exe protect            : $cline_blocked"
        puts "unquote_win CommandLineToArgvW            : $cline_blocked_argv"
        puts "                          argument count  : [llength $cline_blocked_argv]"
        puts [string repeat - 20]

        set cline_passthru  [quote_cmdpassthru {*}$args]
        set cline_passthru_argv [unquote_win $cline_passthru]
        puts "quote_cmdpassthru to argv parser          : $cline_passthru"
        puts "unquote_win CommandLineToArgvW            : $cline_passthru_argv"
        puts "                          argument count  : [llength $cline_passthru_argv]"
        puts [string repeat - 20]

        #if {[file exists [file dirname [info nameofexecutable]]/../scriptlib/showargs.tcl]} {
        #    runraw tclsh showargs.tcl {*}$cline_blocked
        #}
        return $argv_from_win32
    }

    proc import {pattern {ns ""}} {
        set pattern ::punk::winrun::$pattern
        if {$ns eq ""} {
            set ns [uplevel 1 {namespace current}]
        }
        internal::nsimport_noclobber $pattern $ns
    }

    namespace eval internal {
        # -- --- ---
        #get a copy of the item without affecting internal rep
        #this isn't critical for most usecases - but can be of use for example when trying not to shimmer path objects to strings (filesystem performance impact in some cases)
        proc objclone {obj} {
            append obj2 $obj {}
        }
        # -- --- ---

        #get_run_opts - allow completely arbitrary commandline following controlling flags - with no collision issues if end-of-opts flag "--" is used.
        #singleton flags allowed preceding commandline. (no support for option-value pairs in the controlling flags)
        #This precludes use of executable beginning with a dash unless -- provided as first argument or with only known run-opts preceding it. 
        #This should allow any first word for commandlist even -- itself if a protective -- provided at end of any arguments intended to control the function.
        proc get_run_opts {arglist} {
            if {[catch {
                set callerinfo [info level -1]
            } errM]} {
                set caller ""
            } else {
                set caller [lindex $callerinfo 0]
            }

            #we provide -nonewline even for 'run' even though run doesn't deliver stderr or stdout to the tcl return value
            set options [list "-allowvars" "-allowquotes" "-disallowvars" "-useprequoted" "-usepreescaped" "-quiet" "-verbose" "-verbose2" "-echo" "-nonewline"]
            set aliases [dict create\
                -av -allowvars\
                -dv -disallowvars\
                -aq -allowquotes\
                -up -useprequoted\
                -ue -usepreescaped\
                -q  -quiet\
                -v  -verbose\
                -vv -verbose2\
                -e  -echo\
                -n  -nonewline\
            ]
            #build alias dict mapping shortnames to longnames - longnames to self
            set alias_dict $aliases
            foreach o $options {
                dict set alias_dict $o $o
            }
            set known_runopts [dict keys $alias_dict]
            set runopts [list]
            set cmdargs [list]

            set first_eopt_posn [lsearch $arglist --]
            if {$first_eopt_posn >=0} {
                set pre_eopts [lrange $arglist 0 $first_eopt_posn-1]
                set is_eopt_for_runopts 1 ;#default assumption that it is for this function rather than part of user's commandline - cycle through previous args to disprove.
                foreach pre $pre_eopts {
                    if {$pre ni $known_runopts} {
                        set is_eopt_for_runopts 0; #the first -- isn't for us.
                    }
                }
            } else {
                set is_eopt_for_runopts 0
            }
            #split on first -- if only known opts preceding (or nothing preceeding) - otherwise split on first arg that doesn't look like an option and bomb if unrecognised flags before it.
            if {$is_eopt_for_runopts} {
                set idx_first_cmdarg [expr $first_eopt_posn + 1]
                set runopts [lrange $arglist 0 $idx_first_cmdarg-2] ;#exclude -- from runopts - it's just a separator.
            } else {
                set idx_first_cmdarg [lsearch -not $arglist "-*"]
                set runopts [lrange $arglist 0 $idx_first_cmdarg-1]
            }
            set cmdargs [lrange $arglist $idx_first_cmdarg end]
            foreach o $runopts {
                if {$o ni $known_runopts} {
                    error "$caller: Unknown runoption $o - known options $known_runopts"
                }
            }
            set runopts [lmap o $runopts {dict get $alias_dict $o}]
            if {"-allowvars" in $runopts && "-disallowvars" in $runopts} {
                puts stderr "Warning - conflicting options -allowvars & -disallowvars specified: $arglist"
            }

            #maintain order: runopts $runopts cmdargs $cmdargs as first 4 args (don't break 'lassign [get_runopts $args] _ runopts _ cmdargs')
            #todo - add new keys after these indicating type of commandline etc.
            return [list runopts $runopts cmdargs $cmdargs]
        }

        #maintenance: home is punk::ns package
        proc nsimport_noclobber {pattern {ns ""}} {
            set source_ns [namespace qualifiers $pattern]
            if {![namespace exists $source_ns]} {
                error "nsimport_noclobber error namespace $source_ns not found"
            }
            if {$ns eq ""} {
                set ns [uplevel 1 {namespace current}]
            } elseif {![string match ::* $ns]} {
                set nscaller [uplevel 1 {namespace current}]
                set ns [punk::nsjoin $nscaller $ns]
            }
            set a_export_patterns [namespace eval $source_ns {namespace export}] 
            set a_commands [info commands $pattern]
            set a_tails [lmap v $a_commands {namespace tail $v}]
            set a_exported_tails [list]
            foreach pattern $a_export_patterns {
                set matches [lsearch -all -inline $a_tails $pattern]
                foreach m $matches {
                    if {$m ni $a_exported_tails} {
                        lappend a_exported_tails $m
                    }
                }
            }
            set imported_commands [list]
            foreach e $a_exported_tails {
                set imported [namespace eval $ns [string map [list <func> $e <a> $source_ns] {
                    set cmd ""
                    if {![catch {namespace import <a>::<func>}]} {
                        set cmd <func>
                    }
                    set cmd
                }]]
                if {[string length $imported]} {
                    lappend imported_commands $imported
                }
            }
            return $imported_commands
        }
    } ;# end ns internal
    #comment out for manual import
    import * ::
}









# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide punk::winrun [namespace eval punk::winrun {
    variable version
    set version 999999.0a1.0 
}]
return