diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.15.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.17.0.tm similarity index 97% rename from src/vfs/_vfscommon.vfs/modules/punk/args-0.15.1.tm rename to src/vfs/_vfscommon.vfs/modules/punk/args-0.17.0.tm index 9fe4f5bb..b5389f54 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.15.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.17.0.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::args 0.15.1 +# Application punk::args 0.17.0 # Meta platform tcl # Meta license # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args 0 0.15.1] +#[manpage_begin punkshell_module_punk::args 0 0.17.0] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] @@ -798,6 +798,18 @@ tcl::namespace::eval punk::args { directive-options: -name -summary -help + -formhint + The -formhint value replaces the built-in ' i -form N ...' + hint labels rendered beside a multi-form definition's + synopsis lines in usage/arg_error table output. + Occurrences of %formindex% and %formname% are replaced + per form with the form's 0-based ordinal and its name. + An empty string suppresses the hint labels entirely. + Intended for definitions whose users cannot act on the + repl-oriented default - e.g script-level (script) ids, + which are unreachable from any repl - so the hint can + name that consumer's own navigation instead. Callers of + usage/arg_error may override with their -formhint option. %B%@leaders%N% ?opt val...? (used for leading args that come before switches/opts) directive-options: @@ -1104,6 +1116,31 @@ tcl::namespace::eval punk::args { Each alias must map to an existing choice, and must not itself collide with a choice (validated when the definition is resolved). + -choiceunavailable {} + Names that are recognised but not available in the + current runtime/context (e.g a choice a newer version + provides - the version-adaptive definition declares it + here on runtimes that lack it). Unavailable names are + displayed among the choices under a dedicated + 'Unavailable' group heading with their ordinary + -choicelabels notes, and participate in prefix + calculation exactly like -choiceprefixreservelist + entries - so a prefix shared between an available and + an unavailable name is ambiguous, preparing users for + contexts where the name is real. A word landing on an + unavailable name (exactly, or as a unique prefix) is + rejected with a tailored 'choiceunavailable' error + naming the entry and its -choicelabels note, instead + of the generic listed-values error. Applies under + -choicerestricted 1 (the default); with + -choicerestricted 0 any word remains an acceptable + ordinary value. Requires -choices and/or -choicegroups; + entries must not collide with choices, alias names or + reservelist entries, and -default may not be an + unavailable name (validated when the definition is + resolved). Synopsis choice-literal display and + value-in-effect highlighting never include unavailable + entries. -choicegroups {} Generally this would be used instead of -choices to allow usage display of choices grouped by some name (or the empty @@ -3362,6 +3399,20 @@ tcl::namespace::eval punk::args { } tcl::dict::set spec_merged $spec $specval } + -choiceunavailable { + #list of recognised-but-unavailable choice names (goal G-073). + #Displayed among the choices (dedicated display group, with their ordinary + #-choicelabels notes), prefix-pool members like -choiceprefixreservelist - + #but a word landing on one (exact, or unique prefix) is rejected with a + #tailored 'choiceunavailable' error instead of the generic choice error. + #Applies under -choicerestricted 1 (the default) - with -choicerestricted 0 + #any word is an acceptable ordinary value and no tailored rejection occurs. + #Cross-validation against the final choice set happens after all specs merge. + if {[catch {llength $specval}]} { + error "punk::args::resolve - invalid value for key '$spec' in specifications for argument '$argname' - value must be a list of recognised-but-unavailable choice names @id:$DEF_definition_id" + } + tcl::dict::set spec_merged $spec $specval + } -unindentedfields - -solo - -choices - -choicegroups - -choicemultiple - -choicecolumns - @@ -3481,7 +3532,7 @@ tcl::namespace::eval punk::args { -minsize -maxsize -choices -choicegroups -mincap -maxcap -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted - -choicelabels -choiceinfo -choicealiases + -choicelabels -choiceinfo -choicealiases -choiceunavailable -unindentedfields -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help -multipleunique -choicemultipleunique -choicemultipleuniqueset @@ -3510,6 +3561,33 @@ tcl::namespace::eval punk::args { } } + #cross-validate -choiceunavailable against the final merged choice set (goal G-073) + if {[tcl::dict::exists $spec_merged -choiceunavailable] && [llength [tcl::dict::get $spec_merged -choiceunavailable]]} { + set cu_allchoices [punk::args::system::Dict_getdef $spec_merged -choices {}] + foreach {_cugroup cumembers} [punk::args::system::Dict_getdef $spec_merged -choicegroups {}] { + lappend cu_allchoices {*}$cumembers + } + if {![llength $cu_allchoices]} { + error "punk::args::resolve - -choiceunavailable for argument '$argname' requires -choices and/or -choicegroups to also be declared (an argument whose every choice is unavailable is not expressible with this key) @id:$DEF_definition_id" + } + set cu_aliasnames [tcl::dict::keys [punk::args::system::Dict_getdef $spec_merged -choicealiases {}]] + set cu_reservelist [punk::args::system::Dict_getdef $spec_merged -choiceprefixreservelist {}] + foreach cu_entry [tcl::dict::get $spec_merged -choiceunavailable] { + if {$cu_entry in $cu_allchoices} { + error "punk::args::resolve - -choiceunavailable for argument '$argname' entry '$cu_entry' collides with a defined choice in -choices/-choicegroups @id:$DEF_definition_id" + } + if {$cu_entry in $cu_aliasnames} { + error "punk::args::resolve - -choiceunavailable for argument '$argname' entry '$cu_entry' collides with a -choicealiases alias name (the alias exact-match would silently accept the unavailable name) @id:$DEF_definition_id" + } + if {$cu_entry in $cu_reservelist} { + error "punk::args::resolve - -choiceunavailable for argument '$argname' entry '$cu_entry' also appears in -choiceprefixreservelist (the reservelist landing would mask the unavailable indication) @id:$DEF_definition_id" + } + } + if {[tcl::dict::exists $spec_merged -default] && [tcl::dict::get $spec_merged -default] in [tcl::dict::get $spec_merged -choiceunavailable]} { + error "punk::args::resolve - -default for argument '$argname' is a -choiceunavailable entry (an unavailable name cannot be the value in effect) @id:$DEF_definition_id" + } + } + if {$is_opt} { #tcl::dict::set FDICT ARG_CHECKS $argname {*}{ # } [tcl::dict::remove $spec_merged -form -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi -choicecolumns -group -typesynopsis -help -ARGTYPE] ;#leave things like -range -minsize @@ -5005,6 +5083,16 @@ tcl::namespace::eval punk::args { -scheme -default error -choices {nocolour info error} -form -default 0 -help\ "Ordinal index or name of command form" + -formhint -type string -help\ + "Template for the per-form hint labels displayed beside each + form's synopsis line when the definition has multiple forms. + Occurrences of %formindex% and %formname% in the template are + replaced per form with the form's ordinal index (0-based) and + its name. An empty string suppresses the hint labels entirely. + When this option is not supplied, a definition may carry its + own template via '@cmd -formhint'; with neither present the + built-in repl-oriented default renders ' i -form N ...' labels + (one per form)." }] ] @@ -5174,8 +5262,10 @@ tcl::namespace::eval punk::args { set as_error 1 ;#usual case is to raise an error set scheme error set form 0 + set formhint "" + set formhint_received 0 ;#distinguish supplied-empty (suppress) from not-supplied (definition/default applies) dict for {k v} $args { - set fullk [tcl::prefix::match -error "" {-badarg -parsedargs -parsestatus -aserror -return -scheme -form} $k] + set fullk [tcl::prefix::match -error "" {-badarg -parsedargs -parsestatus -aserror -return -scheme -form -formhint} $k] switch -- $fullk { -badarg { set badarg $v @@ -5206,9 +5296,13 @@ tcl::namespace::eval punk::args { -form { set form $v } + -formhint { + set formhint $v + set formhint_received 1 + } default { set arg_error_isrunning 0 - error "arg_error invalid option $k. Known_options: -badarg -parsedargs -parsestatus -aserror -scheme -return -form" + error "arg_error invalid option $k. Known_options: -badarg -parsedargs -parsestatus -aserror -scheme -return -form -formhint" } } } @@ -5480,10 +5574,22 @@ tcl::namespace::eval punk::args { set form_names [dict get $spec_dict form_names] set synhelp "Synopsis:" if {[llength $form_names] > 1} { - set fn 0 - foreach fname $form_names { - append synhelp \n " i -form $fn \U2026" - incr fn + #G-149: the per-form hint labels beside the synopsis lines are a + #template substituted per form (%formindex% 0-based ordinal, + #%formname% form name). Precedence: caller -formhint > definition + #@cmd -formhint > builtin repl-oriented default. An empty template + #suppresses the labels (the cell keeps just the Synopsis: label). + if {$formhint_received} { + set hint_template $formhint + } else { + set hint_template [Dict_getdef $spec_dict cmd_info -formhint " i -form %formindex% \U2026"] + } + if {$hint_template ne ""} { + set fn 0 + foreach fname $form_names { + append synhelp \n [string map [list %formindex% $fn %formname% $fname] $hint_template] + incr fn + } } } $t configure_header $h -colspans $arg_colspans -values [list $synhelp [punk::ansi::ansiwrap brightwhite $synopsis]] @@ -5816,6 +5922,18 @@ tcl::namespace::eval punk::args { } else { set choicegroups [dict merge [dict create "" $choices] $choicegroups] } + #G-073: recognised-but-unavailable names render among the choices under a + #dedicated display group (the heading is the distinguishing mechanism), + #with their ordinary -choicelabels notes. Joining choicegroups here also + #puts them in allchoices_originalcase below and therefore the prefix-calc + #pool, so displayed shortest-prefix marking reflects their parse-time + #reserving effect. Display-side injection only: they are never in + #-choices/-choicegroups, so parse acceptance, synopsis choice-literals + #and value-in-effect marking cannot pick them up. + set choiceunavailable_display [Dict_getdef $arginfo -choiceunavailable {}] + if {[llength $choiceunavailable_display]} { + dict lappend choicegroups "Unavailable (recognised, not selectable here)" {*}$choiceunavailable_display + } #review - does choiceprefixdenylist need to be added? dict for {groupname clist} $choicegroups { lappend allchoices_originalcase {*}$clist @@ -6412,7 +6530,7 @@ tcl::namespace::eval punk::args { " -return -default table -choices {string table tableobject} }\ - {${[punk::args::resolved_def -types opts -override {-scheme {-default info}} ::punk::args::arg_error -scheme]}}\ + {${[punk::args::resolved_def -types opts -override {-scheme {-default info}} ::punk::args::arg_error -scheme -formhint]}}\ {${[punk::args::resolved_def -types opts ::punk::args::resolved_def -form]}}\ { @@ -7201,6 +7319,7 @@ tcl::namespace::eval punk::args { [Dict_getdef $ARG_INFO $argname -choiceprefix 1]\ [Dict_getdef $ARG_INFO $argname -choiceprefixdenylist {}]\ [Dict_getdef $ARG_INFO $argname -choiceprefixreservelist {}]\ + [Dict_getdef $ARG_INFO $argname -choiceunavailable {}]\ ] if {[dict get $cwm matched]} { set word_matched 1 @@ -7435,6 +7554,7 @@ tcl::namespace::eval punk::args { [Dict_getdef $ARG_INFO $argname -choiceprefix 1]\ [Dict_getdef $ARG_INFO $argname -choiceprefixdenylist {}]\ [Dict_getdef $ARG_INFO $argname -choiceprefixreservelist {}]\ + [Dict_getdef $ARG_INFO $argname -choiceunavailable {}]\ ] return [expr {[dict get $cwm matched] ? "yes" : "no"}] } @@ -7724,11 +7844,15 @@ tcl::namespace::eval punk::args { status valid | invalid | incomplete invalid - a supplied word failed validation incomplete - required arguments missing (a count or - allocation shortfall). Note a supplied word - failing its -type check can also surface as - an allocation shortfall (missingrequiredvalue) - - badarg and the per-argument statuses carry - the specifics in both situations. For a + allocation shortfall). A supplied word + failing a required argument's basic -type + screen reports typemismatch (invalid) as of + 0.15.2; a word leaving a multi-member + clause short, or failing a literal-typed + member, still surfaces as an allocation + shortfall (missingrequiredvalue) - badarg + and the per-argument statuses carry the + specifics in both situations. For a single-form parse this is the engine failure classification, NOT a viability verdict - read formstatus for that. For a multiform @@ -8281,6 +8405,7 @@ tcl::namespace::eval punk::args { set cw_aliases [Dict_getdef $ARG_INFO $thisname -choicealiases {}] set cw_deny [Dict_getdef $ARG_INFO $thisname -choiceprefixdenylist {}] set cw_reserve [Dict_getdef $ARG_INFO $thisname -choiceprefixreservelist {}] + set cw_unavail [Dict_getdef $ARG_INFO $thisname -choiceunavailable {}] ;#G-073 lassign [Dict_getdef $ARG_INFO $thisname -choicemultiple {1 1}] cw_cmmin cw_cmmax } } @@ -8300,12 +8425,14 @@ tcl::namespace::eval punk::args { set member_satisfied 0 set member_choicechecked 0 + set member_cwm {} ;#G-073: singular-screen matchinfo (consulted by the rejection builder) if {$has_choices} { if {$choicescreen_applies} { #G-071 allocation screen (see block above the loop) set member_choicechecked 1 if {$cw_cmmax == 1} { - set cwm [choiceword_match $v $cw_nocase $cw_allchoices $cw_aliases $cw_prefix $cw_deny $cw_reserve] + set cwm [choiceword_match $v $cw_nocase $cw_allchoices $cw_aliases $cw_prefix $cw_deny $cw_reserve $cw_unavail] + set member_cwm $cwm set member_satisfied [tcl::dict::get $cwm matched] } else { #-choicemultiple: the word is itself a list of choices - screen @@ -8317,7 +8444,7 @@ tcl::namespace::eval punk::args { } else { set member_satisfied 1 foreach v_member $v { - set cwm [choiceword_match $v_member $cw_nocase $cw_allchoices $cw_aliases $cw_prefix $cw_deny $cw_reserve] + set cwm [choiceword_match $v_member $cw_nocase $cw_allchoices $cw_aliases $cw_prefix $cw_deny $cw_reserve $cw_unavail] if {![tcl::dict::get $cwm matched]} { set member_satisfied 0 break @@ -8489,7 +8616,14 @@ tcl::namespace::eval punk::args { #words like lseq's 'to' - overflow remains the clearer report). if {[llength $thistype] == 1} { if {$member_choicechecked} { - set rejection [tcl::dict::create kind choice argname $thisname word $v choices $cw_allchoices nocase $cw_nocase prefix $cw_prefix] + if {$member_cwm ne "" && [tcl::dict::get $member_cwm unavailable]} { + #G-073: the screen's non-match was a landing on a + #recognised-but-unavailable name - record the distinct kind so + #raise-time selection can emit the tailored report + set rejection [tcl::dict::create kind unavailable argname $thisname word $v name [tcl::dict::get $member_cwm canonical] choices $cw_allchoices] + } else { + set rejection [tcl::dict::create kind choice argname $thisname word $v choices $cw_allchoices nocase $cw_nocase prefix $cw_prefix] + } } elseif {[llength $ctg_other]} { set rejection [tcl::dict::create kind type argname $thisname word $v type $tp] } @@ -9304,6 +9438,30 @@ tcl::namespace::eval punk::args { #rename get_dict # + #G-073: assemble the tailored recognised-but-unavailable rejection message. + #Shared by final validation and the G-082 allocation-rejection raise sites so the + #report is identical wherever the unavailable landing surfaces. supplied = the + #check-form word as received; name = the resolved -choiceunavailable entry; + #choicelabeldict provides the entry's documentation note when present (the wording + #steers the user: the note names the why - e.g a version boundary). + proc private::unavailable_choice_msg {argclass argname supplied name choicelabeldict allchoices} { + if {$supplied eq $name} { + set msg "$argclass '$argname' for %caller%: '$name' is a recognised name here, but is not available in this runtime/context." + } else { + set msg "$argclass '$argname' for %caller%: '$supplied' resolves to '$name' - a recognised name that is not available in this runtime/context." + } + if {[tcl::dict::exists $choicelabeldict $name]} { + append msg "\n note:" + foreach ln [split [tcl::dict::get $choicelabeldict $name] \n] { + append msg "\n [string trim $ln]" + } + } + if {[llength $allchoices]} { + append msg "\nAvailable values:\n [join $allchoices "\n "]" + } + return $msg + } + #G-040: the single implementation of choice-word matching - shared by argument parsing #(get_dict) and the punk::ns doc-lookup walk (cmd_traverse), so 'i ' #resolution can never diverge from what parsing accepts. @@ -9323,8 +9481,18 @@ tcl::namespace::eval punk::args { prefix, or via an alias) exact - boolean: the raw stored word already equals the resulting choice (no rewrite needed) - canonical - the resulting choice value (empty when not matched)" - @values -min 7 -max 7 + canonical - the resulting choice value (empty when not matched, + EXCEPT when unavailable is 1 - it then carries the + matched unavailable name) + unavailable - boolean (G-073): the word landed - exactly, or as a + unique prefix - on a -choiceunavailable entry + (recognised but not available). matched stays 0; + callers wanting the tailored unavailability report + consult this key, existing matched-only consumers + treat it as an ordinary non-match. A prefix shared + between an available and an unavailable name is a + plain ambiguous non-match (unavailable 0)." + @values -min 7 -max 8 word -type string -help\ "The supplied word. Callers pass the check-form, e.g ansistripped when applicable" @@ -9340,8 +9508,12 @@ tcl::namespace::eval punk::args { "-choiceprefixdenylist (full word required for these names)" reservelist -type list -help\ "-choiceprefixreservelist (phantom prefix-calculation members)" + unavailablelist -type list -optional 1 -default {} -help\ + "-choiceunavailable (recognised-but-unavailable names - prefix-pool + members like the reservelist, but a word landing on one reports + unavailable 1 with the name as canonical) (G-073)" }] - proc choiceword_match {word nocase allchoices choicealiases choiceprefix denylist reservelist} { + proc choiceword_match {word nocase allchoices choicealiases choiceprefix denylist reservelist {unavailablelist {}}} { set aliasnames [tcl::dict::keys $choicealiases] set has_choicealiases [expr {[llength $aliasnames] > 0}] set choicealiases_nocase [tcl::dict::create] @@ -9360,6 +9532,7 @@ tcl::namespace::eval punk::args { set chosen "" set choice_in_list 0 set choice_exact_match 0 + set unavailable_hit 0 ;#G-073 recognised-but-unavailable landing if {$choiceprefix} { #can we handle empty string as a choice? It should just work - REVIEW/test if {$word in $allchoices} { @@ -9386,6 +9559,14 @@ tcl::namespace::eval punk::args { #exact alias match differing only by case - normalize to the canonical choice set chosen [tcl::dict::get $choicealiases_nocase $v_test] set choice_in_list 1 + } elseif {[llength $unavailablelist] && ($word in $unavailablelist || ($nocase && [lsearch -exact -nocase $unavailablelist $word] >= 0))} { + #G-073: exact match (case per -nocase) on a recognised-but-unavailable name + set unavailable_hit 1 + if {$word in $unavailablelist} { + set chosen $word + } else { + set chosen [lsearch -inline -exact -nocase $unavailablelist $word] + } } else { #PREFIX check required - any match here is not an exact match or it would have matched above. #in this block we can treat empty result from prefix match as a non-match @@ -9393,10 +9574,19 @@ tcl::namespace::eval punk::args { if {$nocase} { #nocase prefixing with case-dups: see the -choiceprefixdenylist nocase notes at the original #get_dict site - counterintuitive DEL/delete/Delete edge cases are documented feature-not-bug - set bestmatch [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$aliasnames {*}$reservelist] $word] - if {$bestmatch eq "" || $bestmatch in $reservelist} { - set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $choices_test] {*}[tcl::dict::keys $choicealiases_nocase] {*}$reservelist] $v_test] - if {$chosen ne "" && [tcl::dict::exists $choicealiases_nocase $chosen]} { + set bestmatch [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$aliasnames {*}$reservelist {*}$unavailablelist] $word] + if {$bestmatch ne "" && $bestmatch in $unavailablelist} { + #G-073: prefix landed uniquely on an unavailable name + set unavailable_hit 1 + set chosen $bestmatch + } elseif {$bestmatch eq "" || $bestmatch in $reservelist} { + set unavailablelist_lc [string tolower $unavailablelist] + set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $choices_test] {*}[tcl::dict::keys $choicealiases_nocase] {*}$reservelist {*}$unavailablelist_lc] $v_test] + if {$chosen ne "" && $chosen in $unavailablelist_lc} { + #G-073: nocase prefix landed uniquely on an unavailable name - report with its defined casing + set unavailable_hit 1 + set chosen [lsearch -inline -exact -nocase $unavailablelist $chosen] + } elseif {$chosen ne "" && [tcl::dict::exists $choicealiases_nocase $chosen]} { #matched an alias (lowercased) - deny applies to the alias name, then normalize if {[lsearch -nocase $denylist $chosen] >= 0} { set chosen "" @@ -9427,10 +9617,15 @@ tcl::namespace::eval punk::args { } } } else { - set matchedname [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$aliasnames {*}$reservelist] $word] + set matchedname [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$aliasnames {*}$reservelist {*}$unavailablelist] $word] if {$matchedname eq "" || $matchedname in $reservelist} { set chosen "" set choice_in_list 0 + } elseif {$matchedname in $unavailablelist} { + #G-073: prefix landed uniquely on an unavailable name + set unavailable_hit 1 + set chosen $matchedname + set choice_in_list 0 } elseif {$matchedname in $aliasnames} { #prefix landed on an alias - deny applies to the alias name, then normalize if {$matchedname in $denylist} { @@ -9448,9 +9643,11 @@ tcl::namespace::eval punk::args { } #don't allow prefixing for elements from -choiceprefixdenylist #we still use all elements to calculate the prefixes though - #(a canonical reached via an alias is exempt - deny was already applied to the alias name) + #(a canonical reached via an alias is exempt - deny was already applied to the alias name; + # an unavailable landing is exempt - deny applies to choices, and the unavailable + # indication must survive to drive the tailored report) #review - case difference edge cases in choiceprefixdenylist !todo - if {!$prefix_via_alias && $chosen in $denylist} { + if {!$unavailable_hit && !$prefix_via_alias && $chosen in $denylist} { set choice_in_list 0 set chosen "" } @@ -9470,9 +9667,17 @@ tcl::namespace::eval punk::args { #exact alias match differing only by case - normalize to the canonical choice set chosen [tcl::dict::get $choicealiases_nocase $v_test] set choice_in_list 1 + } elseif {[llength $unavailablelist] && ($word in $unavailablelist || ($nocase && [lsearch -exact -nocase $unavailablelist $word] >= 0))} { + #G-073: exact match (case per -nocase) on a recognised-but-unavailable name + set unavailable_hit 1 + if {$word in $unavailablelist} { + set chosen $word + } else { + set chosen [lsearch -inline -exact -nocase $unavailablelist $word] + } } } - return [tcl::dict::create matched $choice_in_list exact $choice_exact_match canonical $chosen] + return [tcl::dict::create matched $choice_in_list exact $choice_exact_match canonical $chosen unavailable $unavailable_hit] } #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values @@ -10971,6 +11176,15 @@ tcl::namespace::eval punk::args { } else { #required named arg if {$leadername ni $leadernames_received} { + #G-082 follow-on (0.15.2): mirrored from the values loop below + #(per the MAINTENANCE contract above) - a present word that + #failed this required leader's basic-type screen reports the + #pointed typemismatch instead of the generic shortfall. + if {$rj ne "" && [dict get $rj kind] eq "type" && [dict get $rj argname] eq $leadername} { + set rj_type [dict get $rj type] + set msg "Leading argument '$leadername' for %caller% requires type '$rj_type'. Received: '$ldr'" + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $rj_type] -badarg $leadername -badval $ldr -argspecs $argspecs]] $msg + } #puts stderr "private::get_dict_can_assign_value $ldridx $values $nameidx $VAL_NAMES" set msg "Bad number of leaders for %caller%. Not enough remaining values to assign to required arguments (fail on $leadername)." return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list missingrequiredleader $leadername ] -badarg $leadername -argspecs $argspecs]] $msg @@ -11087,6 +11301,12 @@ tcl::namespace::eval punk::args { set rj_choices [dict get $rj choices] set msg "$rj_argclass '$rj_argname' for %caller% must be one of the listed values:\n [join $rj_choices "\n "]\n$rj_casemsg$rj_prefixmsg. Received: '$ldr'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $ldr choices $rj_choices] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg + } elseif {[dict get $rj kind] eq "unavailable"} { + #G-073: recognised-but-unavailable landing recorded by the + #allocation screen - the tailored report, as final validation gives + set rj_name [dict get $rj name] + set msg [private::unavailable_choice_msg $rj_argclass $rj_argname $ldr $rj_name [Dict_getdef $argstate $rj_argname -choicelabels {}] [dict get $rj choices]] + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceunavailable $rj_name choices [dict get $rj choices]] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg } else { set rj_type [dict get $rj type] set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '$ldr'" @@ -11213,6 +11433,19 @@ tcl::namespace::eval punk::args { } else { #required named arg if {$valname ni $valnames_received} { + #G-082 follow-on (0.15.2): a word IS present but failed this + #required argument's basic-type allocation screen - report the + #pointed typemismatch (same message/errorcode shape as the + #overflow-site selection below) instead of the generic + #missingrequiredvalue shortfall. Only kind 'type' can arrive + #here (choice screens never apply to required args - G-071 + #asymmetry); literal mismatches and multi-member clauses record + #no rejection, so those shapes keep the shortfall report. + if {$rj ne "" && [dict get $rj kind] eq "type" && [dict get $rj argname] eq $valname} { + set rj_type [dict get $rj type] + set msg "Trailing argument '$valname' for %caller% requires type '$rj_type'. Received: '$val'" + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $rj_type] -badarg $valname -badval $val -argspecs $argspecs]] $msg + } #puts stderr "private::get_dict_can_assign_value $validx $values $nameidx $VAL_NAMES" set msg "Bad number of values for %caller%. Not enough remaining values to assign to required arguments (fail on $valname)." return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list missingrequiredvalue $valname ] -badarg $valname -argspecs $argspecs]] $msg @@ -11325,6 +11558,13 @@ tcl::namespace::eval punk::args { set rj_choices [dict get $rj choices] set msg "$rj_argclass '$rj_argname' for %caller% must be one of the listed values:\n [join $rj_choices "\n "]\n$rj_casemsg$rj_prefixmsg. Received: '$val'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $val choices $rj_choices] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg + } elseif {[dict get $rj kind] eq "unavailable"} { + #G-073: recognised-but-unavailable landing recorded by the + #allocation screen - the tailored report, as final validation gives + #(MAINTENANCE - same selection logic as leaders loop above) + set rj_name [dict get $rj name] + set msg [private::unavailable_choice_msg $rj_argclass $rj_argname $val $rj_name [Dict_getdef $argstate $rj_argname -choicelabels {}] [dict get $rj choices]] + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceunavailable $rj_name choices [dict get $rj choices]] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg } else { set rj_type [dict get $rj type] set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '$val'" @@ -11733,6 +11973,9 @@ tcl::namespace::eval punk::args { #setting) and as prefix-calculation members when -choiceprefix is true; matched aliases #normalize to their canonical choice in the parse result (see choiceword_match). set choicealiases [Dict_getdef $thisarg -choicealiases {}] + #-choiceunavailable (G-073): recognised-but-unavailable names - prefix-pool members; + #a word landing on one earns the tailored choiceunavailable rejection below. + set choiceunavailable [Dict_getdef $thisarg -choiceunavailable {}] set choicerestricted [tcl::dict::get $thisarg -choicerestricted] set choicemultiple [tcl::dict::get $thisarg -choicemultiple] if {[string is integer -strict $choicemultiple]} { @@ -11810,7 +12053,7 @@ tcl::namespace::eval punk::args { #G-040: choice-word matching delegated to the shared resolver #(punk::args::choiceword_match - also consumed by the punk::ns doc-lookup # walk, so 'i ' resolution cannot diverge from parsing) - set matchinfo [choiceword_match $c_check $nocase $allchoices $choicealiases $choiceprefix $choiceprefixdenylist $choiceprefixreservelist] + set matchinfo [choiceword_match $c_check $nocase $allchoices $choicealiases $choiceprefix $choiceprefixdenylist $choiceprefixreservelist $choiceunavailable] set choice_in_list [tcl::dict::get $matchinfo matched] set choice_exact_match [tcl::dict::get $matchinfo exact] set chosen [tcl::dict::get $matchinfo canonical] @@ -11887,6 +12130,16 @@ tcl::namespace::eval punk::args { } else { #unhappy path + #G-073: the word landed (exact, or unique prefix) on a + #recognised-but-unavailable name - tailored report naming the + #entry and its -choicelabels note instead of the generic + #listed-values error. + if {[tcl::dict::get $matchinfo unavailable]} { + set cu_name [tcl::dict::get $matchinfo canonical] + set msg [private::unavailable_choice_msg $argclass $argname $c_check $cu_name [Dict_getdef $thisarg -choicelabels {}] $allchoices] + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceunavailable $cu_name choices $allchoices] -badarg $argname -badval $c_check -argspecs $argspecs]] $msg + } + #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} { @@ -11894,11 +12147,20 @@ tcl::namespace::eval punk::args { #review - case if {$nocase} { set longermatches [lsearch -all -inline -nocase $allchoices "$c_check*"] + set longermatches_unavail [lsearch -all -inline -nocase $choiceunavailable "$c_check*"] } else { set longermatches [lsearch -all -inline $allchoices "$c_check*"] + set longermatches_unavail [lsearch -all -inline $choiceunavailable "$c_check*"] + } + #G-073: unavailable names participate in prefix ambiguity - + #display them annotated so the ambiguity is explicable, but + #never as selectable suggestions + set longermatches_display $longermatches + foreach cu_lm $longermatches_unavail { + lappend longermatches_display "$cu_lm (recognised but unavailable)" } - 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'" + if {[llength $longermatches] || [llength $longermatches_unavail] > 1} { + set msg "$argclass '$argname' for %caller% seems to be an ambiguous prefix. Try one of:\n [join $longermatches_display "\n "]\n$casemsg$prefixmsg. Received: '$c_check'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $c choices $allchoices] -badarg $argname -badval $c_check -argspecs $argspecs]] $msg } } else { @@ -14365,7 +14627,7 @@ package provide punk::args [tcl::namespace::eval punk::args { tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version - set version 0.15.1 + set version 0.17.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.3.4.tm b/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.4.0.tm similarity index 99% rename from src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.3.4.tm rename to src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.4.0.tm index 6e1ecebe..f54c012e 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.3.4.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.4.0.tm @@ -8,7 +8,7 @@ # (C) 2025 # # @@ Meta Begin -# Application punk::args::moduledoc::tclcore 0.3.4 +# Application punk::args::moduledoc::tclcore 0.4.0 # Meta platform tcl # Meta license MIT # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args::moduledoc::tclcore 0 0.3.4] +#[manpage_begin punkshell_module_punk::args::moduledoc::tclcore 0 0.4.0] #[copyright "2025"] #[titledesc {punk::args definitions for tcl core commands}] [comment {-- Name section and table of contents description --}] #[moddesc {tcl core argument definitions}] [comment {-- Description at end of page heading --}] @@ -46,7 +46,7 @@ #[list_begin itemized] package require Tcl 8.6- -package require punk::args +package require punk::args 0.16.0- ;#G-073: 'string is' model uses -choiceunavailable package require punk::ansi package require textblock #*** !doctools @@ -9884,6 +9884,21 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { set string_is_classes {alnum alpha ascii boolean control dict digit double entier false graph integer list lower print punct space true upper wideinteger wordchar xdigit} } set string_is_classes [lsort $string_is_classes] ;#display order (as the previous hand-written list) + #G-073: curated forward-class list - classes later Tcl versions provide that THIS + #runtime may lack. On such runtimes (8.6 for dict) the model declares them + #-choiceunavailable: displayed among the choices with their version-note label, + #reserving prefixes (so an 8.6 user's 'string is di' habit is broken before 9.x + #makes it genuinely ambiguous), and rejected with the tailored unavailability + #message. The list is explicitly curated, never derived: 'unicode' is deliberately + #EXCLUDED - it exists only in the unreleased 8.7 series (removed in Tcl 9) and is + #never a forward target. + set string_is_forward_classes {dict} + set string_is_unavailable [list] + foreach _sis_c $string_is_forward_classes { + if {$_sis_c ni $string_is_classes} { + lappend string_is_unavailable $_sis_c + } + } #hand-written class descriptions (man-page derived, verbatim) - applied below only for #classes the running interpreter accepts; accepted classes without an entry get a #generic label. tstr here resolves the ${$A_WARN}/${$A_RST} highlights as before. @@ -10011,6 +10026,17 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { append string_is_choicelabels [list $_sis_c] " " [list " (class accepted by this Tcl\n runtime - not yet described\n in the punk tclcore docs)"] \n } } + #G-073: unavailable (forward) classes carry their static description as an ordinary + #choicelabel - it renders in the Unavailable display group, feeds the tailored + #rejection message's note, and drives the per-class virtual id loop below (so + #'i string is dict' documents the class on 8.6 from the same static description). + foreach _sis_c $string_is_unavailable { + if {[dict exists $string_is_class_descriptions $_sis_c]} { + append string_is_choicelabels [list $_sis_c] " " [list [dict get $string_is_class_descriptions $_sis_c]] \n + } else { + append string_is_choicelabels [list $_sis_c] " " [list " (recognised forward class -\n not present in this Tcl\n runtime)"] \n + } + } unset -nocomplain _sis_msg _sis_csv _sis_c punk::args::define [punk::args::lib::tstr -return string { @@ -10024,6 +10050,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @leaders -min 1 -max 1 class -type string\ -choices {${$string_is_classes}}\ + -choiceunavailable {${$string_is_unavailable}}\ -choicelabels {${$string_is_choicelabels}}\ -help\ "character class @@ -12583,7 +12610,7 @@ namespace eval ::punk::args::register { package provide punk::args::moduledoc::tclcore [tcl::namespace::eval punk::args::moduledoc::tclcore { variable pkg punk::args::moduledoc::tclcore variable version - set version 0.3.4 + set version 0.4.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm index 3882931a..4dfdbed0 100644 Binary files a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm and b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm differ diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.2.tm b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.3.tm similarity index 99% rename from src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.2.tm rename to src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.3.tm index b0c1a8f8..af297a1d 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.2.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.3.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ns 0.9.2 +# Application punk::ns 0.9.3 # Meta platform tcl # Meta license # @@ Meta End @@ -4924,6 +4924,7 @@ y" {return quirkykeyscript} [punk::args::system::Dict_getdef $pf_arginfo -choiceprefix 1]\ [punk::args::system::Dict_getdef $pf_arginfo -choiceprefixdenylist {}]\ [punk::args::system::Dict_getdef $pf_arginfo -choiceprefixreservelist {}]\ + [punk::args::system::Dict_getdef $pf_arginfo -choiceunavailable {}]\ ] if {[dict get $pf_matchinfo matched]} { set pf_canonical [dict get $pf_matchinfo canonical] @@ -5067,9 +5068,19 @@ y" {return quirkykeyscript} } #G-040: resolve the subcommand word with the same shared resolver argument #parsing uses (punk::args::choiceword_match) - so aliases normalize to their - #canonical (choiceinfo is keyed on canonicals), -choiceprefixdenylist and - #-choiceprefixreservelist are honoured, and 'i ' can never accept - #a word that parsing would reject. + #canonical (choiceinfo is keyed on canonicals), -choiceprefixdenylist, + #-choiceprefixreservelist and -choiceunavailable (G-073) are honoured. + #Scope of that parity claim: CHOICE-WORD RESOLUTION - this traverse never + #treats a word as identifying a choice that parsing would reject (unknown, + #ambiguous, denied, reserved and unavailable words all resolve no choice + #here). Documentation ADDRESSING is a separate, deliberately broader axis: + #the exact space-form docid checks (id_exists, earlier in the walk) reach + #doc-only ids without implying the word parses - that is how per-class ids + #like 'string is true' have always documented argument words, and how an + #UNAVAILABLE word's virtual id ('string is dict' on 8.6) documents since + #G-073. Consequence: cmdinfo classes both landings 'doconly' with no + #availability distinction - surfacing that (cmdinfo axis / render marking) + #is deliberately not decided here. set ct_matchinfo [punk::args::choiceword_match $q\ [punk::args::system::Dict_getdef $arginfo -nocase 0]\ $allchoices\ @@ -5077,6 +5088,7 @@ y" {return quirkykeyscript} [dict get $arginfo -choiceprefix]\ [punk::args::system::Dict_getdef $arginfo -choiceprefixdenylist {}]\ [punk::args::system::Dict_getdef $arginfo -choiceprefixreservelist {}]\ + [punk::args::system::Dict_getdef $arginfo -choiceunavailable {}]\ ] if {![dict get $ct_matchinfo matched]} { #no match under parse rules (covers: unknown word, ambiguous prefix, @@ -6734,6 +6746,6 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ns [tcl::namespace::eval punk::ns { variable version - set version 0.9.2 + set version 0.9.3 }] return