#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
append warningblock \n "minor warning: punk::lib::check::has_tclbug_script_var returned true! (string rep for list variable in script generated when script changed)"
}
if {[punk::lib::check::has_tclbug_safeinterp_compile]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_safeinterp returned true!" \n
append warningblock "${indent}(ensemble commands not compiled in safe interps - heavy performance impact in safe interps)" \n
append text \n "Tcl build-info: [::tcl::build-info]"
}
if {[punk::lib::check::has_tclbug_script_var]} {
append warningblock \n "minor warning: punk::lib::check::has_tclbug_script_var returned true! (string rep for list variable in script generated when script changed)"
}
if {[punk::lib::check::has_tclbug_safeinterp_compile]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
set t [textblock::class::table new -show_hseps 0 -show_header 1 -ansiborder_header [a+ web-green]]
if {"windows" eq $::tcl_platform(platform)} {
#If any env vars have been set to empty string - this is considered a deletion of the variable on windows.
#The Tcl ::env array is linked to the underlying process view of the environment
#- but info exists ::env(var) can misreport as true if it has been deleted by setting to empty string rather than using unset.
#an 'array get' will resynchronise.
#Even if an env variable didn't exist before - setting it to empty string can get it to this inconsistent state.
array get ::env
}
#do an array read on ::env
foreach {v vinfo} $punkenv_config {
if {[info exists ::env($v)]} {
set c2 [set ::env($v)]
} else {
set c2 "(NOT SET)"
}
set help ""
if {[dict exists $vinfo help]} {
set help [dict get $vinfo help]
if {[catch {lsearch -stride 2 {a b} b}]} {
set indent " "
append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n
append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n
append warningblock [a]
} else {
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append out "[a+ {*}$fc web-white]Combination testing[a]" \n
append out [textblock::join -- $indent "Example: a? red brightgreen underline Tk-slategrey italic"] \n
append out [textblock::join -- $indent "This will show a small table of each applied code and a RESULT row. The 'red' in this case is redundant,"] \n
append out [textblock::join -- $indent "so a final MERGED row displays with an alert 'REDUNDANCIES FOUND'."] \n
append out [textblock::join -- $indent "This will show a small table of each applied code and a RESULT row. The 'red' in this case is redundant, because there are"] \n
append out [textblock::join -- $indent "two foreground colours (lowercase first letter) so a final MERGED row displays with an alert 'REDUNDANCIES FOUND'."] \n
append out [textblock::join -- $indent "The final columns of RESULT and MERGED (showing raw ANSI sequence) will differ if the arguments aren't in canonical order."] \n
append out [textblock::join -- $indent "The MERGED line will only display if there are redundancies or different ordering."] \n
#rudimentary colourising (not full tcl syntax parsing)
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
switch -- $opt_syntax {
tcl {
#rudimentary colourising (not full tcl syntax parsing)
#Note that this can highlight ;# in some places as a comment where it's not appropriate
# e.g inside a regexp
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
#result lines often indicated in examples by \u2192 →
#however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str]
set argdefcache_unresolved [tcl::dict::create] ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params)
#lsearch -stride not avail (or buggy) in some 8.6 interps - search manually for now (2025). todo - modernize some time after Tcl 9.0/9.1 more widespread.(2027?)
#check for and report if id is present multiple times
"If newstate is specified, the window will be set to the new state, otherwise it returns the current state of window:
either ${$B}normal${$N}, ${$B}iconic${$N}, ${$B}withdrawn${$N}, ${$B}icon${$N}, or (Windows and macOS only) ${$B}zoomed${$N}. The difference between ${$B}iconic${$N} and ${$B}icon${$N} is
that ${$B}iconic${$N} refers to a window that has been iconified (e.g., with the wm iconify command) while ${$B}icon${$N} refers to a
window whose only purpose is to serve as the icon for some other window (via the ${$B}wm iconwindow${$N} command).
set result [exec cygpath -m /] ;# -m gives result with forward-slashes - which is ok for windows paths in a Tcl context.
set cachedunixyroot [punk::objclone $result]
set cachedunixyroot [punk::valcopy $result]
file pathtype $cachedunixyroot; #this call causes the int-rep to be path
#set ::punk::last_run_display [list] ;#hack - review shouldn't really be necessary.. but because we call winpath from ./ - the repl looks for last_run_display
} errM]} {
} else {
puts stderr "Warning: Failed to determine base for unix-like paths - using default of c:/msys2"
set path [punk::objclone $unixypath] ;#take another copy that we can deliberatley shimmer to path and know is separate to the supplied argument
set path [punk::valcopy $unixypath] ;#take another copy that we can deliberatley shimmer to path and know is separate to the supplied argument
set supplied_pathtype [file pathtype $path] ;#we don't care about the pathtype so much as the act of making this call shimmers to a path internal-rep
#copy of var that we can treat as a string without affecting path rep
#Note that some but not all read operations will lose path rep e.g 'string length $x' will lose any path-rep $x had, (but 'string equal $x something' won't)
#Todo - make int-rep tests to check stability of these behaviours across Tcl versions!
#\\servername\share etc or \\?\UNC\servername\share etc.
proc is_unc_path {path} {
set strcopy_path [punk::winpath::system::objclone $path]
set strcopy_path [punk::winpath::system::valcopy $path]
set strcopy_path [string map {\\ /} $strcopy_path] ;#normalize to forward slashes for testing purposes (and forward slashes seem to be auto-translated by windows anyway)
if {[string first "//" $strcopy_path] == 0} {
#check for "Dos device path" syntax
@ -77,7 +77,7 @@ namespace eval punk::winpath {
#dos device path syntax allows windows api to acces extended-length paths and filenames with illegal path characters such as trailing dots or whitespace
#(can exist on server shares and on NTFS - but standard apps can't access without dos device syntax)
proc is_dos_device_path {path} {
set strcopy_path [punk::winpath::system::objclone $path]
set strcopy_path [punk::winpath::system::valcopy $path]
set strcopy_path [string map {\\ /} $strcopy_path] ;#normalize to forward slashes for testing purposes (and forward slashes seem to be auto-translated by windows anyway)
if {[string range $strcopy_path 0 3] in {//?/ //./}} {
#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 tcl_list [lmap v $cmdargs {internal::valcopy $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
@ -721,7 +721,7 @@ namespace eval punk::winrun {
set allowvars [expr {"-allowvars" in $runopts}]
set verbose [expr {"-verbose" in $runopts}]
set tcl_list [lmap v $cmdargs {internal::objclone $v}]
set tcl_list [lmap v $cmdargs {internal::valcopy $v}]
set meta_chars [list {"} "(" ")" ^ < > & |]
if {!$allowvars} {
lappend meta_chars % !
@ -764,7 +764,7 @@ namespace eval punk::winrun {
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 tcl_list [lmap v $cmdargs {internal::valcopy $v}]
set cmdline ""
set i 0
set meta_chars [list "(" ")" ^ < > & |]
@ -797,7 +797,7 @@ namespace eval punk::winrun {
proc quote_cmd2 {args} {
set cmdargs $args
set tcl_list [lmap v $cmdargs {internal::objclone $v}]
set tcl_list [lmap v $cmdargs {internal::valcopy $v}]
set cmdline ""
set i 0
@ -906,7 +906,7 @@ namespace eval punk::winrun {
# -- --- ---
#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)
