diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index fa5aa2ee..38c8a359 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -51,11 +51,8 @@ tcl::namespace::eval punk::ns { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { - #variable ns_current - ##allow presetting - #if {![info exists ::punk::ns::ns_current]} { - # set ns_current :: - #} + #2026-07-14 Agent-Updated: removed a commented-out ns_current presetting block - + #the shell's current-namespace state lives in punk::nav::ns (::punk::nav::ns::ns_current), not here. variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp pkguse cmdtype synopsis @@ -156,6 +153,9 @@ tcl::namespace::eval punk::ns { #for 'weird' namespaces, this uses a generated nested script #It has to run this (probably non byte-compiled?) script twice in some cases #consider coroutine-based alternative? + #2026-07-14 Agent-Generated: note that punk::ns parses p:::x leading-colon-greedy (child literally + #named :x) whereas native 'namespace eval p:::x' resolves to child x - the divergence and the + #no-create/error-propagation contract of nseval_ifexists are pinned in tests ns/nsprimitives.test. proc nseval_ifexists {ns script} { set parts [nsparts $ns] if {[lindex $parts 0] ne ""} { @@ -281,7 +281,10 @@ tcl::namespace::eval punk::ns { } #Note nsjoin,nsjoinall,nsprefix,nstail are string functions that don't care about namespaces in existence. - #Some functions in punk::ns are + #2026-07-14 Agent-Updated: (completed a trailing sentence fragment) Other functions in punk::ns are + #contextual - they resolve relative paths against the caller's namespace (e.g nsexists, nschildren, + #nspath_here_absolute) and/or consult live interp state. + #Behaviour of the string primitives - including the edge cases below - is pinned in tests ns/nsprimitives.test. proc nsjoin {prefix name} { if {[string match ::* $name]} { @@ -293,16 +296,12 @@ tcl::namespace::eval punk::ns { if {"$prefix" eq "::"} { return ::$name } - #if {"$name" eq ""} { - # return $prefix - #} + #Note an empty prefix with a relative name produces an ABSOLUTE path (nsjoin {} x -> ::x). + #An empty name is deliberately not special-cased: #nsjoin ::x::y "" should return ::x::y:: - this is the correct fully qualified form used to call a command that is the empty string return ${prefix}::$name } proc nsjoinall {prefix args} { - #if {![llength $args]} { - # error "usage: nsjoinall prefix relativens \[relativens ...\]" - #} set segments [list $prefix] foreach sub $args { if {[string match ::* $sub]} { @@ -336,15 +335,9 @@ tcl::namespace::eval punk::ns { #nsparts will prefer leading colon (ie greedy on ::) #This is important to support leading colon commands such as :/ # ie ::punk:::jjj:::etc -> :: punk :jjj :etc - proc nsparts1 {nspath} { - set nspath [string map {:::: ::} $nspath] - set mapped [string map {:: \u0FFF} $nspath] - set parts [split $mapped \u0FFF] - #if {[lindex $parts end] eq ""} { - #} - return $parts - } - + #2026-07-14 Agent-Updated: removed the superseded simpler variant nsparts1 (blanket ::::->:: collapse + #before splitting - NOT equivalent to nsparts on colon runs of 5+; divergence was pinned before removal, + #see git history of tests ns/nsprimitives.test). #Memory leak for systems that create and delete a lot of differently names namespaces/commands - review #consider configuration option to disable for large long-running systems? @@ -483,7 +476,7 @@ tcl::namespace::eval punk::ns { #The main difference being collapsing (or ignoring) repeated double-colons #we need to distinguish unprefixed from prefixed ie ::x vs x #There is an apparent inconsistency with nstail ::a:::x being able to return :x - #whereas nsprefix :::a will return just ::a + #whereas nsprefix :::a will return just :: (2026-07-14 Agent-Updated: was documented as ::a - the actual value is :: per tests ns/nsprimitives.test) #This is because :x (or even just : ) can in theory be the name of a command and we may need to see it (although it is not a good idea) #and a namespace can exist with leading colon - but is even worse - as default Tcl commands will misreport e.g namespace current within namespace eval #The view is taken that a namespace with leading/trailing colons is so error-prone that even introspection is unreliable so we will rule that out. @@ -491,97 +484,18 @@ tcl::namespace::eval punk::ns { #nsprefix is *somewhat* like 'namespace parent' except that it is string based - ie no requirement for the namespaces to actually exist # - this is an important usecase even if the handling of 'unwise' command names isn't so critical. #nsprefix is more like 'namespace qualifiers' - but can return the global namespace as :: instead of empty string. - proc nsprefix1 {{nspath ""}} { - #normalize the common case of leading :::: and also collapse any internal runs of 4 (there can be no namespace named as empty string - as this is reserved for global ns by Tcl) - - while {[regexp {::::} $nspath]} { - set nspath [string map {:::: ::} $nspath] - } - set rawprefix [string range $nspath 0 end-[string length [nstail $nspath]]] - if {$rawprefix eq "::"} { - return $rawprefix - } else { - if {[string match *:: $rawprefix]} { - return [string range $rawprefix 0 end-2] - } else { - return $rawprefix - } - #return [string trimright $rawprefix :] - } - } - #deprecated - proc nsprefix_orig {{nspath ""}} { - #normalize the common case of :::: - set nspath [string map {:::: ::} $nspath] - set rawprefix [string range $nspath 0 end-[string length [nstail $nspath]]] - if {$rawprefix eq "::"} { - return $rawprefix - } else { - if {[string match *:: $rawprefix]} { - return [string range $rawprefix 0 end-2] - } else { - return $rawprefix - } - #return [string trimright $rawprefix :] - } - } - + #2026-07-14 Agent-Updated: removed the superseded variants nsprefix1 and nstail1 and the deprecated + #nsprefix_orig/nstail_orig (all collapse long colon runs before splitting - NOT equivalent to the + #nsparts-based nsprefix/nstail on colon runs of 5+; divergence was pinned before removal, see git + #history of tests ns/nsprimitives.test). nstail1 also had an unshipped '-strict' flag raising an error + #on unpaired-colon segments - a possible future validation feature for nstail if ever needed. + + #string-based tail: returns the last nsparts segment - unlike 'namespace tail' it preserves + #leading/trailing colons in the tail (nstail ::a:::b -> :b) and returns empty for a trailing :: path. proc nstail {nspath} { return [lindex [nsparts_cached $nspath] end] } - #namespace tail which handles :::cmd ::x:::y ::x:::/y etc in a specific manner for string processing - #review - consider making -strict raise an error for unexpected sequences such as :::: or any situation with more than 2 colons together. - #This is only necessary in the context of requirement to browse namespaces with 'unwisely' named commands - #For most purposes 'namespace tail' is fine. - proc nstail1 {nspath args} { - #normalize the common case of :::: - while {[regexp {::::} $nspath]} { - set nspath [string map {:::: ::} $nspath] - } - #it's unusual - but namespaces *can* have spaced in them. - set mapped [string map {:: \u0FFF} $nspath] - set parts [split $mapped \u0FFF] - - set defaults [list -strict 0] - set opts [dict merge $defaults $args] - set strict [dict get $opts -strict] - - if {$strict} { - foreach p $parts { - if {[string match :* $p]} { - error "nstail unpaired colon ':' in $nspath" - } - } - } - - #e.g ::x::y:::z should return ":z" despite it being a bad idea for a command name. - return [lindex $parts end] - } - #deprecated - proc nstail_orig {nspath args} { - #normalize the common case of :::: - set nspath [string map {:::: ::} $nspath] - #it's unusual - but namespaces *can* have spaced in them. - set mapped [string map {:: \u0FFF} $nspath] - set parts [split $mapped \u0FFF] - - set defaults [list -strict 0] - set opts [dict merge $defaults $args] - set strict [dict get $opts -strict] - - if {$strict} { - foreach p $parts { - if {[string match :* $p]} { - error "nstail unpaired colon ':' in $nspath" - } - } - } - - #e.g ::x::y:::z should return ":z" despite it being a bad idea for a command name. - return [lindex $parts end] - } - #tcl 8.x has creative writing var weirdness.. tcl 9 is likely to differ proc nsvars {{nsglob "*"}} { @@ -635,10 +549,10 @@ tcl::namespace::eval punk::ns { lappend pats "" } * { - #review - ::g*t will not find ::got:it (won't match single inner colon) - this should be fixed - #lappend pats {[^:]*} - #negative lookahead - #any number of chars not followed by ::, followed by any number of non : + #2026-07-14 Agent-Updated: (was a stale 'should be fixed' note - the fix is in place) + #negative lookahead: any number of chars not followed by ::, followed by any number of non-: + #so * matches within a level INCLUDING a single inner colon (::g*t finds ::got:it) + #but never crosses a :: separator. Pinned in tests ns/nsprimitives.test (globmatchns_pins). lappend pats {(?:.(?!::))*[^:]*} } ** { @@ -658,31 +572,9 @@ tcl::namespace::eval punk::ns { } return "^[join $pats ::]\$" } - #obsolete - proc nsglob_as_re1 {glob} { - #any segment that is not just * must match exactly one segment in the path - set pats [list] - foreach seg [nsparts_cached $glob] { - if {$seg eq ""} { - set seg "" - } - if {$seg eq "*"} { - lappend pats {[^:]*} - } elseif {$seg eq "**"} { - lappend pats {.*} - } else { - #set seg [string map [list . {[.]}] $seg] - set seg [string map {. [.]} $seg] - if {[regexp {[*?]} $seg]} { - set pat [string map [list ** {.*} * {[^:]*} ? {[^:]}] $seg] - lappend pats "$pat" - } else { - lappend pats "$seg" - } - } - } - return "^[join $pats ::]\$" - } + #2026-07-14 Agent-Updated: removed the obsolete-marked nsglob_as_re1 (pre-lookahead version whose * + #could not match an inner colon). Live nsglob_as_re behaviour is pinned via globmatchns in tests + #ns/nsprimitives.test. proc globmatchns {glob path} { #the total set of namespaces is *generally* reasonably bounded so we could just cache all globs, perhaps with some pretty high limit for sanity.. (a few thousand?) review - memory cost? # Tcl (reportedly https://wiki.tcl-lang.org/page/regexp) only caches 'up to 30'dynamically - but should cache more if more stored. @@ -721,20 +613,27 @@ tcl::namespace::eval punk::ns { } + #2026-07-14 Agent-Updated: filled in the previously empty summary/help fields. + #(the internal recursion option -call-depth-internal parsed by the proc is deliberately undocumented) punk::args::define { @id -id ::punk::ns::nstree_list @cmd -name punk::ns::nstree_list\ -summary\ - ""\ + "List namespaces matching a namespace path glob."\ -help\ - "" + "Return a list of fully qualified namespaces matching the + location glob. Glob chars (* ?) may appear in any path segment. + A segment of ** (or trailing ** on a segment) matches across + multiple namespace levels." @leaders location -type path -optional 0 @opts -subnslist -type list -default {} -help\ - "" + "Remaining glob path segments still to be matched + (internal - used during recursion)." -allbelow -type boolean -default 1 -help\ - "" + "Also return namespaces nested deeper than the matched + glob path (the matched namespaces' subtrees)." @values -min 0 -max 0 } #important: add tests for tricky cases - e.g punk::m**::util vs punk::m*::util vs punk::m*::**::util - these should all be able to return different results depending on namespace structure. @@ -841,32 +740,8 @@ tcl::namespace::eval punk::ns { } set nslist [lsort -unique $nslist] - - if 0 { - set nextglob [lindex $tailparts 0] - if {$nextglob ne "**"} { - set nslist [list] - if {[llength $tailparts]} { - set nsmatches [list] - #lappend nsmatches {*}[lsearch -all -inline -glob $allchildren [nsjoin ${base} $nextglob]::*] - lappend nsmatches {*}[lsearch -all -inline -glob $allchildren [nsjoin ${base} $nextglob]] - } else { - set nsmatches $allchildren - } - #return - - foreach ch $nsmatches { - lappend nslist $ch - lappend nslist {*}[nstree_list $ch -subnslist [lrange $tailparts 1 end] -call-depth-internal [expr {$CALLDEPTH + 1}] -allbelow $allbelow] - } - } else { - set nslist [nstree_list $base -subnslist {} -allbelow 1] - } - } - - #foreach ns $nslist { - # puts "== $ns" - #} + #2026-07-14 Agent-Updated: removed an 'if 0' disabled earlier version of the tailparts matching + #(recoverable via git history). set nslist_filtered [list] if {$CALLDEPTH == 0} { #puts "--base: $base" @@ -1346,22 +1221,16 @@ tcl::namespace::eval punk::ns { - #set chwidest1 [pipedata [list {*}$children1 ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] + #2026-07-14 Agent-Updated: removed per-line commented-out pipedata equivalents of the width calcs below. set lenlist1 [lmap v [list {*}$children1 ""] {string length $v}] set chwidest1 [tcl::mathfunc::max {*}$lenlist1] - #set chwidest2 [pipedata [list {*}$children2 ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] set chwidest2 [tcl::mathfunc::max {*}[lmap v [list {*}$children2 ""] {string length $v}]] #wrap the cmd in [list] (just for the width calc) to get a proper length for what will actually be displayed - #set cmdwidest1 [pipedata [list {*}$elements1 ""] {lmap v $data {string length [list [lindex $v 1]]}} {tcl::mathfunc::max {*}$data}] set cmdwidest1 [tcl::mathfunc::max {*}[lmap v [list {*}$elements1 ""] {string length [list [lindex $v 1]]}]] - - #set cmdwidest2 [pipedata [list {*}$elements2 ""] {lmap v $data {string length [list [lindex $v 1]]}} {tcl::mathfunc::max {*}$data}] set cmdwidest2 [tcl::mathfunc::max {*}[lmap v [list {*}$elements2 ""] {string length [list [lindex $v 1]]}]] - #set cmdwidest3 [pipedata [list {*}$elements3 ""] {lmap v $data {string length [list [lindex $v 1]]}} {tcl::mathfunc::max {*}$data}] set cmdwidest3 [tcl::mathfunc::max {*}[lmap v [list {*}$elements3 ""] {string length [list [lindex $v 1]]}]] - #set cmdwidest4 [pipedata [list {*}$elements4 ""] {lmap v $data {string length [list [lindex $v 1]]}} {tcl::mathfunc::max {*}$data}] set cmdwidest4 [tcl::mathfunc::max {*}[lmap v [list {*}$elements4 ""] {string length [list [lindex $v 1]]}]] set displaylist [list] @@ -1417,6 +1286,12 @@ tcl::namespace::eval punk::ns { if {$cmd ni $commands && $cmd in $aliases } { #ordinary un-masked commandless-alias #(original alias name that has been renamed) + #2026-07-14 Agent-Generated: this red-strike branch and the yellow masked-alias + #branch below appear unreachable from the current get_ns_dicts bucket derivation + #(probed 2026-07-14: an alias overwritten by a same-name proc classifies as proc + #only, and a renamed alias stays a plain als entry - see the fixture-findings + #header of tests ns/nslist.test). Retained pending the planned display rework - + #reassess reachability there before deleting. set c [a+ red bold strike] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] @@ -1549,16 +1424,7 @@ tcl::namespace::eval punk::ns { proc nslist {args} { set argd [punk::args::parse $args withid ::punk::ns::nslist] lassign [dict values $argd] leaders opts values received solos multis - - #if {[dict exists $args -match]} { - # #review - presumably this is due to get_nslist taking -match? - # error "nslist requires positional argument 'glob' instead of -match option" - #} - #set defaults [dict create {*}{ - # } -match $ns_absolute {*}{ - # -nspathcommands 0 - #}] - #set opts [dict merge $defaults $args] + #2026-07-14 Agent-Updated: removed a commented-out pre-punk::args manual defaults block. # -- --- --- set opt_nspathcommands [dict get $opts -nspathcommands] # -- --- --- @@ -1751,6 +1617,11 @@ tcl::namespace::eval punk::ns { dict set switchblock_cache $patternblock $result return $result } + #2026-07-14 Agent-Generated: the test_switch* procs below are deliberate fixtures for the + #switchblock_info/cmdtrace nested-switch line-attribution work - NOT dead code. They are exercised + #by tests ns/cmdtrace.test (test_switch2/test_switch4/test_switch5) and were used to characterize + #the upstream traceline mismark (core.tcl-lang.org tktview 5d5b1052280c976ea3d4). Do not remove + #while cmdtrace/G-085 work is live. proc test_switch {s} { switch -- $s { x {return x} a - b { @@ -2129,6 +2000,11 @@ y" {return quirkykeyscript} variable tinfo variable _cmdtrace_pause 1 ;#gate for the interactive pause in _cmdtrace_leave (cmdtrace -pause option) + #2026-07-14 Agent-Generated: KNOWN NOISE - the cmdtrace machinery (the _cmdtrace_* callbacks and + #_cmdtrace_get_eval_offset*) emits development-style progress output on stdout/stderr as it traces + #('found a switch', per-step lines, testswitch dumps ...). Deliberately left as-is here: output + #discipline (and machine-parseable trace output) is in scope for proposed goal G-085 - clean it up + #there rather than piecemeal. proc _cmdtrace_enter {vname target args} { variable _cmdtrace_disabled if {$_cmdtrace_disabled} return @@ -2715,10 +2591,7 @@ y" {return quirkykeyscript} #we will need to evaluate in the namespace foreach {tgt_cmd ns nscmd} $resolved_targets { puts stderr "tracing target: $tgt_cmd whilst running: $origin $arglist" - - #::tcl::namespace::eval $ns [list ::trace add execution $nscmd enter [list ::punk::ns::_cmdtrace_enter ::punk::ns::linedict $tgt_cmd]] - #::tcl::namespace::eval $ns [list ::trace add execution $nscmd enterstep [list ::punk::ns::_cmdtrace_enterstep ::punk::ns::linedict $tgt_cmd]] - #::tcl::namespace::eval $ns [list ::trace add execution $nscmd leave [list ::punk::ns::_cmdtrace_leave ::punk::ns::linedict $tgt_cmd]] + #nseval rather than tcl::namespace::eval - see leading-colon note above nseval $ns [list ::trace add execution $nscmd enter [list ::punk::ns::_cmdtrace_enter ::punk::ns::linedict $tgt_cmd]] nseval $ns [list ::trace add execution $nscmd enterstep [list ::punk::ns::_cmdtrace_enterstep ::punk::ns::linedict $tgt_cmd]] nseval $ns [list ::trace add execution $nscmd leave [list ::punk::ns::_cmdtrace_leave ::punk::ns::linedict $tgt_cmd]] @@ -2726,9 +2599,7 @@ y" {return quirkykeyscript} try { - #uplevel 1 [list $origin {*}$arglist] set _cmdtrace_disabled false - #::tcl::namespace::eval $origin_ns [list $origin_nscmd {*}$arglist] nseval $origin_ns [list $origin_nscmd {*}$arglist] } trap {} {errMsg errOptions} { set _cmdtrace_disabled true @@ -2738,9 +2609,6 @@ y" {return quirkykeyscript} } finally { set _cmdtrace_disabled true foreach {tgt_cmd ns nscmd} $resolved_targets { - #::tcl::namespace::eval $ns [list ::trace remove execution $nscmd enterstep [list ::punk::ns::_cmdtrace_enterstep ::punk::ns::linedict $tgt_cmd]] - #::tcl::namespace::eval $ns [list ::trace remove execution $nscmd enter [list ::punk::ns::_cmdtrace_enter ::punk::ns::linedict $tgt_cmd]] - #::tcl::namespace::eval $ns [list ::trace remove execution $nscmd leave [list ::punk::ns::_cmdtrace_leave ::punk::ns::linedict $tgt_cmd]] nseval $ns [list ::trace remove execution $nscmd enterstep [list ::punk::ns::_cmdtrace_enterstep ::punk::ns::linedict $tgt_cmd]] nseval $ns [list ::trace remove execution $nscmd enter [list ::punk::ns::_cmdtrace_enter ::punk::ns::linedict $tgt_cmd]] nseval $ns [list ::trace remove execution $nscmd leave [list ::punk::ns::_cmdtrace_leave ::punk::ns::linedict $tgt_cmd]] @@ -3204,7 +3072,6 @@ y" {return quirkykeyscript} dict set nspathdict $pathns [dict create] ;#use consistent structure when nspathcommands false } } - #set exportpatterns [nseval $location {::namespace export}] set allexported [list] set matched [list] foreach p $exportpatterns { @@ -3243,7 +3110,6 @@ y" {return quirkykeyscript} } else { set allprocs [tcl::namespace::eval $location {::info procs}] } - #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] set allnative [list] @@ -3257,7 +3123,8 @@ y" {return quirkykeyscript} set allooprivateclasses [list] set allimported [list] set allundetermined [list] - set interp_aliases [interp aliases ""] + #2026-07-14 Agent-Updated: removed unused assignment 'set interp_aliases [interp aliases ""]' + #(its only consumer was the commented-out per-command alias check below). #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespace (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases if {$weird_ns} { @@ -3265,7 +3132,6 @@ y" {return quirkykeyscript} } else { set raw_aliases [tcl::namespace::eval $location [list ::punk::ns::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } - #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] foreach a $raw_aliases { if {[string match *:: $a]} { @@ -3609,6 +3475,11 @@ y" {return quirkykeyscript} #Must be no ansi when only single arg used. #review - ansi codes will be very confusing in some scenarios! #todo - only output color when requested (how?) or via repltelemetry ? + #2026-07-14 Agent-Generated: nscommands2 and nscommands1 below are earlier pipeline-based iterations + #superseded by the plain proc nscommands (which adds weird-namespace handling). No callers exist in + #the repo; nscommands1 additionally references nonexistent commands (nsthis2, inspect at global scope) + #and errors on first use. Removal candidates - retained pending user decision since they register + #global command aliases and serve as pipeline-syntax examples. interp alias {} nscommands2 {} .= ,'ok'@0.= { #Note: namespace argument to apply doesn't accept namespace segments with leading colon - so pipelines won't work fully in dodgily-named namespaces such as :::x #inspect -label namespace_current [namespace current] @@ -5601,11 +5472,11 @@ y" {return quirkykeyscript} 3) ensemble commands - auto-generated unless documented via punk::args (subcommands will show with an indicator if they are explicitly documented or are themselves ensembles) - 4) tcl::oo objects - auto-gnerated unless documented via punk::args + 4) tcl::oo objects - auto-generated unless documented via punk::args 5) dereferencing of aliases to find underlying command (will not work with some renamed aliases) - Note that native commands commands not explicitly documented will + Note that native commands not explicitly documented will generally produce no useful info. For example sqlite3 dbcmd objects could theoretically be documented - but as 'info cmdtype' just shows 'native' they can't (?) be identified as belonging to sqlite3 without @@ -5878,943 +5749,13 @@ y" {return quirkykeyscript} } return "Undocumented command $origin. Type: $origintype" } - - #return [cmdinfo $origin {*}$queryargs] } - #todo - -cache or -refresh to configure whether we introspect ensembles/objects each time? - # - as this is interactive generally introspection should be ok at the top level - # but if we need to go down multiple levels of subcommands generating/testing prefixes - could be an issue ?? - #TODO - make obsolete - (replaced by punk::ns::cmdhelp) - #punk::args::define { - # @dynamic - # @id -id ::punk::ns::arginfo - # @cmd -name punk::ns::arginfo\ - # -summary\ - # "Command usage/help."\ - # -help\ - # "Show usage info for a command. - # It supports the following: - # 1) Procedures or builtins for which a punk::args definition has - # been loaded. - # 2) tepam procedures (returns string form only) - # 3) ensemble commands - auto-generated unless documented via punk::args - # (subcommands will show with an indicator if they are - # explicitly documented or are themselves ensembles) - # 4) tcl::oo objects - auto-gnerated unless documented via punk::args - # 5) dereferencing of aliases to find underlying command - # (will not work with some renamed aliases) - - # Note that native commands commands not explicitly documented will - # generally produce no useful info. For example sqlite3 dbcmd objects - # could theoretically be documented - but as 'info cmdtype' just shows - # 'native' they can't (?) be identified as belonging to sqlite3 without - # calling them. arginfo deliberately avoids calling commands to elicit - # usage information as this is inherently risky. (could create a file, - # exit the interp etc) - # " - # -return -type string -default table -choices {string table tableobject} - - - # } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { - # -form -default 0 -help\ - # "Ordinal index or name of command form" - # -grepstr -default "" -type list -typesynopsis regex -help\ - # "list consisting of regex, optionally followed by ANSI names for highlighting - # (incomplete - todo)" - # -- -type none -help\ - # "End of options marker - # Use this if the command to view begins with a -" - # @values -min 1 - # commandpath -help\ - # "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" - # subcommand -optional 1 -multiple 1 -default {} -help\ - # "subcommand if commandpath is an ensemble. - # Multiple subcommands can be supplied if ensembles are further nested" - #} - #proc arginfo {args} { - # lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received - # set nscaller [uplevel 1 [list ::namespace current]] - # #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part - # #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. - # if {![dict exists $received -scheme]} { - # #dict set opts -scheme info - # set scheme_received 0 - # } else { - # set scheme_received 1; #so we know not to override caller's explicit choice - # } - - # set querycommand [dict get $values commandpath] - # set queryargs [dict get $values subcommand] - # set grepstr [dict get $opts -grepstr] - # set opts [dict remove $opts -grepstr] - # #puts stdout "---------------------arginfo: '$args' querycommand:'$querycommand' queryargs:'$queryargs'" - - # #todo - similar to corp? review corp resolution process - # #should handle lazy loaded commands (via ::auto_index) that are not yet present but may be documented - - # set cinfo [uplevel 1 [list cmdwhich $querycommand]] - # set origin [dict get $cinfo origin] - # set resolved [dict get $cinfo which] - # set cmdtype [dict get $cinfo origintype] - # switch -- $cmdtype { - # script { - # #assumed to be an 'alias' script - ie proper list - not an arbitrary tcl code block - # set scriptargs [lrange $origin 1 end] ;#arguments that were curried into the alias script - # set origin [lindex $origin 0] - # set queryargs [list {*}$scriptargs {*}$queryargs] - # return [uplevel 1 [list punk::ns::arginfo {*}$opts $origin {*}$queryargs]] - # } - # alias { - # #alias to an alias - # return [uplevel 1 [list punk::ns::arginfo {*}$opts $origin {*}$queryargs]] - # } - # } - - # #JJJ - # #check for a direct match first - # if {![llength $queryargs]} { - # #puts stderr "---->arginfo '$args' update_definitions [list [namespace qualifiers $origin]]" - # punk::args::update_definitions [list [namespace qualifiers $origin]] ;#update_definitions will treat empty string as global ns :: - # if {![punk::args::id_exists $origin] && ![punk::args::id_exists (autodef)$origin]} { - # uplevel 1 [list punk::ns::generate_autodef $origin] - # } - - # if {[punk::args::id_exists (autodef)$origin]} { - # set origin (autodef)$origin - # } - # if {[punk::args::id_exists $origin]} { - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse {} -form [dict get $opts -form] -errorstyle $estyle withid $origin} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec $origin] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec $origin] {*}$opts -aserror 0 -parsedargs $parseresult] - # } - # } - # } - - - # set id $origin - # #puts stderr "____>arginfo '$args' update_definitions [list [namespace qualifiers $id]]" - # punk::args::update_definitions [list [namespace qualifiers $id]] - - - # #check longest first checking for id matching ::cmd ?subcmd..? - # #REVIEW - this doesn't cater for prefix callable subcommands - # if {[llength $queryargs]} { - # if {[punk::args::id_exists [list $id {*}$queryargs]]} { - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse {} -form [dict get $opts -form] -errorstyle $estyle withid [list $id {*}$queryargs]} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec [list $id {*}$queryargs]] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec [list $id {*}$queryargs]] {*}$opts -aserror 0 -parsedargs $parseresult] - # #return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$queryargs]]] - # } - # } - # } - - # #didn't find any exact matches - # #traverse from other direction taking prefixes into account - # set specid "" - # if {[punk::args::id_exists $id]} { - # set specid $id - # } elseif {[punk::args::id_exists (autodef)$id]} { - # set specid (autodef)$id - # } - - # if {$specid ne "" && [punk::args::id_exists $specid]} { - # #cycle forward through leading values - # set specargs $queryargs - # if {[llength $queryargs]} { - # #jjj - # set spec [punk::args::get_spec $specid] - # #--------------------------------------------------------------------------- - # set form_names [dict get $spec form_names] - # if {[llength $form_names] == 1} { - # set fid [lindex $form_names 0] - # } else { - # #review - -form only applies to final command? - # # -form must be a list if we have multiple levels of multi-form commands? - # set opt_form [dict get $opts -form] - # if {[string is integer -strict $opt_form]} { - # if {$opt_form < 0 || $opt_form > [llength $form_names]-1} { - # error "punk::ns::arginfo invalid -form $opt_form expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'" - # } - # set fid [lindex $form_names $opt_form] - # } else { - # if {$opt_form ni $form_names} { - # error "punk::ns::arginfo invalid -form $opt_form expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'" - # } - # set fid $opt_form - # } - # } - # #--------------------------------------------------------------------------- - # set nextqueryargs [list] ;#build a list of prefix-resolved queryargs - # set queryargs_untested $queryargs - # foreach q $queryargs { - # if {[llength [dict get $spec FORMS $fid LEADER_NAMES]]} { - # #todo: fix - # set subitems [dict get $spec FORMS $fid LEADER_NAMES] - # if {[llength $subitems]} { - # set next [lindex $subitems 0] - # set arginfo [dict get $spec FORMS $fid ARG_INFO $next] - - # set allchoices [list] - # set choices [punk::args::system::Dict_getdef $arginfo -choices {}] - # set choicegroups [punk::args::system::Dict_getdef $arginfo -choicegroups {}] - # #maintenance smell - similar/dup of some punk::args logic - review - # #-choiceprefixdenylist ?? - # set choiceprefixreservelist [punk::args::system::Dict_getdef $arginfo -choiceprefixreservelist {}] - # if {[dict exists $choicegroups ""]} { - # dict lappend choicegroups "" {*}$choices - # } else { - # set choicegroups [dict merge [dict create "" $choices] $choicegroups] - # } - # dict for {groupname clist} $choicegroups { - # lappend allchoices {*}$clist - # } - # set resolved_q [tcl::prefix::match -error "" [list {*}$allchoices {*}$choiceprefixreservelist] $q] - # if {$resolved_q eq "" || $resolved_q in $choiceprefixreservelist} { - # break - # } - # lappend nextqueryargs $resolved_q - # lpop queryargs_untested 0 - # #ledit queryargs_untested 0 0 - # if {$resolved_q ne $q} { - # #we have our first difference - recurse with new query args - # #set numvals [expr {[llength $queryargs]+1}] - # #return [ punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$nextqueryargs {*}$queryargs_untested] - # #puts "===> testing arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested" - # if {!$scheme_received} { - # dict unset opts -scheme - # } - # return [ punk::ns::arginfo {*}$opts {*}$specid {*}$nextqueryargs {*}$queryargs_untested] - - # } - # #check if subcommands so far have a custom args def - # #set currentid [list $querycommand {*}$nextqueryargs] - # set currentid [list {*}$specid {*}$nextqueryargs] - # if {[punk::args::id_exists $currentid]} { - # set spec [punk::args::get_spec $currentid] - # #--------------------------------------------------------------------------- - # set form_names [dict get $spec form_names] - # if {[llength $form_names] == 1} { - # set fid [lindex $form_names 0] - # } else { - # #review - -form only applies to final command? - # # -form must be a list if we have multiple levels of multi-form commands? - # set opt_form [dict get $opts -form] - # if {[string is integer -strict $opt_form]} { - # if {$opt_form < 0 || $opt_form > [llength $form_names]-1} { - # error "punk::ns::arginfo invalid -form $opt_form expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'" - # } - # set fid [lindex $form_names $opt_form] - # } else { - # if {$opt_form ni $form_names} { - # error "punk::ns::arginfo invalid -form $opt_form expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'" - # } - # set fid $opt_form - # } - # } - # #--------------------------------------------------------------------------- - # set specid $currentid - # set specargs $queryargs_untested - # set nextqueryargs [list] - # } else { - # #We can get no further with custom defs - # #It is possible we have a documented lower level subcommand but missing the intermediate - # #e.g if ::trace remove command was specified and is documented - it will be found above - # #but if ::trace remove is not documented and the query is "::trace remove com" - # #There is no way to determine com is a prefix as we don't have the intermediate documented -choice info available. - # #that's probably ok. - # break - # } - # } - # } else { - # #review - # break - # } - # } - # } else { - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse {} -form [dict get $opts -form] -errorstyle $estyle withid $id} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec $id] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec $id] {*}$opts -aserror 0 -parsedargs $parseresult] - # #return [uplevel 1 [list punk::args::usage {*}$opts $id]] - # } - # } - # #puts "--->origin $specid queryargs: $specargs" - # set origin $specid - # set queryargs $specargs - # } - - # if {[string match "(autodef)*" $origin]} { - # #wasn't resolved by id - so take this as a request to generate it (probably there is an existing custom def - and this has been manually requested to get the default) - # set origin [string range $origin [string length (autodef)] end] - # set resolved $origin - # } - - # set autoid "" - # switch -- $cmdtype { - # object { - # #class is also an object - # #todo -mixins etc etc - # set class [info object class $origin] - # #the call: info object methods -all - # # seems to do the right thing as far as hiding unexported methods, and showing things like destroy - # # - which don't seem to be otherwise easily introspectable - # set public_methods [info object methods $origin -all] - # #set class_methods [info class methods $class] - # #set object_methods [info object methods $origin] - - # if {[llength $queryargs]} { - # set c1 [lindex $queryargs 0] - # if {$c1 in $public_methods} { - # switch -- $c1 { - # new { - # set constructorinfo [info class constructor $origin] - # set arglist [lindex $constructorinfo 0] - # set argdef [punk::lib::tstr -return string { - # @id -id "(autodef)${$origin} new" - # @cmd -name "${$origin} new"\ - # -summary\ - # "Create new object instance."\ - # -help\ - # "create object with autogenerated command name. - # Arguments are passed to the constructor." - # @values - # }] - # set i 0 - # foreach a $arglist { - # if {[llength $a] == 1} { - # if {$i == [llength $arglist]-1 && $a eq "args"} { - # #'args' is only special if last - # append argdef \n "args -optional 1 -multiple 1" - # } else { - # append argdef \n "$a" - # } - # } else { - # append argdef \n "[lindex $a 0] -default [lindex $a 1]" - # } - # incr i - # } - # punk::args::define $argdef - # set queryargs_remaining [lrange $queryargs 1 end] - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse $queryargs_remaining -form [dict get $opts -form] -errorstyle $estyle withid "(autodef)$origin new"} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec "(autodef)$origin new"] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec "(autodef)$origin new"] {*}$opts -aserror 0 -parsedargs $parseresult] - # #return [punk::args::usage {*}$opts "(autodef)$origin new"] - # } - # } - # create { - # set constructorinfo [info class constructor $origin] - # set arglist [lindex $constructorinfo 0] - # set argdef [punk::lib::tstr -return string { - # @id -id "(autodef)${$origin} create" - # @cmd -name "${$origin} create"\ - # -summary\ - # "Create new object instance with specified command name."\ - # -help\ - # "create object with specified command name. - # Arguments following objectName are passed to the constructor." - # @values -min 1 - # objectName -type string -help\ - # "possibly namespaced name for object instance command" - # }] - # set i 0 - # foreach a $arglist { - # if {[llength $a] == 1} { - # if {$i == [llength $arglist]-1 && $a eq "args"} { - # #'args' is only special if last - # append argdef \n "args -optional 1 -multiple 1" - # } else { - # append argdef \n "$a" - # } - # } else { - # append argdef \n "[lindex $a 0] -default [lindex $a 1]" - # } - # incr i - # } - # punk::args::define $argdef - # set queryargs_remaining [lrange $queryargs 1 end] - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse $queryargs_remaining -form [dict get $opts -form] -errorstyle $estyle withid "(autodef)$origin create"} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec "(autodef)$origin create"] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec "(autodef)$origin create"] {*}$opts -aserror 0 -parsedargs $parseresult] - # #return [punk::args::usage {*}$opts "(autodef)$origin create"] - # } - # } - # destroy { - # #review - generally no doc - # # but we may want notes about a specific destructor - # set argdef [punk::lib::tstr -return string { - # @id -id "(autodef)${$origin} destroy" - # @cmd -name "destroy"\ - # -summary\ - # "delete object instance."\ - # -help\ - # "delete object, calling destructor if any. - # destroy accepts no arguments." - # @values -min 0 -max 0 - # }] - # punk::args::define $argdef - # set queryargs_remaining [lrange $queryargs 1 end] - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse $queryargs_remaining -form [dict get $opts -form] -errorstyle $estyle withid "(autodef)$origin destroy"} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec "(autodef)$origin destroy"] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec "(autodef)$origin destroy"] {*}$opts -aserror 0 -parsedargs $parseresult] - # #return [punk::args::usage {*}$opts "(autodef)$origin destroy"] - # } - # } - # default { - # #use info object call to resolve callchain - # #we assume the first impl is the topmost in the callchain - # # and its call signature is therefore the one we are interested in - REVIEW - # # we should probably ignore generaltypes filter|unknown and look for a subsequent method|private? - # set implementations [::info object call $origin $c1] - # #result documented as list of 4 element lists - # #set callinfo [lindex $implementations 0] - # set oodef "" - # foreach impl $implementations { - # lassign $impl generaltype mname location methodtype - # switch -- $generaltype { - # method - private { - # #objects being dynamic systems - we should always reinspect. - # #Don't use the cached (autodef) def - # #If there is a custom def override - use it (should really be -dynamic - but we don't check) - # if {$location eq "object"} { - # set idcustom "$origin $c1" - # #set id "[string trimleft $origin :] $c1" ;# " " - # if {[info commands ::punk::args::id_exists] ne ""} { - # if {[punk::args::id_exists $idcustom]} { - # return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] - # } - # } - # set oodef [::info object definition $origin $c1] - # } else { - # #set id "[string trimleft $location :] $c1" ;# " " - # set idcustom "$location $c1" - # if {[info commands ::punk::args::id_exists] ne ""} { - # if {[punk::args::id_exists $idcustom]} { - # return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] - # } - # } - # set oodef [::info class definition $location $c1] - # } - # break - # } - # filter { - # } - # unknown { - # } - # } - # } - # if {$oodef ne ""} { - # set autoid "(autodef)$location $c1" - # set arglist [lindex $oodef 0] - # set argdef [punk::lib::tstr -return string { - # @id -id "${$autoid}" - # @cmd -name "${$location} ${$c1}" -help\ - # "(autogenerated by arginfo) - # arglist:${$arglist}" - # @values - # }] - # set i 0 - # #for 9.1+ can use -integer - # foreach a $arglist { - # switch -- [llength $a] { - # 1 { - # if {$i == [llength $arglist]-1 && $a eq "args"} { - # #'args' is only special if last - # append argdef \n "args -optional 1 -multiple 1" - # } else { - # append argdef \n "$a" - # } - # } - # 2 { - # append argdef \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" - # } - # default { - # error "punk::ns::arginfo unexpected oo argument signature '$arglist'\noodef:$oodef\nimplementations:$implementations" - # } - # } - # incr i - # } - # punk::args::define $argdef - # return [punk::args::usage {*}$opts $autoid] - # } else { - # return "unable to resolve $origin method $c1" - # } - - # } - # } - # } - # } - # set choicelabeldict [dict create] - # set choiceinfodict [dict create] - # foreach cmd $public_methods { - # switch -- $cmd { - # new - create - destroy { - # #todo - # } - # default { - # set implementations [::info object call $origin $cmd] - # set def "" - # foreach impl $implementations { - # lassign $impl generaltype mname location methodtype - # switch -- $generaltype { - # method - private { - # if {$location eq "object" || $location eq $origin} { - # #set id "[string trimleft $origin :] $cmd" ;# " " - # set id "$origin $cmd" - # dict set choiceinfodict $cmd {{doctype objectmethod}} - # } elseif {$location eq $class} { - # set id "$class $cmd" - # dict set choiceinfodict $cmd {{doctype classmethod}} - # } else { - # #set id "[string trimleft $location :] $cmd" ;# " " - # set id "$location $cmd" - # if {[string match "core method:*" $methodtype]} { - # dict lappend choiceinfodict $cmd {doctype coremethod} - # } else { - # dict lappend choiceinfodict $cmd [list doctype [list $location $methodtype]] - # } - # } - # if {[punk::args::id_exists $id]} { - # #dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]" - # dict lappend choiceinfodict $cmd {doctype punkargs} - # dict lappend choiceinfodict $cmd [list subhelp {*}$id] - # } - # break - # } - # filter { - # } - # unknown { - # dict set choiceinfodict $cmd {{doctype unknown}} - # } - # } - # } - # } - # } - # } - - # set vline [list method -choices $public_methods -choicelabels $choicelabeldict -choiceinfo $choiceinfodict -choiceprefix 0] ;#methods must be specified in full always? - review - # #puts stderr "--->$vline" - # set autoid "(autodef)$origin" - # set argdef [punk::lib::tstr -return string { - # @id -id ${$autoid} - # @cmd -name "Object: ${$origin}" -help\ - # "Instance of class: ${$class} (info autogenerated)" - # @leaders -min 1 - # }] - # append argdef \n $vline - # punk::args::define $argdef - - # } - # privateObject { - # return "Command is a privateObject - no info currently available" - # } - # privateClass { - # return "Command is a privateClass - no info currently available" - # } - # interp { - # #todo - # } - # script { - # #todo - # } - # ensemble { - # #review - # #todo - check -unknown - # #if there is a -unknown handler - we can't be sure the choices in -map or from -namespace are exhaustive. - # #presumably -choiceprefix should be zero in that case?? - - # set ensembleinfo [namespace ensemble configure $origin] - # set parameters [dict get $ensembleinfo -parameters] - # set prefixes [dict get $ensembleinfo -prefixes] - # set map [dict get $ensembleinfo -map] - # set ns [dict get $ensembleinfo -namespace] - - # #review - we can have a combination of commands from -map as well as those exported from -namespace - # # if and only if -subcommands is specified - - # set subcommand_dict [dict create] - # set commands [list] - # set nscommands [list] - # if {[llength [dict get $ensembleinfo -subcommands]]} { - # #set exportspecs [namespace eval $ns {namespace export}] - # #foreach pat $exportspecs { - # # lappend nscommands {*}[info commands ${ns}::$pat] - # #} - # #when using -subcommands, even unexported commands are available - # set nscommands [info commands ${ns}::*] - # foreach sub [dict get $ensembleinfo -subcommands] { - # if {[dict exists $map $sub]} { - # #-map takes precence over same name exported from -namespace - # dict set subcommand_dict $sub [dict get $map $sub] - # } elseif {"${ns}::$sub" in $nscommands} { - # dict set subcommand_dict $sub ${ns}::$sub - # } else { - # #subcommand probably supplied via -unknown handler? - # dict set subcommand_dict $sub "" - # } - # } - # } else { - # if {[dict size $map]} { - # set subcommand_dict $map - # } else { - # set exportspecs [namespace eval $ns {namespace export}] - # foreach pat $exportspecs { - # lappend nscommands {*}[info commands ${ns}::$pat] - # } - # foreach fqc $nscommands { - # dict set subcommand_dict [namespace tail $fqc] $fqc - # } - # } - # } - - - # set subcommands [lsort [dict keys $subcommand_dict]] - # if {[llength $queryargs]} { - # set posn_subcommand [llength $parameters];#ensemble may have '-parameters' list specified - parameters that come before the subcommand - # if {$posn_subcommand > 0} { - # set params [lrange $queryargs 0 $posn_subcommand-1] - # set remaining_queryargs [lrange $queryargs $posn_subcommand end] - # } else { - # set params [list] - # set remaining_queryargs $queryargs - # } - # if {[llength $remaining_queryargs]} { - # if {$prefixes} { - # set match [tcl::prefix::match -error {} $subcommands [lindex $remaining_queryargs 0]] - # } else { - # set match [lindex $remaining_queryargs 0] - # } - # if {$match in $subcommands} { - # set subcmd [dict get $subcommand_dict $match] - # #return [arginfo {*}$subcmd {*}[lrange $queryargs 1 end]] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") - # if {!$scheme_received} { - # dict unset opts -scheme - # } - # #return [arginfo {*}$opts {*}$subcmd {*}$params {*}[lrange $remaining_queryargs 1 end]] - # #use tailcall so %caller% is reported properly in error msg - # tailcall arginfo {*}$opts {*}$subcmd {*}$params {*}[lrange $remaining_queryargs 1 end] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") - # } - # } - # } - - # #todo - synopsis? - # set choicelabeldict [dict create] - - # set choiceinfodict [dict create] - - # dict for {sub subwhat} $subcommand_dict { - # if {[llength $subwhat] > 1} { - # #TODO - resolve using cmdinfo? - # puts stderr "arginfo warning: subcommand $sub points to multiword target $subwhat - TODO" - # } - # set targetfirstword [lindex $subwhat 0] - # set targetinfo [cmdwhich $targetfirstword] - # set targetorigin [dict get $targetinfo origin] - # set targetcmdtype [dict get $targetinfo origintype] - # set nstarget [nsprefix $targetorigin] - - # dict lappend choiceinfodict $sub [list doctype $targetcmdtype] - - # if {[punk::args::id_exists [list $origin $sub]]} { - # dict lappend choiceinfodict $sub {doctype punkargs} - # dict lappend choiceinfodict $sub [list subhelp {*}$origin $sub] - # } elseif {[punk::args::id_exists $targetorigin]} { - # dict lappend choiceinfodict $sub {doctype punkargs} - # dict lappend choiceinfodict $sub [list subhelp {*}$targetorigin] - # } else { - # #puts stderr "arginfo ensemble--- NO doc for [list $origin $sub] or $origin" - # } - - # } - - # set vline [list subcommand -choices $subcommands -choiceprefix $prefixes -choicelabels $choicelabeldict -choiceinfo $choiceinfodict] - # set autoid "(autodef)$origin" - # puts "ENSEMBLE auto def $autoid (arginfo)" - # set argdef [punk::lib::tstr -return string { - # @id -id ${$autoid} - # @cmd -help\ - # "(autogenerated by arginfo) - # ensemble: ${$origin}" - # }] - # if {[llength $parameters] == 0} { - # append argdef \n "@leaders -min 1" - # } else { - # append argdef \n "@leaders -min [expr {[llength $parameters]+1}]" - # foreach p $parameters { - # append argdef \n "$p -type string -help { (leading ensemble parameter)}" - # } - # } - # append argdef \n "@values -unnamed true" - # append argdef \n $vline - # punk::args::define $argdef - # } - # } - - # #if {$autoid ne ""} { - # # return [punk::args::usage {*}$opts $autoid] - # #} - - - # #check ensemble before testing punk::arg::id_exists - # #we want to recalculate ensemble usage info in case ensemble has been modified - - # if {$autoid ne ""} { - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - # if {[catch {punk::args::parse $queryargs -form [dict get $opts -form] -errorstyle $estyle withid $autoid} parseresult]} { - # # parsing error e.g Bad number of leading values - # #override -scheme in opts with -scheme error - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec $autoid] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # #show usage - with goodargs marked - # #return [punk::args::arg_error "" [punk::args::get_spec $autoid] -scheme info -aserror 0 {*}$opts -parsedargs $parseresult] - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec $autoid] {*}$opts -aserror 0 -parsedargs $parseresult] - # } - # #return [punk::args::usage {*}$opts $autoid] - # } - - # #check for tepam help - # if {[info exists ::tepam::ProcedureList]} { - # if {$origin in $::tepam::ProcedureList} { - # return [tepam::ProcedureHelp $origin 1] ;#use 1 to return rather than emit to stdout - # } else { - # #handle any tepam functions that don't eat their own dogfood but have help variables - # #e.g tepam::procedure, tepam::argument_dialogbox - # #Rather than hardcode these - we'll guess that any added will use the same scheme.. - # if {[namespace qualifiers $origin] eq "::tepam"} { - # set func [namespace tail $origin] - # #tepam XXXHelp vars don't exactly match procedure names :/ - # if {[info exists ::tepam::${func}Help]} { - # return [set ::tepam::${func}Help] - # } else { - # set f2 [string totitle $func] - # if {[info exists ::tepam::${f2}Help]} { - # return [set ::tepam::${f2}Help] - # } - # #e.g argument_dialogbox -> ArgumentDialogboxHelp - # set parts [split $func _] - # set uparts [lmap p $parts {string totitle $p}] - # set f3 [join [list {*}$uparts Help] ""] - # if {[info exists ::tepam::${f3}]} { - # return [set ::tepam::${f3}] - # } - # } - # } - # } - # } - - # set origin_ns [nsprefix $origin] - # set parts [nsparts_cached $origin_ns] - # set weird_ns 0 - # if {[lsearch $parts :*] >=0} { - # set weird_ns 1 - # } - # if {$weird_ns} { - # set argl {} - # set tail [nstail $origin] - # set cmdtype [nseval_ifexists $origin_ns [list punk::ns::cmdtype $tail]] - # if {$cmdtype eq "proc"} { - # foreach a [nseval_ifexists $origin_ns [list info args $tail]] { - # if {[nseval_ifexists $origin_ns [list info default $tail $a def]]} { - # lappend a $def - # } - # lappend argl $a - # } - # } - # } else { - # set cmdtype [punk::ns::cmdtype $origin] - # if {$cmdtype eq "proc"} { - # set argl {} - # set infoargs [info args $origin] - # foreach a $infoargs { - # if {[info default $origin $a def]} { - # lappend a $def - # } - # lappend argl $a - # } - # } - # } - - # if {[llength $queryargs]} { - # #todo - something better ? - # switch -- [dict get $opts -return] { - # string { - # set estyle "basic" - # } - # tableobject { - # set estyle "minimal" - # } - # default { - # set estyle "standard" - # } - # } - - # if {[punk::args::id_exists $origin]} { - # if {[catch {punk::args::parse $queryargs -form [dict get $opts -form] -errorstyle $estyle withid $origin} parseresult]} { - # if {[dict get $opts -return] eq "tableobject"} { - # return [punk::args::arg_error "$parseresult" [punk::args::get_spec $origin] {*}$opts -aserror 0] - # } else { - # return $parseresult - # } - # } else { - # #show usage - with goodargs marked - # if {!$scheme_received} { - # dict set opts -scheme info - # } - # return [punk::args::arg_error "" [punk::args::get_spec $origin] {*}$opts -aserror 0 -parsedargs $parseresult] - # } - # } - # set msg "Undocumented or nonexistant command $origin $queryargs" - # append msg \n "$origin Type: $cmdtype" - # } else { - # if {$cmdtype eq "proc"} { - # set msg "Undocumented proc $origin" - # append msg \n "No argument processor detected" - # append msg \n "function signature: $resolved $argl" - # } else { - # set msg "Undocumented command $origin. Type: $cmdtype" - # } - # } - # if {[llength $grepstr] != 0} { - # if {[llength $grepstr] == 1} { - # return [punk::ansi::grepstr -no-linenumbers -highlight red [lindex $grepstr 0] $msg] - # } else { - # return [punk::ansi::grepstr -no-linenumbers -highlight [lrange $grepstr 1 end] [lindex $grepstr 0] $msg] - # } - # } - # return $msg - #} + #2026-07-14 Agent-Updated: removed the fully commented-out predecessor help command 'arginfo' + #(punk::args::define + proc arginfo, ~930 lines) - superseded by punk::ns::cmdhelp above, which the + #block's own header marked as its replacement. Recoverable via git history. #todo - package up as navns namespace eval argdoc { @@ -6886,7 +5827,9 @@ y" {return quirkykeyscript} List: proc - but a syntax highlighter may return a string that is not a Tcl list. - The 'basic' highlighter " + The 'basic' highlighter colours comments and + bracket/brace characters only - it is not a full + Tcl syntax highlighter." @values -min 1 -max -1 commandname -type string -typesynopsis ${$I}procname${$NI}|${$I}alias${$NI} -help\ "May be either the fully qualified path for the command, @@ -6916,14 +5859,6 @@ y" {return quirkykeyscript} #we want to handle edge cases of commands such as "" or :x #various builtins such as 'namespace which' won't work - #if {[string match ::* $path]} { - # set targetns [nsprefix $path] - # set name [nstail $path] - #} else { - # set thispath [uplevel 1 [list ::nsthis $path]] - # set targetns [nsprefix $thispath] - # set name [nstail $thispath] - #} set cinfo [uplevel 1 [list punk::ns::cmdwhich $path]] set origin [dict get $cinfo origin] set resolved [dict get $cinfo which] @@ -6938,9 +5873,6 @@ y" {return quirkykeyscript} error "no such namespace $targetns" } - #set origin [nseval $targetns [list ::namespace origin $name]] - #set resolved [nseval $targetns [list ::namespace which $name]] - #A renamed alias may exist that is the same name as a proc that was created later.. so we must check for the proc before looking into aliases! #set iproc [info procs $origin] ;#This will find empty-string command as ::ns:: but miss finding proc ":x" as ::ns:::x set iproc [nsjoin $targetns [nseval $targetns [list ::info procs $name]]] @@ -7020,37 +5952,8 @@ y" {return quirkykeyscript} set argl {} set argnames [nseval $targetns [list ::info args $name]] foreach a $argnames { - #if {[info default $origin $a defvar]} { - # lappend a $defvar - #} - - #string map is risky for strange values of $a - #set result [nseval $targetns [string map [list %n% $name %a% $a] { - # #qualify all command names when running in arbitrary namespace - # ::if {[::info default "%n%" "%a%" punk_ns_corp_defvar]} { - # #::return [::list default [::tcl::string::map [::list {"} {\"} \[ {\[]} \] {\]} ] $punk_ns_corp_defvar]][::unset punk_ns_corp_defvar] ;#keep the targetns tidy - # ::return [::list default $punk_ns_corp_defvar][::unset punk_ns_corp_defvar] ;#keep the targetns tidy - # } else { - # ::return [::list none] - # } - #}]] - - #this very odd construct is to avoid using the namespace argument of apply. (handling of *weird/inadvisable* namespaces) - #we use an uplevel from within the apply which runs in the global namespace, (but called via nseval from within targetns) and a result var for 'info default' in the current punk::ns namespace. - #set result [nseval $targetns [list apply [list {procname argname} { - # set has_default [uplevel 1 [list info default $procname $argname ::punk::ns::corp_defvar]] - # if {$has_default} { - # set answer [list default $::punk::ns::corp_defvar] - # } else { - # set answer [list none] - # } - # unset ::punk::ns::corp_defvar - # return $answer - #} ] $name $a]] - #if {[lindex $result 0] eq "default"} { - # lappend a [lindex $result 1] - #} - + #2026-07-14 Agent-Updated: removed two commented-out earlier default-retrieval experiments - + #info_default carries the explanation of the odd apply/uplevel construct (weird-namespace safe). set default_info [info_default $targetns $name $a] if {[dict get $default_info exists]} { lappend a [dict get $default_info default] @@ -7208,17 +6111,8 @@ y" {return quirkykeyscript} } - #review ??? - proc ns_relative_to_location {name} { - if {[string match ::* $name]} { - error "ns_relative_to_location accepts a relative namespace name only ie one without leading ::" - } - - } - proc ns_absolute_to_location {name} { - - } - + #2026-07-14 Agent-Updated: removed the never-implemented stub procs ns_relative_to_location and + #ns_absolute_to_location (empty bodies marked '#review ???', no callers in the repo). tcl::namespace::eval internal { @@ -7278,12 +6172,8 @@ y" {return quirkykeyscript} return [list runopts $runopts cmdargs $cmdargs] } - proc _pkguse_vars {varnames} { - #review - obsolete? - while {"pkguse_vars_[incr n]" in $varnames} {} - #return [concat $varnames pkguse_vars_$n] - return [list {*}$varnames pkguse_vars_$n] - } + #2026-07-14 Agent-Updated: removed the obsolete-marked helper _pkguse_vars (no callers - pkguse + #uses an equivalent inline collision-avoidance loop in its capture apply). proc tracehandler_nowrite {args} { error "readonly in use block" } @@ -7588,7 +6478,6 @@ y" {return quirkykeyscript} } return $out } - #interp alias "" use "" punk::ns::pkguse punk::args::define { @id -id ::punk::ns::nsimport_noclobber @@ -7718,8 +6607,6 @@ y" {return quirkykeyscript} return $all_imported } - #todo - use ns::nsimport_noclobber instead ? - interp alias {} nsthis {} punk::ns::nspath_here_absolute interp alias {} nsorigin {} apply {ns {namespace origin [uplevel 1 ::punk::ns::nspath_here_absolute $ns]} ::} interp alias {} nsvars {} punk::ns::nsvars @@ -7785,4 +6672,4 @@ package provide punk::ns [tcl::namespace::eval punk::ns { variable version set version 999999.0a1.0 }] -return \ No newline at end of file +return diff --git a/src/modules/punk/ns-buildversion.txt b/src/modules/punk/ns-buildversion.txt index 64d3b063..9e343908 100644 --- a/src/modules/punk/ns-buildversion.txt +++ b/src/modules/punk/ns-buildversion.txt @@ -1,6 +1,7 @@ -0.6.0 +0.7.0 #First line must be a semantic version number #all other lines are ignored. +#0.7.0 - comment/doc hygiene pass (no change to shipped behaviour; minor bump for removed unused procs). Dead code removed (recoverable via git history): the fully commented-out predecessor help command 'arginfo' (~930 lines, replaced by cmdhelp), the superseded/deprecated name-primitive twins nsparts1/nsprefix1/nsprefix_orig/nstail1/nstail_orig (never exported, no callers; NOT drop-in equivalents - they collapse colon runs of 5+ differently, divergence pinned in tests ns/nsprimitives.test git history), obsolete nsglob_as_re1, empty stubs ns_relative_to_location/ns_absolute_to_location, obsolete internal::_pkguse_vars, an 'if 0' block in nstree_list, unused interp_aliases assignment in get_ns_dicts, and assorted commented-out code remnants. Stale docs corrected: nsprefix comment (:::a prefix is :: not ::a), nsglob_as_re 'should be fixed' note (fix has long been in place - * matches an inner single colon), cmdhelp typos, corp -syntax truncated help sentence, nstree_list empty PUNKARGS help fields filled. Flagged (comment only): get_nslist red-strike/masked alias display branches appear unreachable (see nslist.test fixture findings), nscommands1/nscommands2 pipeline aliases are superseded removal candidates (nscommands1 errors on use - references nonexistent nsthis2), cmdtrace stdout/stderr noise deferred to proposed G-085, test_switch* marked as live cmdtrace test fixtures. All inserted/updated comments carry 2026-07-14 Agent marks. #0.6.0 - cmdtrace gains -pause (default 1 - existing interactive behaviour unchanged): -pause 0 bypasses the 'paused - hit enter key to continue' askuser in _cmdtrace_leave so cmdtrace can run non-interactively/scripted and the returned marked-up body report captured (gate: namespace variable _cmdtrace_pause). cmdtrace argdoc: the nested-switch traced-linenumber caveat now cites the upstream Tcl ticket (core.tcl-lang.org tktview 5d5b1052280c976ea3d4, reported by the developer) and records the characterized pattern (2026-07-14, punk-free minimal repro identical on 8.6.17/8.7a6/9.0.3): a nested single-block switch arm body reports lines shifted by (switch command's line within its containing script - 1) exactly when the arm's index into the split pattern/body list lands on a literal word of the switch command (options/--/block); dynamic-word or out-of-range indices report correctly arm-relative - so which arms mismark varies with the option words used, matching the ticket's observation. New testsuite ns/cmdtrace.test (pause flag, flat-switch and 2-word-nested correct-mark guards, upstream mismark GAP pins gated on have_tclcoredocs since cmdtrace's arm-offset correction needs the ::switch argdoc). #0.5.0 - G-041 doc surface: cmdhelp's -form option defaults to * (was 0) and accepts the punk::args::parse list semantics - the usage display now presents the form the supplied argument words match: the advisory parse_status's matched/best-candidate form's argument table renders at both render sites (alias path and main), with every ranked candidate (noformmatch) or every matching form (multipleformmatches) passed to arg_error so all are marked in the synopsis block ('i after cancel ' presents the cancel form; 'i lseq 0 10 2' presents the range form). punk::ns::synopsis: with trailing argument words after a multiform command path (and no explicit -form), the form(s) the words match are underlined - matching forms from the advisory parse's formstatus, or the best candidate when no form fully matches ('s after cancel someid' marks both cancel forms; 's lseq 0 10 2' marks the range form); ordinal non-comment-line position maps lines to forms in declaration order for both the full and summary renders; skipped when alias currying makes the remaining words unreliable. cmdhelp.test gains the multiform doc-surface pins (autoselected form presented, noformmatch best-candidate table + candidate naming, synopsis marking present/absent). #0.4.0 - G-051: (a) cmdinfo reports cmdtype 'doconly' (was 'notfound') when resolution lands on a punk::args id with no corresponding real command - documentation-only levels such as the per-class id "::tcl::string::is true" below the real ::tcl::string::is, and TclOO documented-method docids like " docmeth" (method case adopts doconly; may be refined by G-052). Consumers audited: cmdhelp/synopsis/eg are docid-driven, cmdtrace only tests for 'proc', punk::lib script analysis updated in step (lib 0.4.1). (b) space-form docid prefix parity: cmd_traverse's space-delimited child docid jump, on an exact-word miss, resolves the word against the current level's choices-bearing first leader via punk::args::choiceword_match (the shared G-040 resolver - -choiceprefix/-nocase/-choicealiases/denylist/reservelist honoured) and retries with the canonical word - so 'i string is tr' resolves to "::tcl::string::is true" exactly when 'string is tr' executes, ambiguous/unknown/denied words stay at the parent exactly when parse rejects them, and resolvedargs records the canonical (as parse normalization does). Tests: the four G-051 GAP pins flipped (cmdhelp_pseudo_command_cmdtype_doconly, cmdhelp_spaceform_docid_prefix_honoured incl ambiguous/unknown guard, cmdhelp_string_is_true_pseudo_doconly, cmdhelp_string_is_prefix_honoured). diff --git a/src/tests/modules/AGENTS.md b/src/tests/modules/AGENTS.md index 572a4414..056eb5b5 100644 --- a/src/tests/modules/AGENTS.md +++ b/src/tests/modules/AGENTS.md @@ -43,7 +43,7 @@ Unit tests for editable source modules under `src/modules/`, `src/modules_tcl8/` - `punk/args/` — punk::args tests (`testsuites/args/`): parsing, choices/choicegroups, forms, rendering/indentation characterization, synopsis display characterization (`synopsis.test`: basic italic argname/`` styling, longopt `--x=` alias forms, literal/literalprefix/stringstartswith/stringendswith type-alternates rendering unitalicised, option alternate parenthesization, multi-element clause display incl `?type?` members and argname tail-word hints, `-typesynopsis` value-element lists and option passthrough incl documenter ANSI, and the small-restricted-choice-set literal rule: 1-3 restricted choices render as unitalicised `|`-joined literals in leader/option/value positions with choicegroups counted, >3 or `-choicerestricted 0` falling back to italics, `-typesynopsis` taking precedence), usage-marking characterization (`usagemarking.test`: -parsedargs/-badarg/-parsestatus/-scheme marking primitives plus goodchoice highlighting of selected/default-in-effect choice words, asserted by SGR-parameter subset against the live colour arrays; the G-049 nocolour/colour-leak GAP pins flipped 2026-07-10 to scheme-statelessness assertions), the G-049 parse-status structure (`parsestatus.test`: punk::args::parse_status overall/per-argument statuses, badarg for type/allocation failures, -caller attribution, errorcode -argspecs stripping), -parsekey characterization (`parsekey.test`: result/received/solos/multis keying, shared-key required satisfaction and defaults, mash-path and prefix-abbreviation keying, plus GAP pins for last-defined-member default precedence, cross-member -multiple value loss, parsekey/optname collision conflation, and values/leaders parsekey breakage - desired-behaviour pins disabled behind punkargsKnownBug in `testsuites/dev/parsekey-knownbugs.test`), and tclcore doc/interpreter behavioural parity (`tclcoreparity.test`, G-054, gated on have_tclcoredocs: 'string is' class choices equal the live-harvested set, per-class docids exist, error-vs-ok agreement across the probe matrix, version-note labels conditional on class presence - expectations derived from the running interpreter, green on 8.6/8.7/9.0; under 8.6 run the file directly via a plain tclkit + tcltest driver since runtests' harness needs newer infrastructure) - `punk/nav/ns/` — punk::nav::ns tests (`testsuites/nav/navns.test`): the n/ n// n/// navigation state machine (ns/ transitions absolute/relative/glob-no-nav, failed-nav state preservation, quad-colon normalization, v-form content selection, ensemble annotation) and the ::punk::nav::ns::ns_current variable contract the repl/codethread/subshell seeding all consume; display content is covered in punk/ns nslist.test - `punk/repl/` — punk::repl tests (`testsuites/repl/`): opunk console backend integration (`consolebackends.test`) and repl current-namespace retention (`nscurrent.test`: real codethread via repl::init driven by synchronous runscript sends - inscope evaluation of ns_current, retention across submissions, n/-navigation retained, auto-create-with-notice for missing namespaces, the 2026-07-14 stray-namespace seeding fix pinned behaviourally plus a source-text guard on repl::start's inline template; the end-to-end piped subshell session is covered at shell level by shell/testsuites/punkexe/shellnavns.test - which found the first-subshell shared-code-interp asymmetry and the piped-inscope gap recorded there) -- `punk/ns/` — punk::ns tests (`testsuites/ns/`): cmdwhich/cmdinfo/cmd_traverse doc-lookup flow (`cmdflow.test`, G-040 parity), n/ display machinery characterization (`nslist.test`: tier A get_ns_dicts classification buckets as the machine contract for display reworks - incl package tail/prefix derivation, alias edge cases, usageinfo scan-dependence; tier B per-element layout-agnostic marking - underline/underdouble/underdotted namespace package styles, command type tag colours, exported/imported markers, the punkargs doc icon; tier C REWORK-flagged pins of the current hardcoded 2-col/4-col layout and nspath subtables, to flip deliberately with the planned punk-tables/width-responsive rework; plus the KNOWN QUIRK pin that bare nslist without -types errors with a malformed message), corp proc-retrieval and syntax/untabify interplay (`corp.test`: name edge cases, -ranges/-n line handling, basic-highlight ansistrip equivalence, -untabify spaces/unicode tab-free output, the KNOWN-DEFICIENCY pin for default -untabify none on tabbed bodies - grepstr warns per pass and brace overlays mangle tabbed lines, deterministic under mocked console tabstops - and a ::tcl::CopyDirectory -untabify spaces smoke test; precursor coverage for the planned punk::ns hygiene pass), cmdtrace characterization (`cmdtrace.test`: -pause 0 non-interactive runs, linedict line-mark keys for flat and 2-word-form nested switches as correct-mark guards, and GAP pins for the upstream nested-switch mismark - core.tcl-lang.org tktview 5d5b1052280c976ea3d4, arm bodies whose split-list index lands on a literal switch-command word report container-relative lines; mark tests gated on have_tclcoredocs because cmdtrace's arm-offset correction parses against the ::switch argdoc; plus the fixed-canary asserting punk::lib::check::has_tclbug_nestedswitch_tracelines still reports the bug - a live behavioural probe, so a fixed Tcl release fails the canary first and triggers the documented flip workflow), cmdhelp usage-rendering integration (`cmdhelp.test`: scheme selection, goodarg/badarg marking incl type/allocation failures, goodchoice highlighting of supplied/default choice words, alias path, cmdinfo result shape, queried-command failure attribution, and `-return dict` parse-status returns (G-049 - its GAP pins flipped 2026-07-10); remaining GAP pins for pseudo-command cmdtype + space-form docid prefixes (G-051, real `string is` pins behind the have_tclcoredocs constraint), TclOO undocumented-method fallback (G-052), and synopsis marking absence (G-050)), and name/path primitive characterization (`nsprimitives.test`: string pins for nsparts/nsprefix/nstail/nsjoin/nsjoinall incl weird colon-run (`:::`) splitting, the trailing-colon parse ambiguity (`::x:` + `y` joins to the same string as `::x` + `:y` and reparses leading-colon-greedy), prefix/tail/join round-trip and its absolutizing exceptions, and divergence pins showing the nsparts1/nsprefix1/nsprefix_orig/nstail1/nstail_orig twins are NOT drop-in equivalents (safe-deletion evidence for the planned hygiene pass); plus nseval fq-requirement/create-on-eval/evaluator-proc caching, the native-vs-punk `p:::x` resolution divergence (native namespace eval reaches child `x`, nseval creates/reaches literal `:x`), nseval_ifexists no-create + error propagation on plain and genuinely weird namespaces, nsexists/nschildren/nstree_raw weird-ns and relative-resolution pins, globmatchns `*`/`**`/`?` semantics (incl `*` matching a single inner colon - the 'should be fixed' comment above nsglob_as_re is stale), and nspath_to_absolute/nspath_here_absolute caller-resolution pins; known warts recorded in-test for the pass: nsjoinall error message prefixed 'nsjoin:') +- `punk/ns/` — punk::ns tests (`testsuites/ns/`): cmdwhich/cmdinfo/cmd_traverse doc-lookup flow (`cmdflow.test`, G-040 parity), n/ display machinery characterization (`nslist.test`: tier A get_ns_dicts classification buckets as the machine contract for display reworks - incl package tail/prefix derivation, alias edge cases, usageinfo scan-dependence; tier B per-element layout-agnostic marking - underline/underdouble/underdotted namespace package styles, command type tag colours, exported/imported markers, the punkargs doc icon; tier C REWORK-flagged pins of the current hardcoded 2-col/4-col layout and nspath subtables, to flip deliberately with the planned punk-tables/width-responsive rework; plus the KNOWN QUIRK pin that bare nslist without -types errors with a malformed message), corp proc-retrieval and syntax/untabify interplay (`corp.test`: name edge cases, -ranges/-n line handling, basic-highlight ansistrip equivalence, -untabify spaces/unicode tab-free output, the KNOWN-DEFICIENCY pin for default -untabify none on tabbed bodies - grepstr warns per pass and brace overlays mangle tabbed lines, deterministic under mocked console tabstops - and a ::tcl::CopyDirectory -untabify spaces smoke test; precursor coverage for the planned punk::ns hygiene pass), cmdtrace characterization (`cmdtrace.test`: -pause 0 non-interactive runs, linedict line-mark keys for flat and 2-word-form nested switches as correct-mark guards, and GAP pins for the upstream nested-switch mismark - core.tcl-lang.org tktview 5d5b1052280c976ea3d4, arm bodies whose split-list index lands on a literal switch-command word report container-relative lines; mark tests gated on have_tclcoredocs because cmdtrace's arm-offset correction parses against the ::switch argdoc; plus the fixed-canary asserting punk::lib::check::has_tclbug_nestedswitch_tracelines still reports the bug - a live behavioural probe, so a fixed Tcl release fails the canary first and triggers the documented flip workflow), cmdhelp usage-rendering integration (`cmdhelp.test`: scheme selection, goodarg/badarg marking incl type/allocation failures, goodchoice highlighting of supplied/default choice words, alias path, cmdinfo result shape, queried-command failure attribution, and `-return dict` parse-status returns (G-049 - its GAP pins flipped 2026-07-10); remaining GAP pins for pseudo-command cmdtype + space-form docid prefixes (G-051, real `string is` pins behind the have_tclcoredocs constraint), TclOO undocumented-method fallback (G-052), and synopsis marking absence (G-050)), and name/path primitive characterization (`nsprimitives.test`: string pins for nsparts/nsprefix/nstail/nsjoin/nsjoinall incl weird colon-run (`:::`) splitting, the trailing-colon parse ambiguity (`::x:` + `y` joins to the same string as `::x` + `:y` and reparses leading-colon-greedy), and prefix/tail/join round-trip and its absolutizing exceptions (the original twin-divergence pins for nsparts1/nsprefix1/nsprefix_orig/nstail1/nstail_orig served as safe-deletion evidence and were removed with the twins in the punk::ns 0.7.0 hygiene pass - divergence record in this file's git history, commit 0c7168a1); plus nseval fq-requirement/create-on-eval/evaluator-proc caching, the native-vs-punk `p:::x` resolution divergence (native namespace eval reaches child `x`, nseval creates/reaches literal `:x`), nseval_ifexists no-create + error propagation on plain and genuinely weird namespaces, nsexists/nschildren/nstree_raw weird-ns and relative-resolution pins, globmatchns `*`/`**`/`?` semantics (incl `*` matching a single inner colon - a formerly stale 'should be fixed' comment above nsglob_as_re was corrected in the 0.7.0 hygiene pass), and nspath_to_absolute/nspath_here_absolute caller-resolution pins; known warts recorded in-test for the pass: nsjoinall error message prefixed 'nsjoin:') - `punk/mix/` — punk::mix::cli tests (prune helpers, punkcheck virtual sources), punk::mix::commandset::repo fossil move/rename characterization tests (`testsuites/repo/`, FOSSIL_HOME-isolated; GAP-marked tests pin behaviour G-022 will change), punk::mix::commandset::loadedlib tests (`testsuites/loadedlib/libsearch.test`: 'dev lib.search' match semantics via -return list — wrap-glob default, =exact prefix, case rules, explicit globs, version aggregation — plus the loadedlib 0.2.0 contract: deep discovery by default (deep .tm modules found without -refresh, registration persists), -refresh = genuine re-scan (epoch incr + rediscovery picks up .tm files added to already-scanned dirs), and highlight working without the shell-global a+ alias; shared provisioned child interp sourcing the source-tree libunknown directly — see the file's ORDERING NOTE), and the MULTISHELL polyglot build machinery (`testsuites/scriptwrap/multishell.test`: scriptset wrap via the punk.multishell.cmd template - structure/LF-only/determinism, checkfile 512-byte label validation of fresh wraps AND the committed bin/runtime.cmd, the runtime scriptset round-trip byte-identity pin, and platform-gated execution smoke: cmd.exe→powershell payload on windows, sh payload on unix or via the `wsllinux` capability constraint from `src/tests/testsupport/wslprobe.tcl` - staged to the WSL distro's native filesystem, G-059) - `punk/lib/` — punk::lib tests (`testsuites/lib/`): range/index/parse/compat/interp_sync utilities, G-058 static-baseline seeding (`staticseed.test`: interp_sync_package_paths/snapshot_package_paths propagate a simulated ::punkboot static baseline and seed `load {} ` ifneeded mappings; no-op without a baseline), and the repl command-completeness engine (`commandcomplete.test`: punk::lib::system::incomplete pending-opener stacks - the info-complete quoting quirk progression (`set x "{*}{"` standalone vs in-proc-body), single openers, tabs, escapes, incomplete<->info-complete parity property; pre-repl-refactor characterization, see goals/G-044 detail preserve-list) - `punk/packagepreference/` — punk::packagepreference tests (`testsuites/packagepreference/`): G-058 static-vs-bundled policy (`staticpolicy.test`: require of a baseline package triggers the index scan before resolution so a newer bundled copy wins, static beats older bundled, exact requires of bundled versions stay reachable, missing static mappings get seeded) diff --git a/src/tests/modules/punk/ns/testsuites/ns/nsprimitives.test b/src/tests/modules/punk/ns/testsuites/ns/nsprimitives.test index 6d0110dc..f8dcbe54 100644 --- a/src/tests/modules/punk/ns/testsuites/ns/nsprimitives.test +++ b/src/tests/modules/punk/ns/testsuites/ns/nsprimitives.test @@ -8,10 +8,11 @@ namespace eval ::testspace { set result "" } - #added 2026-07-14 (agent) - characterization pins for the punk::ns name/path string primitives and eval variants, coverage precondition for the planned punk::ns hygiene pass - #The primitive region of punk::ns contains variant/deprecated twins (nsparts1, nsprefix1, nsprefix_orig, nstail1, nstail_orig) that are - #consolidation candidates. The pins below record the exported primitives' behaviour AND where the twins diverge from them, so any - #dead-code removal during the hygiene pass is deliberate rather than assumed-equivalent. + #added 2026-07-14 (agent) - characterization pins for the punk::ns name/path string primitives and eval variants, coverage precondition for the punk::ns hygiene pass + #The primitive region of punk::ns contained variant/deprecated twins (nsparts1, nsprefix1, nsprefix_orig, nstail1, nstail_orig). + #This file originally also pinned their divergence from the live primitives (they collapsed long colon runs differently); + #those divergence tests were removed together with the twins in the punk::ns 0.7.0 hygiene pass - see git history of this + #file (commit 0c7168a1 has the divergence record). #nsjoin/nsjoinall/nsprefix/nstail/nsparts are pure string functions - none of the namespaces used in these string pins need to exist. test nsparts_standard {nsparts splits well-formed paths - leading empty element marks fully qualified, :::: collapses to ::, spaces preserved}\ @@ -51,19 +52,6 @@ namespace eval ::testspace { {{} :} {{} : {}} {{} : :} {{} a :b} {{} a : b} {{} a : :b} {a : b} :x {{} :x} {{} x:} {{} x {}} {{} a b :} ] - test nsparts1_divergence {nsparts1 is NOT equivalent to nsparts - its blanket ::::->:: collapse merges colon runs before splitting}\ - -setup $common -body { - lappend result [punk::ns::nsparts1 ::a:::b] ;# {} a :b - same as nsparts here - lappend result [punk::ns::nsparts1 ::a:::::b] ;# {} a :b - DIFFERS (nsparts: {} a : b) - lappend result [punk::ns::nsparts1 ::a::::::b] ;# {} a {} b - DIFFERS (nsparts: {} a : :b) - produces an empty middle segment - lappend result [punk::ns::nsparts1 :::::] ;# {} : - DIFFERS (nsparts: {} : {}) - }\ - -cleanup { - }\ - -result [list\ - {{} a :b} {{} a :b} {{} a {} b} {{} :} - ] - test nsparts_cached_coherence {nsparts_cached returns the same as nsparts for plain and weird paths}\ -setup $common -body { foreach p [list "" ::a::b ::a:::::b ::x: {::a b::c}] { @@ -95,32 +83,17 @@ namespace eval ::testspace { {} {} a b :b :a :a b: {} ] - test nstail_variant_divergence {nstail1/nstail_orig diverge from nstail on long colon runs; nstail1 -strict errors on unpaired colons}\ - -setup $common -body { - lappend result [punk::ns::nstail1 ::::::a] ;# a - DIFFERS from nstail (:a) - lappend result [punk::ns::nstail_orig ::::::a] ;# a - DIFFERS from nstail (:a) - lappend result [punk::ns::nstail1 ::a:::b] ;# :b - same as nstail here - lappend result [catch {punk::ns::nstail1 ::a:::b -strict 1} emsg] $emsg - }\ - -cleanup { - }\ - -result [list\ - a a :b 1 {nstail unpaired colon ':' in ::a:::b} - ] - - test nsprefix_variant_divergence {nsprefix1/nsprefix_orig diverge from nsprefix on colon runs of 5+ (they collapse, nsprefix keeps bare-colon segments)}\ + #2026-07-14 (agent) - nsprefix long-colon-run values (previously asserted alongside the removed + #twin-divergence pins) kept as a direct pin of the live proc + test nsprefix_long_colon_runs {nsprefix keeps bare-colon segments on colon runs of 5+}\ -setup $common -body { - lappend result [punk::ns::nsprefix :::::a] ;# ::: (as pinned in basic.test) - lappend result [punk::ns::nsprefix1 :::::a] ;# :: - DIFFERS - lappend result [punk::ns::nsprefix_orig :::::a] ;# :: - DIFFERS - lappend result [punk::ns::nsprefix ::a::::::b] ;# ::a::: - lappend result [punk::ns::nsprefix1 ::a::::::b] ;# ::a - DIFFERS - lappend result [punk::ns::nsprefix_orig ::a::::::b] ;# ::a:: - DIFFERS (and differs from nsprefix1) + lappend result [punk::ns::nsprefix :::::a] ;# ::: (as pinned in basic.test) + lappend result [punk::ns::nsprefix ::a::::::b] ;# ::a::: }\ -cleanup { }\ -result [list\ - ::: :: :: ::a::: ::a ::a:: + ::: ::a::: ] test nsjoin_edges {nsjoin edge cases - empty prefix absolutizes, empty name gives trailing :: (fq form of empty command name), absolute name rejects non-empty prefix}\ @@ -338,7 +311,7 @@ namespace eval ::testspace { lappend result [punk::ns::globmatchns ::a::* ::a::b] lappend result [punk::ns::globmatchns ::a::* ::a::b::c] ;# 0 - * does not cross :: lappend result [punk::ns::globmatchns ::a::** ::a::b::c] ;# 1 - ** crosses :: - lappend result [punk::ns::globmatchns ::g*t ::got:it] ;# 1 - * matches a single inner colon (the 'should be fixed' comment above nsglob_as_re is stale - behaviour is fixed) + lappend result [punk::ns::globmatchns ::g*t ::got:it] ;# 1 - * matches a single inner colon (a formerly stale 'should be fixed' comment above nsglob_as_re was corrected in the 0.7.0 hygiene pass) lappend result [punk::ns::globmatchns ::a::? ::a::b] lappend result [punk::ns::globmatchns ::a::? ::a::bc] ;# 0 - ? is a single char lappend result [punk::ns::globmatchns ::w::* {::w:::odd}] ;# 1 - * at a level also matches a leading-colon (weird) child