if {[string length $ns] && ![namespace exists $ns]} {
error "unknown_assign_dispatch: namespace '$ns' not found. (Note that pipeline lhs variables cannot be namespaced)"
} else {
set nscaller [uplevel 1 [list ::namespace current]]
set nscaller [uplevel 1 [list ::tcl::namespace::current]]
#jmn
set rhsmapped [punk::pipe::lib::pipecmd_namemapping $equalsrhs]
set commands [uplevel 1 [list ::info commands $pattern=$rhsmapped]] ;#uplevel - or else we are checking from perspective of this namespace ::punk
set commands [uplevel 1 [list ::tcl::info::commands $pattern=$rhsmapped]] ;#uplevel - or else we are checking from perspective of this namespace ::punk
#we must check for exact match of the command in the list - because command could have glob chars.
#pipe initiator which will never raise an error *except for pipesyntax* , but always returns {ok {result something}} or {error {mismatch something}} or, for tcl errors {error {reason something}}
set chunks [uplevel 1 [list ::punk::help_chunks {*}$args]]
foreach chunk $chunks {
lassign $chunk chan text
puts -nonewline $chan $text
}
puts -nonewline stdout \n
}
#return list of {chan chunk} elements
namespace eval argdoc {
punk::args::define {
@id -id ::punk::help_chunks
@ -7838,14 +7474,6 @@ namespace eval punk {
arg -type any -optional 1 -multiple 1
}
}
proc help {args} {
set chunks [uplevel 1 [list ::punk::help_chunks {*}$args]]
foreach chunk $chunks {
lassign $chunk chan text
puts -nonewline $chan $text
}
}
#return list of {chan chunk} elements
proc help_chunks {args} {
set argd [punk::args::parse $args withid ::punk::help_chunks]
lassign [dict values $argd] leaders opts values received
@ -7877,7 +7505,7 @@ namespace eval punk {
}
set title "[a+ brightgreen] Help System: "
set cmdinfo [list]
lappend cmdinfo [list help "?${I}topic${NI}?" "This help.\nTo see available subitems type:\nhelp topics\n\n\n\n\n"]
lappend cmdinfo [list help "?${I}topic${NI}?" "This help.\nTo see available subitems type:\nhelp topics\n\nFor an unrecognised ${I}topic${NI}\nhelp will look for basic\ninfo for it as a command.\n"]
set t [textblock::class::table new -minwidth 51 -show_seps 0]
foreach row $cmdinfo {
$t add_row $row
@ -7993,35 +7621,40 @@ namespace eval punk {
catch {
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]} {
#generate warningblocks for each triggered Tcl bug in namespace ::punk::lib::check
set bugcheck_procs [info procs ::punk::lib::check::has_tclbug*]
#has_tclbug_lsearch_strideallinline will have reported bug false because it couldn't test it.
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
#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 str [punk::ansi::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::ansi::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str]
#Note that if we were to highlight based on the regexp {\{|\}} then the inserted ansi would come between
# the backslash and brace in \{ or \} - this breaks the syntactic structure causing problems.
set str [punk::grepstr -return all -highlight {Term-grey tk-darkblue} {^\{|[^\\](\{+)} $str]
set str [punk::grepstr -return all -highlight {Term-grey tk-darkblue} {[^\\](\}+)} $str]
set str [punk::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str]
set str [punk::ansi::grepstr -return all -highlight {Term-grey tk-darkblue} {^\{|[^\\](\{+)} $str]
set str [punk::ansi::grepstr -return all -highlight {Term-grey tk-darkblue} {[^\\](\}+)} $str]
set str [punk::ansi::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
}
}
set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"]
set result [textblock::bookend_lines $str [punk::ansi::a] "[punk::ansi::a defaultbg] [punk::ansi::a]"]
#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
set argdata_records [list]
dict for {k v} $rawdef_cache_argdata {
if {[dict get $v id] eq $id} {
if {$k eq $rawdef} {
lappend argdata_records [list 1 $k $v]
} else {
lappend argdata_records [list 0 $k $v]
}
}
}
append result \n "argdata cache:"
if {![llength $argdata_records]} {
append result \n "(not present)"
} else {
append result \n "present [llength $argdata_records] time(s)"
foreach r $argdata_records {
lassign $r match k v
if {$match} {
append result \n " - present with same rawdef key"
} else {
append result \n " - present with different rawdef key"
append result \n " [punk::lib::indent $k { }]"
}
}
if {[llength $argdata_records] > 1} {
append result \n "*more than one record was not expected - review*"
#string is dict only 8.7/9+ - use wrapper to support 8.6 also
if {![punk::args::lib::string_is_dict $specval]} {
error "punk::args::resolve - invalid value for key '$spec' in specifications for argument '$argname' - value must be a dictionary @id:$DEF_definition_id"
#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
set argdata_records [list]
dict for {k v} $rawdef_cache_argdata {
if {[dict get $v id] eq $id} {
if {$k eq $rawdef} {
lappend argdata_records [list 1 $k $v]
} else {
lappend argdata_records [list 0 $k $v]
}
}
}
append result \n "argdata cache:"
if {![llength $argdata_records]} {
append result \n "(not present)"
} else {
append result \n "present [llength $argdata_records] time(s)"
foreach r $argdata_records {
lassign $r match k v
if {$match} {
append result \n " - present with same rawdef key"
} else {
append result \n " - present with different rawdef key"
append result \n " [punk::lib::indent $k { }]"
}
}
if {[llength $argdata_records] > 1} {
append result \n "*more than one record was not expected - review*"
#if prefixes allowed, first see if c_check is an ambiguous prefix
#This is preferable to listing all (possibly many) choices in the error message.
if {$choiceprefix} {
set prefixmsg " (or a unique prefix of a value)"
#review - case
if {$nocase} {
set longermatches [lsearch -all -inline -nocase $allchoices "$c_check*"]
} else {
set longermatches [lsearch -all -inline $allchoices "$c_check*"]
}
if {[llength $longermatches]} {
set msg "$argclass '$argname' for %caller% seems to be an ambiguous prefix. Try one of:\n [join $longermatches "\n "]\n$casemsg$prefixmsg. Received: '$c_check'"
#punk::console namespace - contains *directly* acting functions - some based on ansi escapes from the 'ansi' sub namespace, some on local system calls or executable calls wrapped in the 'local' sub namespace
#directly acting means they write to stdout to cause the console to peform the action, or they perform the action immediately via other means.
#directly acting means they write to stdout to cause the console to perform the action, or they perform the action immediately via other means.
#punk::console::ansi contains a subset of punk::ansi, but with emission to stdout as opposed to simply returning the ansi sequence.
#punk::console::local functions are used by punk::console commands when there is no ansi equivalent
#ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console
@ -602,7 +602,9 @@ namespace eval punk::console {
}
namespace eval internal {
proc abort_if_loop {{failmsg ""}} {
#obsolete
#puts "il1 [info level 1]"
#puts "thisproc: [lindex [info level 0] 0]"
set would_loop [uplevel 1 {expr {[string match *loopavoidancetoken* [info body [namespace tail [lindex [info level 0] 0]]]]}}]
#[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data.
#[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes.
chan configure $fd -translation binary -encoding $opt_translation;#should use translation binary to get actual line-endings - but we allow caller to override
#Always read encoding in binary - check for bom below and/or apply chosen opt_encoding
#lindex_resolve_basic returns only -1 if out of range
#lindex_resolve_basic returns only -Inf if out of range at either bound
#if we didn't do this check - we could raise an error on second lset below - leaving list corrupted because only one lset occurred
#(e.g using: lswap mylist end-2 end on a two element list)
#on the unhapy path we can take time to check the nature of the out-of-boundness to give a nicer report
#use full 'lindex_resolve' which can report which side via -3 and -2 special results being lower and upper bound breaches respectively (-1 never returned)
#use full 'lindex_resolve' which can report which side via -Inf and Inf special results being lower and upper bound breaches respectively
set a_index [lindex_resolve $len $a]
set a_msg ""
switch -- $a_index {
-2 {
set a_msg "1st supplied index $a is above the upper bound for the list ([llength $l])"
}
-3 {
-Inf {
set a_msg "1st supplied index $a is below the lower bound for the list (0)"
}
Inf {
set a_msg "1st supplied index $a is above the upper bound for the list ([llength $l])"
}
}
set z_index [lindex_resolve $len $z]
set z_msg ""
switch -- $z_index {
-2 {
set z_msg "2nd supplied index $z is above the upper bound for the list ([llength $l])"
}
-3 {
-Inf {
set z_msg "2nd supplied index $z is below the lower bound for the list (0)"
}
Inf {
set z_msg "2nd supplied index $z is above the upper bound for the list ([llength $l])"
}
}
set errmsg "lswap cannot swap indices $a and $z"
if {$a_msg ne ""} {
@ -981,7 +1020,7 @@ namespace eval punk::lib {
return $zip_l
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
#[para]Resolve an index which may be of the forms accepted by Tcl list commands such as end-2 or 2+2 to the actual integer index for the supplied list/string length
@ -2406,8 +2739,8 @@ namespace eval punk::lib {
#[para]Sometimes the actual integer index is desired.
#[para]We want to resolve the index used, without passing arbitrary expressions into the 'expr' function - which could have security risks.
#[para]lindex_resolve will parse the index expression and return:
#[para] a) -3 if the supplied index expression is below the lower bound for the supplied list. (< 0)
#[para] b) -2 if the supplied index expression is above the upper bound for the supplied list. (> end)
#[para] a) -Inf if the supplied index expression is below the lower bound for the supplied list. (< 0)
#[para] b) Inf if the supplied index expression is above the upper bound for the supplied list. (> end)
#[para] We don't return -1 - as the similar function lindex_resolve_basic uses this to denote out of range at either end of the list/string
#[para]Otherwise it will return an integer corresponding to the position in the list.
#[para]This is in stark contrast to Tcl list function indices which will return empty strings for out of bounds indices, or in the case of lrange, return results anyway.
@ -2427,16 +2760,17 @@ namespace eval punk::lib {
}
if {![string is integer -strict $len] || $len < 0} {
error "lindex_resolve len must be a positive integer"
error "lindex_resolve len must be a positive integer."
}
set based_max [expr {$len -1 + $base}]
if {[string is integer -strict $index]} {
#review - base?
#can match +i -i
if {$index < 0} {
return -3
} elseif {$index >= $len} {
return -2
if {$index < $base} {
return -Inf
} elseif {$index > $based_max} {
return Inf
} else {
#integer may still have + sign - normalize with expr
return [expr {$index}]
@ -2453,19 +2787,22 @@ namespace eval punk::lib {
if {$offset == 0} {
#(offset +0, -0 or 0 or 000 0_0 etc)
#op either + or - is irrelevant
set index [expr {$len-1}]
if {$index < 0} {
return -2 ;#special case - equivalent to 'end', with empty list - treat like a positive number out of bounds
#set index [expr {$len-1}] ;#+ base ?
set index $based_max
if {$index < $base} {
#return -2 ;#special case - equivalent to 'end', with empty list - treat like a positive number out of bounds
return Inf
} else {
return $index
}
}
set index [if {$op eq "+"} {expr {($len-1) + $offset}} else {expr {($len-1) - $offset}}]
#[para] Accepts index of the forms accepted by Tcl's list commands. (e.g compound indices such as 3+1 end-2)
#[para] returns -1 for out of range at either end, or a valid integer index
#[para] returns -Inf for out of range at either end, or a valid integer index
#[para] Unlike lindex_resolve; lindex_resolve_basic can't determine if an out of range index was out of range at the lower or upper bound
#[para] This is only likely to be faster than average over lindex_resolve for small lists and for Tcl which has the builtin lseq command
#[para] The performance advantage is more likely to be present when using compound indexes such as $x+1 or end-1
#[para] For pure integer indices the performance should be equivalent
if {![string is integer -strict $len]} {
error "lindex_resolve_basic len must be an integer"
if {![string is integer -strict $len] || $len < 0} {
error "lindex_resolve_basic len must be an integer greater than or equal to zero"
}
if {![string is integer -strict $base]} {
#base can be negative
error "lindex_resolve_basic base must be an integer"
}
set based_max [expr {$len -1 + $base}]
set index [tcl::string::map {_ {}} $index] ;#forward compatibility with integers such as 1_000
if {[string is integer -strict $index]} {
#can match +i -i
#avoid even the lseq overhead when the index is simple
if {$index < 0 || ($index >= $len)} {
#even though in this case we could return -2 or -3 like lindex_resolve; for consistency we don't, as it's not always determinable for compound indices using the lseq method.
return -1
if {$index < $base || ($index > $based_max)} {
#even though in this case we could return -Inf or Inf like lindex_resolve;
#for consistency we don't return Inf for upper-boudn violation,
#as which bound is violated is not always directly determinable for compound index expressions (such as end-x) using the lseq+lindex mechanism.
return -Inf
} else {
#!NOTE! index within range is unchanged - no matter the base
#integer may still have + sign - normalize with expr
return [expr {$index}]
}
@ -2532,7 +2878,7 @@ namespace eval punk::lib {
if {$len > 0} {
#For large len - this is a wasteful allocation if no true lseq available in Tcl version.
#lseq produces an 'arithseries' object which we can index into without allocating an entire list (REVIEW)
set testlist [punk::lib::range 0 [expr {$len-1}]] ;# uses lseq if available, has fallback.
set testlist [punk::lib::range $base $based_max] ;# uses lseq if available, has fallback of creating a potentially large list of numbers.
} else {
set testlist [list]
#we want to call 'lindex' even in this case - to get the appropriate error message
@ -2540,7 +2886,7 @@ namespace eval punk::lib {
set idx [lindex $testlist $index]
if {$idx eq ""} {
#we have no way to determine if out of bounds is at lower vs upper end
return -1
return -Inf
} else {
return $idx
}
@ -2560,12 +2906,12 @@ namespace eval punk::lib {
if {![string is integer -strict $index]} {
set index [punk::lib::lindex_resolve [string length $str] $index]
switch -- $index {
-2 {
return [list $str ""]
}
-3 {
-Inf {
return [list "" $str]
}
Inf {
return [list $str ""]
}
}
}
return [list [string range $str 0 $index-1] [string range $str $index end]]
@ -2580,20 +2926,20 @@ namespace eval punk::lib {
if {![string is integer -strict $index]} {
set index [punk::lib::lindex_resolve [string length $str] $index]
switch -- $index {
-2 {
if {[lindex $sizes end] != 0} {
ledit parts end end [lindex $parts end] {}
ledit sizes end end [lindex $sizes end] 0
}
continue
}
-3 {
-Inf {
if {[lindex $sizes 0] != 0} {
ledit parts 0 0 {} [lindex $parts 0]
ledit sizes 0 0 0 [lindex $sizes 0]
}
continue
}
Inf {
if {[lindex $sizes end] != 0} {
ledit parts end end [lindex $parts end] {}
ledit sizes end end [lindex $sizes end] 0
}
continue
}
}
}
if {$index <= 0} {
@ -4038,14 +4384,15 @@ namespace eval punk::lib {
set result ""
set in_jt 0
foreach ln [split $data \n] {
set tln [string trim $ln]
set tln [::tcl::string::trim $ln]
if {!$in_jt} {
if {[string match *jumpTable* $ln]} {
if {[::tcl::string::match *jumpTable* $ln]} {
punk::ns::call_frame
append result $ln \n
set in_jt 1
}
} else {
if {[string match Command* $tln] || [string match "(*) *" $tln]} {
if {[::tcl::string::match Command* $tln] || [::tcl::string::match "(*) *" $tln]} {
