#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
append text \n "Tcl build-info: [::tcl::build-info]"
}
if {[punk::lib::check::has_tclbug_script_var]} {
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)"
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)"
}
}
@ -7888,10 +8023,10 @@ namespace eval punk {
append warningblock "${indent}lists elements not properly quoted in some cases. e.g 'list {*}[lindex {etc #foo} 1] {*}[list]' (#foo not braced)" \n
append warningblock "${indent}lists elements not properly quoted in some cases. e.g 'list {*}[lindex {etc #foo} 1] {*}[list]' (#foo not braced)" \n
append out "[a+ {*}$fc web-white]Combination testing[a]" \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 "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 "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 "so a final MERGED row displays with an alert 'REDUNDANCIES FOUND'."] \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 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
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 {
switch -- $opt_syntax {
tcl {
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 →
#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(?)
#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] ;#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 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)
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?)
#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
#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 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
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
#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]} {
} errM]} {
} else {
} else {
puts stderr "Warning: Failed to determine base for unix-like paths - using default of c:/msys2"
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
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
#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)
#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!
#Todo - make int-rep tests to check stability of these behaviours across Tcl versions!
#\\servername\share etc or \\?\UNC\servername\share etc.
#\\servername\share etc or \\?\UNC\servername\share etc.
proc is_unc_path {path} {
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)
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} {
if {[string first "//" $strcopy_path] == 0} {
#check for "Dos device path" syntax
#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
#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)
#(can exist on server shares and on NTFS - but standard apps can't access without dos device syntax)
proc is_dos_device_path {path} {
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)
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 {//?/ //./}} {
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?
#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
#?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 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 cmdline ""
set in_quotes 0
set in_quotes 0
@ -721,7 +721,7 @@ namespace eval punk::winrun {
set allowvars [expr {"-allowvars" in $runopts}]
set allowvars [expr {"-allowvars" in $runopts}]
set verbose [expr {"-verbose" 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 {"} "(" ")" ^ < > & |]
set meta_chars [list {"} "(" ")" ^ < > & |]
if {!$allowvars} {
if {!$allowvars} {
lappend meta_chars % !
lappend meta_chars % !
@ -764,7 +764,7 @@ namespace eval punk::winrun {
set allowvars [expr {"-allowvars" in $runopts}]
set allowvars [expr {"-allowvars" in $runopts}]
set allowquotes [expr {"-allowquotes" in $runopts}]
set allowquotes [expr {"-allowquotes" in $runopts}]
set verbose [expr {"-verbose" 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 cmdline ""
set i 0
set i 0
set meta_chars [list "(" ")" ^ < > & |]
set meta_chars [list "(" ")" ^ < > & |]
@ -797,7 +797,7 @@ namespace eval punk::winrun {
proc quote_cmd2 {args} {
proc quote_cmd2 {args} {
set cmdargs $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 cmdline ""
set i 0
set i 0
@ -906,7 +906,7 @@ namespace eval punk::winrun {
# -- --- ---
# -- --- ---
#get a copy of the item without affecting internal rep
#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)
#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)
