jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

update bootsupport + vfs + layout bootsupport: punk::args 0.4.2, punk::ns 0.1.4 

Build outputs from 'make.tcl project' (punkcheck-managed old->new version renames:
args-0.4.0/ns-0.1.3 pruned, args-0.4.2/ns-0.1.4 installed across src/bootsupport,
_vfscommon.vfs and the punk.project/punk.shell layout bootsupport copies).

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 6 days ago
parent
02da46eb74
commit
ef14dbbe91
8 changed files with 1972 additions and 640 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 605
      src/bootsupport/modules/punk/args-0.4.2.tm
  2. 46
      src/bootsupport/modules/punk/ns-0.1.4.tm
  3. 605
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.4.2.tm
  4. 46
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.4.tm
  5. 605
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.4.2.tm
  6. 46
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.4.tm
  7. 605
      src/vfs/_vfscommon.vfs/modules/punk/args-0.4.2.tm
  8. 46
      src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.4.tm

605
src/bootsupport/modules/punk/args-0.4.0.tm → src/bootsupport/modules/punk/args-0.4.2.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024 # (C) 2024
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::args 0.4.0 # Application punk::args 0.4.2
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -18,7 +18,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::args 0 0.4.0] #[manpage_begin punkshell_module_punk::args 0 0.4.2]
#[copyright "2024"] #[copyright "2024"]
#[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[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 --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}]
@ -1266,6 +1266,7 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[id_exists $id]} { if {[id_exists $id]} {
if {!$quiet} { if {!$quiet} {
puts stderr "punk::args::undefine clearing existing data for id:$id" puts stderr "punk::args::undefine clearing existing data for id:$id"
@ -1274,11 +1275,13 @@ tcl::namespace::eval punk::args {
set deflist [dict get $id_cache_rawdef $id] set deflist [dict get $id_cache_rawdef $id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} else { } else {
dict for {k v} $rawdef_cache_argdata { dict for {k v} $rawdef_cache_argdata {
if {[dict get $v id] eq $id} { if {[dict get $v id] eq $id} {
dict unset rawdef_cache_argdata $k dict unset rawdef_cache_argdata $k
dict unset argdefcache_display $k
} }
} }
dict for {k v} $rawdef_cache_about { dict for {k v} $rawdef_cache_about {
@ -1315,15 +1318,389 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[dict exists $rawdef_cache_about $deflist -id]} { if {[dict exists $rawdef_cache_about $deflist -id]} {
set id [dict get $rawdef_cache_about $deflist -id] set id [dict get $rawdef_cache_about $deflist -id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} }
} }
# -- --- --- --- --- --- --- --- --- --- ---
# G-046 display-field deferral
# Expansion of ${...} content landing in display-only fields (-help on @cmd/@examples
# and argument records, @formdisplay -header/-body) is deferred out of resolve: the
# parse spec stores inert tokens plus a DISPLAY_DEFERRED map, and display consumers
# (arg_error, eg, resolved_def) expand on demand via private::expand_display_fields.
# -choicelabels stays eager - punk::ns reads it directly from parse specs during the
# subcommand walk.
variable argdefcache_display [tcl::dict::create] ;#display-expanded specs (non-dynamic definitions), keyed by raw deflist
variable display_expanding [list] ;#definition ids currently being display-expanded (reentrancy guard)
proc private::split_definition_records {optionspecs} {
#definition text -> list of records (factored out of resolve - G-046)
#records are delimited by newlines, but multiline values are allowed if properly
#quoted/braced - 'info complete' (on ansi-stripped accumulation) finds record ends.
set records [list]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
if {$in_record_continuation} {
#trim only the whitespace corresponding to the record indent - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#(note string first "" $str is fast and returns -1)
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
} else {
assert {$record_line == 0} punk::args::private::split_definition_records record_line
regexp {(\s*).*} $rawline _all record_base_indent
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
return $records
}
proc private::classify_display_tokens {placeholdertext tokenlist} {
#G-046: return the subset of tokenlist whose tokens land in display-only field
#values. Display-only: -help on @cmd/@examples and on argument records, and
#@formdisplay -header/-body. Everything else (record names, -choices, -default,
#-choicelabels, @form -synopsis, directive settings) is parse/synopsis-relevant
#and stays eagerly expanded.
set display_tokens [list]
if {![llength $tokenlist]} {
return $display_tokens
}
set records [split_definition_records $placeholdertext]
foreach rec $records {
set trimrec [tcl::string::trim $rec]
switch -- [tcl::string::index $trimrec 0] {
"" - # {continue}
}
if {[catch {set record_values [lassign $trimrec firstword]}]} {
continue ;#unparseable here - real errors surface in resolve's own record loop
}
if {[llength $record_values] % 2 != 0} {
continue
}
switch -glob -- $firstword {
@cmd - @examples {
set displaykeys {-help}
}
@formdisplay {
set displaykeys {-header -body}
}
@* {
set displaykeys {}
}
default {
#argument record
set displaykeys {-help}
}
}
if {![llength $displaykeys]} {continue}
foreach {k v} $record_values {
if {$k in $displaykeys && [string first \x01PADEFER $v] >= 0} {
foreach tk $tokenlist {
if {$tk ni $display_tokens && [string first $tk $v] >= 0} {
lappend display_tokens $tk
}
}
}
}
}
return $display_tokens
}
proc private::mask_display_params {normargs defspace is_dynamic} {
#G-046 phases 0-2: extract ${...} params without evaluation (tstr -eval 0),
#classify which land in display-only fields, and return
# [list <blocks-with-display-params-masked-by-inert-tokens> <deferred map>]
#Blocks without display params are returned untouched (original text) so the
#normal tstr path processes them bit-identically.
set blockparts [list]
set tokenlist [list]
set n 0
set phtext ""
foreach block $normargs {
if {[string first \$\{ $block] >= 0} {
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $block] ptlist paramlist
set btokens [list]
set phblock ""
set i 0
foreach param $paramlist {
set tk [tcl::string::cat \x01 PADEFER [incr n] \x02]
append phblock [lindex $ptlist $i] $tk
lappend btokens $tk
incr i
}
append phblock [lindex $ptlist $i]
lappend blockparts [list 1 $ptlist $paramlist $btokens]
lappend tokenlist {*}$btokens
append phtext $phblock \n
} else {
lappend blockparts [list 0 {} {} {}]
append phtext $block \n
}
}
if {![llength $tokenlist]} {
return [list $normargs {}]
}
set display_tokens [classify_display_tokens $phtext $tokenlist]
if {![llength $display_tokens]} {
return [list $normargs {}]
}
set deferred [tcl::dict::create]
set outblocks [list]
foreach block $normargs bp $blockparts {
lassign $bp hasparams ptlist paramlist btokens
if {!$hasparams} {
lappend outblocks $block
continue
}
set block_display 0
foreach tk $btokens {
if {$tk in $display_tokens} {
set block_display 1
break
}
}
if {!$block_display} {
lappend outblocks $block
continue
}
set masked ""
set i 0
foreach param $paramlist tk $btokens {
append masked [lindex $ptlist $i]
if {$tk in $display_tokens} {
append masked $tk
tcl::dict::set deferred $tk [tcl::dict::create source $param defspace $defspace dynamic $is_dynamic]
} else {
#parse-relevant param - reconstruct for normal tstr evaluation
append masked [tcl::string::cat \$\{ $param \}]
}
incr i
}
append masked [lindex $ptlist $i]
lappend outblocks $masked
}
return [list $outblocks $deferred]
}
proc private::expand_display_fields {spec} {
#G-046: expand deferred display-field content of a parse spec on demand.
#Returns the spec with display fields expanded and DISPLAY_DEFERRED emptied.
#Non-dynamic expansions are cached (keyed by raw deflist); @dynamic definitions
#re-expand each call so provider changes refresh (matching resolve semantics).
if {![tcl::dict::exists $spec DISPLAY_DEFERRED]} {
return $spec
}
set map [tcl::dict::get $spec DISPLAY_DEFERRED]
if {![tcl::dict::size $map]} {
return $spec
}
set id [tcl::dict::get $spec id]
upvar ::punk::args::id_cache_rawdef id_cache_rawdef
upvar ::punk::args::rawdef_cache_about rawdef_cache_about
upvar ::punk::args::argdefcache_display argdefcache_display
set deflist ""
set spec_dynamic 0
if {[tcl::dict::exists $id_cache_rawdef $id]} {
set deflist [tcl::dict::get $id_cache_rawdef $id]
if {[tcl::dict::exists $rawdef_cache_about $deflist -dynamic]} {
set spec_dynamic [tcl::dict::get $rawdef_cache_about $deflist -dynamic]
}
}
if {!$spec_dynamic && $deflist ne "" && [tcl::dict::exists $argdefcache_display $deflist]} {
return [tcl::dict::get $argdefcache_display $deflist]
}
upvar ::punk::args::display_expanding display_expanding
if {$id in $display_expanding} {
#reentrancy: deferred content is (indirectly) rendering help for an id whose
#display expansion is already in progress. Substitute the raw ${...} sources
#instead of evaluating - resolves cleanly, never loops. Not cached.
return [expand_display_slots $spec $map raw]
}
lappend display_expanding $id
try {
set spec [expand_display_slots $spec $map eval]
} finally {
set posn [lsearch -exact $display_expanding $id]
set display_expanding [lreplace $display_expanding $posn $posn]
}
tcl::dict::set spec DISPLAY_DEFERRED {}
if {!$spec_dynamic && $deflist ne ""} {
tcl::dict::set argdefcache_display $deflist $spec
}
return $spec
}
proc private::expand_display_slots {spec map mode} {
#walk the display-only slots of a spec and expand deferred tokens in place
foreach infokey {cmd_info examples_info} {
if {[tcl::dict::exists $spec $infokey -help]} {
set v [tcl::dict::get $spec $infokey -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec $infokey -help [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {fid fdict} [tcl::dict::get $spec FORMS] {
if {[tcl::dict::exists $fdict FORMDISPLAY]} {
tcl::dict::for {k v} [tcl::dict::get $fdict FORMDISPLAY] {
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid FORMDISPLAY $k [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {argname arginfo} [tcl::dict::get $fdict ARG_INFO] {
if {[tcl::dict::exists $arginfo -help]} {
set v [tcl::dict::get $arginfo -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid ARG_INFO $argname -help [expand_deferred_text $v $map $mode]
}
}
}
}
return $spec
}
proc private::expand_deferred_text {text map mode} {
#replace deferred display tokens in a field value.
#mode 'eval': substitute each token's ${...} source in its recorded definition
#namespace; @dynamic sources get the second substitution round (the ${$DYN_X}
#idiom). mode 'raw': substitute the raw ${...} source text (reentrancy path).
#Multiline results align continuation lines with the leading whitespace of the
#token's line - the same 'line' paramindents treatment punk::args::lib::tstr
#applies to eagerly expanded params (G-046 item 2 for the @dynamic path).
set out ""
set firstline 1
foreach ln [split $text \n] {
if {!$firstline} {
append out \n
}
set firstline 0
if {[string first \x01PADEFER $ln] < 0} {
append out $ln
continue
}
regexp {^(\s*)} $ln _all lineindent
while {[regexp -indices {\x01PADEFER[0-9]+\x02} $ln tokenposns]} {
lassign $tokenposns t0 t1
set token [string range $ln $t0 $t1]
set replacement ""
if {[tcl::dict::exists $map $token]} {
set param [tcl::dict::get $map $token source]
set defspace [tcl::dict::get $map $token defspace]
set dynamic [tcl::dict::get $map $token dynamic]
if {$defspace eq ""} {
set defspace ::
}
if {$mode eq "raw"} {
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {[catch {tcl::namespace::eval $defspace [list ::subst $param]} presult]} {
#tstr behaviour on evaluation error: substitute the raw placeholder source
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {$dynamic && [string first \$\{ $presult] >= 0} {
#@dynamic second-round substitution
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $presult] ptlist2 paramlist2
set r2 ""
set i 0
foreach param2 $paramlist2 {
append r2 [lindex $ptlist2 $i]
if {[catch {tcl::namespace::eval $defspace [list ::subst $param2]} p2result]} {
append r2 [tcl::string::cat \$\{ $param2 \}]
} else {
append r2 $p2result
}
incr i
}
append r2 [lindex $ptlist2 $i]
set presult $r2
}
set replacement $presult
}
}
}
if {$lineindent ne "" && [string first \n $replacement] >= 0} {
set rlines [split $replacement \n]
set replacement [lindex $rlines 0]
foreach rl [lrange $rlines 1 end] {
append replacement \n $lineindent $rl
}
}
set ln [string replace $ln $t0 $t1 $replacement]
}
append out $ln
}
return $out
}
# -- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::args::resolve @id -id ::punk::args::resolve
@cmd -name punk::args::resolve\ @cmd -name punk::args::resolve\
@ -1403,12 +1780,14 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: -help section processing is sometimes expensive (e.g tcl syntax
#highlighted examples) and isn't required for parsing of arguments. Display-only
#${...} params are masked with inert tokens here and expanded on demand at
#display time (private::expand_display_fields) with a separate cache.
set deferred_display {}
lassign [private::mask_display_params $normargs $defspace 0] normargs deferred_display
set optionspecs [list] set optionspecs [list]
#REVIEW - whilst this is only done once for each command definition, the -help section processing is sometimes expensive,
#and isn't required for parsing of arguments, so it unnecessarily slows first use of a command that uses punk::args and is heavily documented,
#especially if it has tcl syntax highlighted examples.
#- ideally we would delay expansion of -help sections until needed for display,
#and use a different cache key for the parsing vs display versions of the resolved definition.
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
if {$defspace ne ""} { if {$defspace ne ""} {
@ -1443,10 +1822,11 @@ tcl::namespace::eval punk::args {
#} #}
} else { } else {
set deferred_display {}
if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} {
#cached - so first round of substitution already done #cached - so first round of substitution already done
set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key]
lassign $pt_params ptlist paramlist lassign $pt_params ptlist paramlist deferred_display
set optionspecs "" set optionspecs ""
#subst is only being called on the parameters (contents of ${..}) #subst is only being called on the parameters (contents of ${..})
foreach pt $ptlist param $paramlist { foreach pt $ptlist param $paramlist {
@ -1463,6 +1843,11 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: mask display-only ${...} params (see non-dynamic branch note).
#Masked at round 1, so display payloads (including their round-2
#${$DYN_X} providers) never run during argument resolution.
lassign [private::mask_display_params $normargs $defspace 1] normargs deferred_display
set optionspecs [list] set optionspecs [list]
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
@ -1498,8 +1883,8 @@ tcl::namespace::eval punk::args {
append optionspecs $pt [uplevel $LVL [list ::subst $param]] append optionspecs $pt [uplevel $LVL [list ::subst $param]]
} }
} }
#key is the raw def, value is the 2 element list of textparts, paramparts #key is the raw def, value is the list of textparts, paramparts (and the G-046 deferred display map)
tcl::dict::set argdefcache_unresolved $cache_key $pt_params tcl::dict::set argdefcache_unresolved $cache_key [list {*}$pt_params $deferred_display]
} else { } else {
#wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition #wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition
puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required" puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required"
@ -1557,141 +1942,7 @@ tcl::namespace::eval punk::args {
#set opt_solos [list] #set opt_solos [list]
#first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end #first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end
set records [list] set records [private::split_definition_records $optionspecs]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
#puts "indent1:[ansistring VIEW $record_base_indent]"
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
#append linebuild [string trimleft $rawline] \n
if {$in_record_continuation} {
#incr record_line
#if {$record_line == 1} {
# #first continuation line sets the indent
#}
#///
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
#trim only the whitespace corresponding to last record indent or record_base_indent + 4 spaces - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent.
#ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position.
#(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW)
#(note string first "" $str is fast and returns -1)
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
} else {
assert {$record_line == 0} punk::args::resolve record_line
regexp {(\s*).*} $rawline _all record_base_indent
#puts "indent: [ansistring VIEW -lf 1 $record_base_indent]"
#puts "indent from rawline:$rawline "
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
#trim only the whitespace corresponding to record_base_indent or record_base_indent + 4 spaces - not all whitespace on left
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline
#} else {
# append linebuild $rawline
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {} set cmd_info {}
set package_info {} set package_info {}
@ -1854,7 +2105,9 @@ tcl::namespace::eval punk::args {
#however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable?
if {[dict exists $at_specs -id]} { if {[dict exists $at_specs -id]} {
set copyfrom [get_spec [dict get $at_specs -id]] #G-046: expand any deferred display content of the source spec -
#its deferred map doesn't travel with the copied fields.
set copyfrom [private::expand_display_fields [get_spec [dict get $at_specs -id]]]
#we don't copy the @id info from the source #we don't copy the @id info from the source
#for now we only copy across if nothing set.. #for now we only copy across if nothing set..
#todo - bring across defaults for empty keys at targets? #todo - bring across defaults for empty keys at targets?
@ -3169,7 +3422,11 @@ tcl::namespace::eval punk::args {
} id_info $id_info {*}{ } id_info $id_info {*}{
} FORMS $F {*}{ } FORMS $F {*}{
} form_names [dict keys $F] {*}{ } form_names [dict keys $F] {*}{
} form_info $form_info {*}{ } form_info $form_info {*}[
# G-046: DISPLAY_DEFERRED maps inert display tokens -> {source <${...}-content> defspace <ns> dynamic <bool>}
# for display-only field content whose expansion was deferred out of parsing.
# Expanded on demand by private::expand_display_fields (empty when nothing deferred).
] DISPLAY_DEFERRED $deferred_display {*}{
} }
] ]
@ -3404,6 +3661,9 @@ tcl::namespace::eval punk::args {
set deflist [tcl::dict::get $id_cache_rawdef $realid] set deflist [tcl::dict::get $id_cache_rawdef $realid]
set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]]
#G-046: resolved_def re-emits definition text from the spec - deferred display
#tokens must never leak into consumer definitions, so expand first.
set specdict [private::expand_display_fields $specdict]
set opt_form [dict get $opts -form] set opt_form [dict get $opts -form]
if {[string is integer -strict $opt_form]} { if {[string is integer -strict $opt_form]} {
@ -4467,6 +4727,11 @@ tcl::namespace::eval punk::args {
#bas ic recursion blocker #bas ic recursion blocker
variable arg_error_isrunning 0 variable arg_error_isrunning 0
proc arg_error {msg spec_dict args} { proc arg_error {msg spec_dict args} {
#G-046: specs may arrive with display-only field content deferred (parse specs
#travel in error options as -argspecs). Expand for display before rendering.
if {[tcl::dict::exists $spec_dict DISPLAY_DEFERRED] && [tcl::dict::size [tcl::dict::get $spec_dict DISPLAY_DEFERRED]]} {
set spec_dict [private::expand_display_fields $spec_dict]
}
#todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path. #todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path.
#accept an option here so that we can still use full output for usage requests. #accept an option here so that we can still use full output for usage requests.
#This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args #This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args
@ -4800,7 +5065,19 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display] $t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display]
} else { } else {
lappend errlines "Description: $cmdhelp_display" #align continuation lines under the first line as the table renderer's
#cell does - relative indents among continuations preserved (G-046 item 4)
set desclines [split $cmdhelp_display \n]
set labelpad [string repeat " " [string length "Description: "]]
set descjoined [lindex $desclines 0]
foreach dline [lrange $desclines 1 end] {
if {$dline eq ""} {
append descjoined \n
} else {
append descjoined \n $labelpad $dline
}
}
lappend errlines "Description: $descjoined"
} }
incr h incr h
} }
@ -4819,7 +5096,7 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Example: $example_display] $t configure_header $h -colspans $arg_colspans -values [list Example: $example_display]
} else { } else {
lappend errlines "Example: $docurl_display" lappend errlines "Example: $example_display"
} }
incr h incr h
} }
@ -10653,9 +10930,17 @@ tcl::namespace::eval punk::args {
} }
tcl::dict::set $dname $argname_or_ident $existing tcl::dict::set $dname $argname_or_ident $existing
} else { } else {
#test: choice_multielement_clause if {$clause_size == 1} {
lset existing $element_index $chosen #single-element clause - value in $dname is the plain (non list-wrapped) string.
tcl::dict::set $dname $argname_or_ident $existing #overwrite wholesale: lset would treat the scalar as a list and list-quote
#values needing quoting (backslashes/spaces) e.g {\Deleted}, giving a different
#value shape than exact input (G-046 item 3)
tcl::dict::set $dname $argname_or_ident $chosen
} else {
#test: choice_multielement_clause
lset existing $element_index $chosen
tcl::dict::set $dname $argname_or_ident $existing
}
} }
} else { } else {
if {$is_multiple} { if {$is_multiple} {
@ -10965,6 +11250,7 @@ tcl::namespace::eval punk::args {
if {$spec eq ""} { if {$spec eq ""} {
return return
} }
set spec [private::expand_display_fields $spec] ;#G-046 @examples -help may be deferred
if {[dict exists $spec examples_info -help]} { if {[dict exists $spec examples_info -help]} {
set egdata [dict get $spec examples_info -help] set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata] return [punk::args::helpers::strip_nodisplay_lines $egdata]
@ -11779,6 +12065,19 @@ tcl::namespace::eval punk::args {
} [dict get $cinfo origin] {*}{ } [dict get $cinfo origin] {*}{
} }
] ]
#id_exists only sees definitions already loaded - registered argdocs
#(::punk::args::register::NAMESPACES) load lazily, and callers such as the
#punk::ns doc-lookup path only load the ensemble command's parent namespace.
#Load the namespaces the id_checks could resolve in, or a first call before
#they are loaded (e.g 'i <ensemble>' in a fresh shell) builds the definition
#without subhelp/choicelabel entries for documented subcommands.
set id_check_namespaces [list]
foreach checkid $id_checks {
set idns [namespace qualifiers $checkid]
if {$idns eq ""} {set idns ::}
if {$idns ni $id_check_namespaces} {lappend id_check_namespaces $idns}
}
punk::args::update_definitions $id_check_namespaces
set N [punk::ansi::a+ normal] set N [punk::ansi::a+ normal]
set RST [punk::ansi::a] set RST [punk::ansi::a]
foreach checkid $id_checks { foreach checkid $id_checks {
@ -13033,7 +13332,7 @@ package provide punk::args [tcl::namespace::eval punk::args {
tcl::namespace::path {::punk::args::lib ::punk::args::system} tcl::namespace::path {::punk::args::lib ::punk::args::system}
variable pkg punk::args variable pkg punk::args
variable version variable version
set version 0.4.0 set version 0.4.2
}] }]
return return

46
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.3.tm → src/bootsupport/modules/punk/ns-0.1.4.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023 # (C) 2023
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::ns 0.1.3 # Application punk::ns 0.1.4
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -5597,8 +5597,25 @@ y" {return quirkykeyscript}
if {[llength $testresolved] == 1} { if {[llength $testresolved] == 1} {
#only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand #only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand
ledit queryargs -1 -1 {*}$args_remaining ;#prepend ledit queryargs -1 -1 {*}$args_remaining ;#prepend
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $estyle withid $rootdoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values - nothing to mark and
#nothing wrong with the user's (absent) input, so we show plain usage in the
#info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the
#full usage table INSIDE the raised error only for it to be discarded here -
#doubling display time for large argdocs (e.g 'i punk::args::define').
if {![llength $queryargs]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $advisory_estyle withid $rootdoc} parseresult]} {
if {![llength $queryargs]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -5679,8 +5696,25 @@ y" {return quirkykeyscript}
} }
if {$origindoc ne ""} { if {$origindoc ne ""} {
#important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc #important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $estyle withid $origindoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied trailing args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values (e.g 'i string is') - nothing
#to mark and nothing wrong with the user's (absent) input, so we show plain usage in
#the info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the full
#usage table INSIDE the raised error only for it to be discarded here - doubling
#display time for large argdocs (e.g 'i punk::args::define').
if {![llength $args_remaining]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $advisory_estyle withid $origindoc} parseresult]} {
if {![llength $args_remaining]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -7608,6 +7642,6 @@ namespace eval ::punk::args::register {
## Ready ## Ready
package provide punk::ns [tcl::namespace::eval punk::ns { package provide punk::ns [tcl::namespace::eval punk::ns {
variable version variable version
set version 0.1.3 set version 0.1.4
}] }]
return return

605
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.4.0.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.4.2.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024 # (C) 2024
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::args 0.4.0 # Application punk::args 0.4.2
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -18,7 +18,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::args 0 0.4.0] #[manpage_begin punkshell_module_punk::args 0 0.4.2]
#[copyright "2024"] #[copyright "2024"]
#[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[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 --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}]
@ -1266,6 +1266,7 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[id_exists $id]} { if {[id_exists $id]} {
if {!$quiet} { if {!$quiet} {
puts stderr "punk::args::undefine clearing existing data for id:$id" puts stderr "punk::args::undefine clearing existing data for id:$id"
@ -1274,11 +1275,13 @@ tcl::namespace::eval punk::args {
set deflist [dict get $id_cache_rawdef $id] set deflist [dict get $id_cache_rawdef $id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} else { } else {
dict for {k v} $rawdef_cache_argdata { dict for {k v} $rawdef_cache_argdata {
if {[dict get $v id] eq $id} { if {[dict get $v id] eq $id} {
dict unset rawdef_cache_argdata $k dict unset rawdef_cache_argdata $k
dict unset argdefcache_display $k
} }
} }
dict for {k v} $rawdef_cache_about { dict for {k v} $rawdef_cache_about {
@ -1315,15 +1318,389 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[dict exists $rawdef_cache_about $deflist -id]} { if {[dict exists $rawdef_cache_about $deflist -id]} {
set id [dict get $rawdef_cache_about $deflist -id] set id [dict get $rawdef_cache_about $deflist -id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} }
} }
# -- --- --- --- --- --- --- --- --- --- ---
# G-046 display-field deferral
# Expansion of ${...} content landing in display-only fields (-help on @cmd/@examples
# and argument records, @formdisplay -header/-body) is deferred out of resolve: the
# parse spec stores inert tokens plus a DISPLAY_DEFERRED map, and display consumers
# (arg_error, eg, resolved_def) expand on demand via private::expand_display_fields.
# -choicelabels stays eager - punk::ns reads it directly from parse specs during the
# subcommand walk.
variable argdefcache_display [tcl::dict::create] ;#display-expanded specs (non-dynamic definitions), keyed by raw deflist
variable display_expanding [list] ;#definition ids currently being display-expanded (reentrancy guard)
proc private::split_definition_records {optionspecs} {
#definition text -> list of records (factored out of resolve - G-046)
#records are delimited by newlines, but multiline values are allowed if properly
#quoted/braced - 'info complete' (on ansi-stripped accumulation) finds record ends.
set records [list]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
if {$in_record_continuation} {
#trim only the whitespace corresponding to the record indent - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#(note string first "" $str is fast and returns -1)
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
} else {
assert {$record_line == 0} punk::args::private::split_definition_records record_line
regexp {(\s*).*} $rawline _all record_base_indent
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
return $records
}
proc private::classify_display_tokens {placeholdertext tokenlist} {
#G-046: return the subset of tokenlist whose tokens land in display-only field
#values. Display-only: -help on @cmd/@examples and on argument records, and
#@formdisplay -header/-body. Everything else (record names, -choices, -default,
#-choicelabels, @form -synopsis, directive settings) is parse/synopsis-relevant
#and stays eagerly expanded.
set display_tokens [list]
if {![llength $tokenlist]} {
return $display_tokens
}
set records [split_definition_records $placeholdertext]
foreach rec $records {
set trimrec [tcl::string::trim $rec]
switch -- [tcl::string::index $trimrec 0] {
"" - # {continue}
}
if {[catch {set record_values [lassign $trimrec firstword]}]} {
continue ;#unparseable here - real errors surface in resolve's own record loop
}
if {[llength $record_values] % 2 != 0} {
continue
}
switch -glob -- $firstword {
@cmd - @examples {
set displaykeys {-help}
}
@formdisplay {
set displaykeys {-header -body}
}
@* {
set displaykeys {}
}
default {
#argument record
set displaykeys {-help}
}
}
if {![llength $displaykeys]} {continue}
foreach {k v} $record_values {
if {$k in $displaykeys && [string first \x01PADEFER $v] >= 0} {
foreach tk $tokenlist {
if {$tk ni $display_tokens && [string first $tk $v] >= 0} {
lappend display_tokens $tk
}
}
}
}
}
return $display_tokens
}
proc private::mask_display_params {normargs defspace is_dynamic} {
#G-046 phases 0-2: extract ${...} params without evaluation (tstr -eval 0),
#classify which land in display-only fields, and return
# [list <blocks-with-display-params-masked-by-inert-tokens> <deferred map>]
#Blocks without display params are returned untouched (original text) so the
#normal tstr path processes them bit-identically.
set blockparts [list]
set tokenlist [list]
set n 0
set phtext ""
foreach block $normargs {
if {[string first \$\{ $block] >= 0} {
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $block] ptlist paramlist
set btokens [list]
set phblock ""
set i 0
foreach param $paramlist {
set tk [tcl::string::cat \x01 PADEFER [incr n] \x02]
append phblock [lindex $ptlist $i] $tk
lappend btokens $tk
incr i
}
append phblock [lindex $ptlist $i]
lappend blockparts [list 1 $ptlist $paramlist $btokens]
lappend tokenlist {*}$btokens
append phtext $phblock \n
} else {
lappend blockparts [list 0 {} {} {}]
append phtext $block \n
}
}
if {![llength $tokenlist]} {
return [list $normargs {}]
}
set display_tokens [classify_display_tokens $phtext $tokenlist]
if {![llength $display_tokens]} {
return [list $normargs {}]
}
set deferred [tcl::dict::create]
set outblocks [list]
foreach block $normargs bp $blockparts {
lassign $bp hasparams ptlist paramlist btokens
if {!$hasparams} {
lappend outblocks $block
continue
}
set block_display 0
foreach tk $btokens {
if {$tk in $display_tokens} {
set block_display 1
break
}
}
if {!$block_display} {
lappend outblocks $block
continue
}
set masked ""
set i 0
foreach param $paramlist tk $btokens {
append masked [lindex $ptlist $i]
if {$tk in $display_tokens} {
append masked $tk
tcl::dict::set deferred $tk [tcl::dict::create source $param defspace $defspace dynamic $is_dynamic]
} else {
#parse-relevant param - reconstruct for normal tstr evaluation
append masked [tcl::string::cat \$\{ $param \}]
}
incr i
}
append masked [lindex $ptlist $i]
lappend outblocks $masked
}
return [list $outblocks $deferred]
}
proc private::expand_display_fields {spec} {
#G-046: expand deferred display-field content of a parse spec on demand.
#Returns the spec with display fields expanded and DISPLAY_DEFERRED emptied.
#Non-dynamic expansions are cached (keyed by raw deflist); @dynamic definitions
#re-expand each call so provider changes refresh (matching resolve semantics).
if {![tcl::dict::exists $spec DISPLAY_DEFERRED]} {
return $spec
}
set map [tcl::dict::get $spec DISPLAY_DEFERRED]
if {![tcl::dict::size $map]} {
return $spec
}
set id [tcl::dict::get $spec id]
upvar ::punk::args::id_cache_rawdef id_cache_rawdef
upvar ::punk::args::rawdef_cache_about rawdef_cache_about
upvar ::punk::args::argdefcache_display argdefcache_display
set deflist ""
set spec_dynamic 0
if {[tcl::dict::exists $id_cache_rawdef $id]} {
set deflist [tcl::dict::get $id_cache_rawdef $id]
if {[tcl::dict::exists $rawdef_cache_about $deflist -dynamic]} {
set spec_dynamic [tcl::dict::get $rawdef_cache_about $deflist -dynamic]
}
}
if {!$spec_dynamic && $deflist ne "" && [tcl::dict::exists $argdefcache_display $deflist]} {
return [tcl::dict::get $argdefcache_display $deflist]
}
upvar ::punk::args::display_expanding display_expanding
if {$id in $display_expanding} {
#reentrancy: deferred content is (indirectly) rendering help for an id whose
#display expansion is already in progress. Substitute the raw ${...} sources
#instead of evaluating - resolves cleanly, never loops. Not cached.
return [expand_display_slots $spec $map raw]
}
lappend display_expanding $id
try {
set spec [expand_display_slots $spec $map eval]
} finally {
set posn [lsearch -exact $display_expanding $id]
set display_expanding [lreplace $display_expanding $posn $posn]
}
tcl::dict::set spec DISPLAY_DEFERRED {}
if {!$spec_dynamic && $deflist ne ""} {
tcl::dict::set argdefcache_display $deflist $spec
}
return $spec
}
proc private::expand_display_slots {spec map mode} {
#walk the display-only slots of a spec and expand deferred tokens in place
foreach infokey {cmd_info examples_info} {
if {[tcl::dict::exists $spec $infokey -help]} {
set v [tcl::dict::get $spec $infokey -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec $infokey -help [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {fid fdict} [tcl::dict::get $spec FORMS] {
if {[tcl::dict::exists $fdict FORMDISPLAY]} {
tcl::dict::for {k v} [tcl::dict::get $fdict FORMDISPLAY] {
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid FORMDISPLAY $k [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {argname arginfo} [tcl::dict::get $fdict ARG_INFO] {
if {[tcl::dict::exists $arginfo -help]} {
set v [tcl::dict::get $arginfo -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid ARG_INFO $argname -help [expand_deferred_text $v $map $mode]
}
}
}
}
return $spec
}
proc private::expand_deferred_text {text map mode} {
#replace deferred display tokens in a field value.
#mode 'eval': substitute each token's ${...} source in its recorded definition
#namespace; @dynamic sources get the second substitution round (the ${$DYN_X}
#idiom). mode 'raw': substitute the raw ${...} source text (reentrancy path).
#Multiline results align continuation lines with the leading whitespace of the
#token's line - the same 'line' paramindents treatment punk::args::lib::tstr
#applies to eagerly expanded params (G-046 item 2 for the @dynamic path).
set out ""
set firstline 1
foreach ln [split $text \n] {
if {!$firstline} {
append out \n
}
set firstline 0
if {[string first \x01PADEFER $ln] < 0} {
append out $ln
continue
}
regexp {^(\s*)} $ln _all lineindent
while {[regexp -indices {\x01PADEFER[0-9]+\x02} $ln tokenposns]} {
lassign $tokenposns t0 t1
set token [string range $ln $t0 $t1]
set replacement ""
if {[tcl::dict::exists $map $token]} {
set param [tcl::dict::get $map $token source]
set defspace [tcl::dict::get $map $token defspace]
set dynamic [tcl::dict::get $map $token dynamic]
if {$defspace eq ""} {
set defspace ::
}
if {$mode eq "raw"} {
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {[catch {tcl::namespace::eval $defspace [list ::subst $param]} presult]} {
#tstr behaviour on evaluation error: substitute the raw placeholder source
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {$dynamic && [string first \$\{ $presult] >= 0} {
#@dynamic second-round substitution
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $presult] ptlist2 paramlist2
set r2 ""
set i 0
foreach param2 $paramlist2 {
append r2 [lindex $ptlist2 $i]
if {[catch {tcl::namespace::eval $defspace [list ::subst $param2]} p2result]} {
append r2 [tcl::string::cat \$\{ $param2 \}]
} else {
append r2 $p2result
}
incr i
}
append r2 [lindex $ptlist2 $i]
set presult $r2
}
set replacement $presult
}
}
}
if {$lineindent ne "" && [string first \n $replacement] >= 0} {
set rlines [split $replacement \n]
set replacement [lindex $rlines 0]
foreach rl [lrange $rlines 1 end] {
append replacement \n $lineindent $rl
}
}
set ln [string replace $ln $t0 $t1 $replacement]
}
append out $ln
}
return $out
}
# -- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::args::resolve @id -id ::punk::args::resolve
@cmd -name punk::args::resolve\ @cmd -name punk::args::resolve\
@ -1403,12 +1780,14 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: -help section processing is sometimes expensive (e.g tcl syntax
#highlighted examples) and isn't required for parsing of arguments. Display-only
#${...} params are masked with inert tokens here and expanded on demand at
#display time (private::expand_display_fields) with a separate cache.
set deferred_display {}
lassign [private::mask_display_params $normargs $defspace 0] normargs deferred_display
set optionspecs [list] set optionspecs [list]
#REVIEW - whilst this is only done once for each command definition, the -help section processing is sometimes expensive,
#and isn't required for parsing of arguments, so it unnecessarily slows first use of a command that uses punk::args and is heavily documented,
#especially if it has tcl syntax highlighted examples.
#- ideally we would delay expansion of -help sections until needed for display,
#and use a different cache key for the parsing vs display versions of the resolved definition.
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
if {$defspace ne ""} { if {$defspace ne ""} {
@ -1443,10 +1822,11 @@ tcl::namespace::eval punk::args {
#} #}
} else { } else {
set deferred_display {}
if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} {
#cached - so first round of substitution already done #cached - so first round of substitution already done
set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key]
lassign $pt_params ptlist paramlist lassign $pt_params ptlist paramlist deferred_display
set optionspecs "" set optionspecs ""
#subst is only being called on the parameters (contents of ${..}) #subst is only being called on the parameters (contents of ${..})
foreach pt $ptlist param $paramlist { foreach pt $ptlist param $paramlist {
@ -1463,6 +1843,11 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: mask display-only ${...} params (see non-dynamic branch note).
#Masked at round 1, so display payloads (including their round-2
#${$DYN_X} providers) never run during argument resolution.
lassign [private::mask_display_params $normargs $defspace 1] normargs deferred_display
set optionspecs [list] set optionspecs [list]
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
@ -1498,8 +1883,8 @@ tcl::namespace::eval punk::args {
append optionspecs $pt [uplevel $LVL [list ::subst $param]] append optionspecs $pt [uplevel $LVL [list ::subst $param]]
} }
} }
#key is the raw def, value is the 2 element list of textparts, paramparts #key is the raw def, value is the list of textparts, paramparts (and the G-046 deferred display map)
tcl::dict::set argdefcache_unresolved $cache_key $pt_params tcl::dict::set argdefcache_unresolved $cache_key [list {*}$pt_params $deferred_display]
} else { } else {
#wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition #wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition
puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required" puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required"
@ -1557,141 +1942,7 @@ tcl::namespace::eval punk::args {
#set opt_solos [list] #set opt_solos [list]
#first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end #first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end
set records [list] set records [private::split_definition_records $optionspecs]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
#puts "indent1:[ansistring VIEW $record_base_indent]"
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
#append linebuild [string trimleft $rawline] \n
if {$in_record_continuation} {
#incr record_line
#if {$record_line == 1} {
# #first continuation line sets the indent
#}
#///
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
#trim only the whitespace corresponding to last record indent or record_base_indent + 4 spaces - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent.
#ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position.
#(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW)
#(note string first "" $str is fast and returns -1)
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
} else {
assert {$record_line == 0} punk::args::resolve record_line
regexp {(\s*).*} $rawline _all record_base_indent
#puts "indent: [ansistring VIEW -lf 1 $record_base_indent]"
#puts "indent from rawline:$rawline "
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
#trim only the whitespace corresponding to record_base_indent or record_base_indent + 4 spaces - not all whitespace on left
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline
#} else {
# append linebuild $rawline
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {} set cmd_info {}
set package_info {} set package_info {}
@ -1854,7 +2105,9 @@ tcl::namespace::eval punk::args {
#however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable?
if {[dict exists $at_specs -id]} { if {[dict exists $at_specs -id]} {
set copyfrom [get_spec [dict get $at_specs -id]] #G-046: expand any deferred display content of the source spec -
#its deferred map doesn't travel with the copied fields.
set copyfrom [private::expand_display_fields [get_spec [dict get $at_specs -id]]]
#we don't copy the @id info from the source #we don't copy the @id info from the source
#for now we only copy across if nothing set.. #for now we only copy across if nothing set..
#todo - bring across defaults for empty keys at targets? #todo - bring across defaults for empty keys at targets?
@ -3169,7 +3422,11 @@ tcl::namespace::eval punk::args {
} id_info $id_info {*}{ } id_info $id_info {*}{
} FORMS $F {*}{ } FORMS $F {*}{
} form_names [dict keys $F] {*}{ } form_names [dict keys $F] {*}{
} form_info $form_info {*}{ } form_info $form_info {*}[
# G-046: DISPLAY_DEFERRED maps inert display tokens -> {source <${...}-content> defspace <ns> dynamic <bool>}
# for display-only field content whose expansion was deferred out of parsing.
# Expanded on demand by private::expand_display_fields (empty when nothing deferred).
] DISPLAY_DEFERRED $deferred_display {*}{
} }
] ]
@ -3404,6 +3661,9 @@ tcl::namespace::eval punk::args {
set deflist [tcl::dict::get $id_cache_rawdef $realid] set deflist [tcl::dict::get $id_cache_rawdef $realid]
set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]]
#G-046: resolved_def re-emits definition text from the spec - deferred display
#tokens must never leak into consumer definitions, so expand first.
set specdict [private::expand_display_fields $specdict]
set opt_form [dict get $opts -form] set opt_form [dict get $opts -form]
if {[string is integer -strict $opt_form]} { if {[string is integer -strict $opt_form]} {
@ -4467,6 +4727,11 @@ tcl::namespace::eval punk::args {
#bas ic recursion blocker #bas ic recursion blocker
variable arg_error_isrunning 0 variable arg_error_isrunning 0
proc arg_error {msg spec_dict args} { proc arg_error {msg spec_dict args} {
#G-046: specs may arrive with display-only field content deferred (parse specs
#travel in error options as -argspecs). Expand for display before rendering.
if {[tcl::dict::exists $spec_dict DISPLAY_DEFERRED] && [tcl::dict::size [tcl::dict::get $spec_dict DISPLAY_DEFERRED]]} {
set spec_dict [private::expand_display_fields $spec_dict]
}
#todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path. #todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path.
#accept an option here so that we can still use full output for usage requests. #accept an option here so that we can still use full output for usage requests.
#This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args #This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args
@ -4800,7 +5065,19 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display] $t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display]
} else { } else {
lappend errlines "Description: $cmdhelp_display" #align continuation lines under the first line as the table renderer's
#cell does - relative indents among continuations preserved (G-046 item 4)
set desclines [split $cmdhelp_display \n]
set labelpad [string repeat " " [string length "Description: "]]
set descjoined [lindex $desclines 0]
foreach dline [lrange $desclines 1 end] {
if {$dline eq ""} {
append descjoined \n
} else {
append descjoined \n $labelpad $dline
}
}
lappend errlines "Description: $descjoined"
} }
incr h incr h
} }
@ -4819,7 +5096,7 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Example: $example_display] $t configure_header $h -colspans $arg_colspans -values [list Example: $example_display]
} else { } else {
lappend errlines "Example: $docurl_display" lappend errlines "Example: $example_display"
} }
incr h incr h
} }
@ -10653,9 +10930,17 @@ tcl::namespace::eval punk::args {
} }
tcl::dict::set $dname $argname_or_ident $existing tcl::dict::set $dname $argname_or_ident $existing
} else { } else {
#test: choice_multielement_clause if {$clause_size == 1} {
lset existing $element_index $chosen #single-element clause - value in $dname is the plain (non list-wrapped) string.
tcl::dict::set $dname $argname_or_ident $existing #overwrite wholesale: lset would treat the scalar as a list and list-quote
#values needing quoting (backslashes/spaces) e.g {\Deleted}, giving a different
#value shape than exact input (G-046 item 3)
tcl::dict::set $dname $argname_or_ident $chosen
} else {
#test: choice_multielement_clause
lset existing $element_index $chosen
tcl::dict::set $dname $argname_or_ident $existing
}
} }
} else { } else {
if {$is_multiple} { if {$is_multiple} {
@ -10965,6 +11250,7 @@ tcl::namespace::eval punk::args {
if {$spec eq ""} { if {$spec eq ""} {
return return
} }
set spec [private::expand_display_fields $spec] ;#G-046 @examples -help may be deferred
if {[dict exists $spec examples_info -help]} { if {[dict exists $spec examples_info -help]} {
set egdata [dict get $spec examples_info -help] set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata] return [punk::args::helpers::strip_nodisplay_lines $egdata]
@ -11779,6 +12065,19 @@ tcl::namespace::eval punk::args {
} [dict get $cinfo origin] {*}{ } [dict get $cinfo origin] {*}{
} }
] ]
#id_exists only sees definitions already loaded - registered argdocs
#(::punk::args::register::NAMESPACES) load lazily, and callers such as the
#punk::ns doc-lookup path only load the ensemble command's parent namespace.
#Load the namespaces the id_checks could resolve in, or a first call before
#they are loaded (e.g 'i <ensemble>' in a fresh shell) builds the definition
#without subhelp/choicelabel entries for documented subcommands.
set id_check_namespaces [list]
foreach checkid $id_checks {
set idns [namespace qualifiers $checkid]
if {$idns eq ""} {set idns ::}
if {$idns ni $id_check_namespaces} {lappend id_check_namespaces $idns}
}
punk::args::update_definitions $id_check_namespaces
set N [punk::ansi::a+ normal] set N [punk::ansi::a+ normal]
set RST [punk::ansi::a] set RST [punk::ansi::a]
foreach checkid $id_checks { foreach checkid $id_checks {
@ -13033,7 +13332,7 @@ package provide punk::args [tcl::namespace::eval punk::args {
tcl::namespace::path {::punk::args::lib ::punk::args::system} tcl::namespace::path {::punk::args::lib ::punk::args::system}
variable pkg punk::args variable pkg punk::args
variable version variable version
set version 0.4.0 set version 0.4.2
}] }]
return return

46
src/bootsupport/modules/punk/ns-0.1.3.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.4.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023 # (C) 2023
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::ns 0.1.3 # Application punk::ns 0.1.4
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -5597,8 +5597,25 @@ y" {return quirkykeyscript}
if {[llength $testresolved] == 1} { if {[llength $testresolved] == 1} {
#only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand #only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand
ledit queryargs -1 -1 {*}$args_remaining ;#prepend ledit queryargs -1 -1 {*}$args_remaining ;#prepend
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $estyle withid $rootdoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values - nothing to mark and
#nothing wrong with the user's (absent) input, so we show plain usage in the
#info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the
#full usage table INSIDE the raised error only for it to be discarded here -
#doubling display time for large argdocs (e.g 'i punk::args::define').
if {![llength $queryargs]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $advisory_estyle withid $rootdoc} parseresult]} {
if {![llength $queryargs]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -5679,8 +5696,25 @@ y" {return quirkykeyscript}
} }
if {$origindoc ne ""} { if {$origindoc ne ""} {
#important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc #important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $estyle withid $origindoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied trailing args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values (e.g 'i string is') - nothing
#to mark and nothing wrong with the user's (absent) input, so we show plain usage in
#the info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the full
#usage table INSIDE the raised error only for it to be discarded here - doubling
#display time for large argdocs (e.g 'i punk::args::define').
if {![llength $args_remaining]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $advisory_estyle withid $origindoc} parseresult]} {
if {![llength $args_remaining]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -7608,6 +7642,6 @@ namespace eval ::punk::args::register {
## Ready ## Ready
package provide punk::ns [tcl::namespace::eval punk::ns { package provide punk::ns [tcl::namespace::eval punk::ns {
variable version variable version
set version 0.1.3 set version 0.1.4
}] }]
return return

605
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.4.0.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.4.2.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024 # (C) 2024
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::args 0.4.0 # Application punk::args 0.4.2
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -18,7 +18,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::args 0 0.4.0] #[manpage_begin punkshell_module_punk::args 0 0.4.2]
#[copyright "2024"] #[copyright "2024"]
#[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[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 --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}]
@ -1266,6 +1266,7 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[id_exists $id]} { if {[id_exists $id]} {
if {!$quiet} { if {!$quiet} {
puts stderr "punk::args::undefine clearing existing data for id:$id" puts stderr "punk::args::undefine clearing existing data for id:$id"
@ -1274,11 +1275,13 @@ tcl::namespace::eval punk::args {
set deflist [dict get $id_cache_rawdef $id] set deflist [dict get $id_cache_rawdef $id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} else { } else {
dict for {k v} $rawdef_cache_argdata { dict for {k v} $rawdef_cache_argdata {
if {[dict get $v id] eq $id} { if {[dict get $v id] eq $id} {
dict unset rawdef_cache_argdata $k dict unset rawdef_cache_argdata $k
dict unset argdefcache_display $k
} }
} }
dict for {k v} $rawdef_cache_about { dict for {k v} $rawdef_cache_about {
@ -1315,15 +1318,389 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[dict exists $rawdef_cache_about $deflist -id]} { if {[dict exists $rawdef_cache_about $deflist -id]} {
set id [dict get $rawdef_cache_about $deflist -id] set id [dict get $rawdef_cache_about $deflist -id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} }
} }
# -- --- --- --- --- --- --- --- --- --- ---
# G-046 display-field deferral
# Expansion of ${...} content landing in display-only fields (-help on @cmd/@examples
# and argument records, @formdisplay -header/-body) is deferred out of resolve: the
# parse spec stores inert tokens plus a DISPLAY_DEFERRED map, and display consumers
# (arg_error, eg, resolved_def) expand on demand via private::expand_display_fields.
# -choicelabels stays eager - punk::ns reads it directly from parse specs during the
# subcommand walk.
variable argdefcache_display [tcl::dict::create] ;#display-expanded specs (non-dynamic definitions), keyed by raw deflist
variable display_expanding [list] ;#definition ids currently being display-expanded (reentrancy guard)
proc private::split_definition_records {optionspecs} {
#definition text -> list of records (factored out of resolve - G-046)
#records are delimited by newlines, but multiline values are allowed if properly
#quoted/braced - 'info complete' (on ansi-stripped accumulation) finds record ends.
set records [list]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
if {$in_record_continuation} {
#trim only the whitespace corresponding to the record indent - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#(note string first "" $str is fast and returns -1)
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
} else {
assert {$record_line == 0} punk::args::private::split_definition_records record_line
regexp {(\s*).*} $rawline _all record_base_indent
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
return $records
}
proc private::classify_display_tokens {placeholdertext tokenlist} {
#G-046: return the subset of tokenlist whose tokens land in display-only field
#values. Display-only: -help on @cmd/@examples and on argument records, and
#@formdisplay -header/-body. Everything else (record names, -choices, -default,
#-choicelabels, @form -synopsis, directive settings) is parse/synopsis-relevant
#and stays eagerly expanded.
set display_tokens [list]
if {![llength $tokenlist]} {
return $display_tokens
}
set records [split_definition_records $placeholdertext]
foreach rec $records {
set trimrec [tcl::string::trim $rec]
switch -- [tcl::string::index $trimrec 0] {
"" - # {continue}
}
if {[catch {set record_values [lassign $trimrec firstword]}]} {
continue ;#unparseable here - real errors surface in resolve's own record loop
}
if {[llength $record_values] % 2 != 0} {
continue
}
switch -glob -- $firstword {
@cmd - @examples {
set displaykeys {-help}
}
@formdisplay {
set displaykeys {-header -body}
}
@* {
set displaykeys {}
}
default {
#argument record
set displaykeys {-help}
}
}
if {![llength $displaykeys]} {continue}
foreach {k v} $record_values {
if {$k in $displaykeys && [string first \x01PADEFER $v] >= 0} {
foreach tk $tokenlist {
if {$tk ni $display_tokens && [string first $tk $v] >= 0} {
lappend display_tokens $tk
}
}
}
}
}
return $display_tokens
}
proc private::mask_display_params {normargs defspace is_dynamic} {
#G-046 phases 0-2: extract ${...} params without evaluation (tstr -eval 0),
#classify which land in display-only fields, and return
# [list <blocks-with-display-params-masked-by-inert-tokens> <deferred map>]
#Blocks without display params are returned untouched (original text) so the
#normal tstr path processes them bit-identically.
set blockparts [list]
set tokenlist [list]
set n 0
set phtext ""
foreach block $normargs {
if {[string first \$\{ $block] >= 0} {
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $block] ptlist paramlist
set btokens [list]
set phblock ""
set i 0
foreach param $paramlist {
set tk [tcl::string::cat \x01 PADEFER [incr n] \x02]
append phblock [lindex $ptlist $i] $tk
lappend btokens $tk
incr i
}
append phblock [lindex $ptlist $i]
lappend blockparts [list 1 $ptlist $paramlist $btokens]
lappend tokenlist {*}$btokens
append phtext $phblock \n
} else {
lappend blockparts [list 0 {} {} {}]
append phtext $block \n
}
}
if {![llength $tokenlist]} {
return [list $normargs {}]
}
set display_tokens [classify_display_tokens $phtext $tokenlist]
if {![llength $display_tokens]} {
return [list $normargs {}]
}
set deferred [tcl::dict::create]
set outblocks [list]
foreach block $normargs bp $blockparts {
lassign $bp hasparams ptlist paramlist btokens
if {!$hasparams} {
lappend outblocks $block
continue
}
set block_display 0
foreach tk $btokens {
if {$tk in $display_tokens} {
set block_display 1
break
}
}
if {!$block_display} {
lappend outblocks $block
continue
}
set masked ""
set i 0
foreach param $paramlist tk $btokens {
append masked [lindex $ptlist $i]
if {$tk in $display_tokens} {
append masked $tk
tcl::dict::set deferred $tk [tcl::dict::create source $param defspace $defspace dynamic $is_dynamic]
} else {
#parse-relevant param - reconstruct for normal tstr evaluation
append masked [tcl::string::cat \$\{ $param \}]
}
incr i
}
append masked [lindex $ptlist $i]
lappend outblocks $masked
}
return [list $outblocks $deferred]
}
proc private::expand_display_fields {spec} {
#G-046: expand deferred display-field content of a parse spec on demand.
#Returns the spec with display fields expanded and DISPLAY_DEFERRED emptied.
#Non-dynamic expansions are cached (keyed by raw deflist); @dynamic definitions
#re-expand each call so provider changes refresh (matching resolve semantics).
if {![tcl::dict::exists $spec DISPLAY_DEFERRED]} {
return $spec
}
set map [tcl::dict::get $spec DISPLAY_DEFERRED]
if {![tcl::dict::size $map]} {
return $spec
}
set id [tcl::dict::get $spec id]
upvar ::punk::args::id_cache_rawdef id_cache_rawdef
upvar ::punk::args::rawdef_cache_about rawdef_cache_about
upvar ::punk::args::argdefcache_display argdefcache_display
set deflist ""
set spec_dynamic 0
if {[tcl::dict::exists $id_cache_rawdef $id]} {
set deflist [tcl::dict::get $id_cache_rawdef $id]
if {[tcl::dict::exists $rawdef_cache_about $deflist -dynamic]} {
set spec_dynamic [tcl::dict::get $rawdef_cache_about $deflist -dynamic]
}
}
if {!$spec_dynamic && $deflist ne "" && [tcl::dict::exists $argdefcache_display $deflist]} {
return [tcl::dict::get $argdefcache_display $deflist]
}
upvar ::punk::args::display_expanding display_expanding
if {$id in $display_expanding} {
#reentrancy: deferred content is (indirectly) rendering help for an id whose
#display expansion is already in progress. Substitute the raw ${...} sources
#instead of evaluating - resolves cleanly, never loops. Not cached.
return [expand_display_slots $spec $map raw]
}
lappend display_expanding $id
try {
set spec [expand_display_slots $spec $map eval]
} finally {
set posn [lsearch -exact $display_expanding $id]
set display_expanding [lreplace $display_expanding $posn $posn]
}
tcl::dict::set spec DISPLAY_DEFERRED {}
if {!$spec_dynamic && $deflist ne ""} {
tcl::dict::set argdefcache_display $deflist $spec
}
return $spec
}
proc private::expand_display_slots {spec map mode} {
#walk the display-only slots of a spec and expand deferred tokens in place
foreach infokey {cmd_info examples_info} {
if {[tcl::dict::exists $spec $infokey -help]} {
set v [tcl::dict::get $spec $infokey -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec $infokey -help [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {fid fdict} [tcl::dict::get $spec FORMS] {
if {[tcl::dict::exists $fdict FORMDISPLAY]} {
tcl::dict::for {k v} [tcl::dict::get $fdict FORMDISPLAY] {
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid FORMDISPLAY $k [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {argname arginfo} [tcl::dict::get $fdict ARG_INFO] {
if {[tcl::dict::exists $arginfo -help]} {
set v [tcl::dict::get $arginfo -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid ARG_INFO $argname -help [expand_deferred_text $v $map $mode]
}
}
}
}
return $spec
}
proc private::expand_deferred_text {text map mode} {
#replace deferred display tokens in a field value.
#mode 'eval': substitute each token's ${...} source in its recorded definition
#namespace; @dynamic sources get the second substitution round (the ${$DYN_X}
#idiom). mode 'raw': substitute the raw ${...} source text (reentrancy path).
#Multiline results align continuation lines with the leading whitespace of the
#token's line - the same 'line' paramindents treatment punk::args::lib::tstr
#applies to eagerly expanded params (G-046 item 2 for the @dynamic path).
set out ""
set firstline 1
foreach ln [split $text \n] {
if {!$firstline} {
append out \n
}
set firstline 0
if {[string first \x01PADEFER $ln] < 0} {
append out $ln
continue
}
regexp {^(\s*)} $ln _all lineindent
while {[regexp -indices {\x01PADEFER[0-9]+\x02} $ln tokenposns]} {
lassign $tokenposns t0 t1
set token [string range $ln $t0 $t1]
set replacement ""
if {[tcl::dict::exists $map $token]} {
set param [tcl::dict::get $map $token source]
set defspace [tcl::dict::get $map $token defspace]
set dynamic [tcl::dict::get $map $token dynamic]
if {$defspace eq ""} {
set defspace ::
}
if {$mode eq "raw"} {
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {[catch {tcl::namespace::eval $defspace [list ::subst $param]} presult]} {
#tstr behaviour on evaluation error: substitute the raw placeholder source
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {$dynamic && [string first \$\{ $presult] >= 0} {
#@dynamic second-round substitution
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $presult] ptlist2 paramlist2
set r2 ""
set i 0
foreach param2 $paramlist2 {
append r2 [lindex $ptlist2 $i]
if {[catch {tcl::namespace::eval $defspace [list ::subst $param2]} p2result]} {
append r2 [tcl::string::cat \$\{ $param2 \}]
} else {
append r2 $p2result
}
incr i
}
append r2 [lindex $ptlist2 $i]
set presult $r2
}
set replacement $presult
}
}
}
if {$lineindent ne "" && [string first \n $replacement] >= 0} {
set rlines [split $replacement \n]
set replacement [lindex $rlines 0]
foreach rl [lrange $rlines 1 end] {
append replacement \n $lineindent $rl
}
}
set ln [string replace $ln $t0 $t1 $replacement]
}
append out $ln
}
return $out
}
# -- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::args::resolve @id -id ::punk::args::resolve
@cmd -name punk::args::resolve\ @cmd -name punk::args::resolve\
@ -1403,12 +1780,14 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: -help section processing is sometimes expensive (e.g tcl syntax
#highlighted examples) and isn't required for parsing of arguments. Display-only
#${...} params are masked with inert tokens here and expanded on demand at
#display time (private::expand_display_fields) with a separate cache.
set deferred_display {}
lassign [private::mask_display_params $normargs $defspace 0] normargs deferred_display
set optionspecs [list] set optionspecs [list]
#REVIEW - whilst this is only done once for each command definition, the -help section processing is sometimes expensive,
#and isn't required for parsing of arguments, so it unnecessarily slows first use of a command that uses punk::args and is heavily documented,
#especially if it has tcl syntax highlighted examples.
#- ideally we would delay expansion of -help sections until needed for display,
#and use a different cache key for the parsing vs display versions of the resolved definition.
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
if {$defspace ne ""} { if {$defspace ne ""} {
@ -1443,10 +1822,11 @@ tcl::namespace::eval punk::args {
#} #}
} else { } else {
set deferred_display {}
if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} {
#cached - so first round of substitution already done #cached - so first round of substitution already done
set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key]
lassign $pt_params ptlist paramlist lassign $pt_params ptlist paramlist deferred_display
set optionspecs "" set optionspecs ""
#subst is only being called on the parameters (contents of ${..}) #subst is only being called on the parameters (contents of ${..})
foreach pt $ptlist param $paramlist { foreach pt $ptlist param $paramlist {
@ -1463,6 +1843,11 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: mask display-only ${...} params (see non-dynamic branch note).
#Masked at round 1, so display payloads (including their round-2
#${$DYN_X} providers) never run during argument resolution.
lassign [private::mask_display_params $normargs $defspace 1] normargs deferred_display
set optionspecs [list] set optionspecs [list]
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
@ -1498,8 +1883,8 @@ tcl::namespace::eval punk::args {
append optionspecs $pt [uplevel $LVL [list ::subst $param]] append optionspecs $pt [uplevel $LVL [list ::subst $param]]
} }
} }
#key is the raw def, value is the 2 element list of textparts, paramparts #key is the raw def, value is the list of textparts, paramparts (and the G-046 deferred display map)
tcl::dict::set argdefcache_unresolved $cache_key $pt_params tcl::dict::set argdefcache_unresolved $cache_key [list {*}$pt_params $deferred_display]
} else { } else {
#wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition #wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition
puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required" puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required"
@ -1557,141 +1942,7 @@ tcl::namespace::eval punk::args {
#set opt_solos [list] #set opt_solos [list]
#first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end #first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end
set records [list] set records [private::split_definition_records $optionspecs]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
#puts "indent1:[ansistring VIEW $record_base_indent]"
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
#append linebuild [string trimleft $rawline] \n
if {$in_record_continuation} {
#incr record_line
#if {$record_line == 1} {
# #first continuation line sets the indent
#}
#///
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
#trim only the whitespace corresponding to last record indent or record_base_indent + 4 spaces - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent.
#ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position.
#(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW)
#(note string first "" $str is fast and returns -1)
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
} else {
assert {$record_line == 0} punk::args::resolve record_line
regexp {(\s*).*} $rawline _all record_base_indent
#puts "indent: [ansistring VIEW -lf 1 $record_base_indent]"
#puts "indent from rawline:$rawline "
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
#trim only the whitespace corresponding to record_base_indent or record_base_indent + 4 spaces - not all whitespace on left
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline
#} else {
# append linebuild $rawline
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {} set cmd_info {}
set package_info {} set package_info {}
@ -1854,7 +2105,9 @@ tcl::namespace::eval punk::args {
#however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable?
if {[dict exists $at_specs -id]} { if {[dict exists $at_specs -id]} {
set copyfrom [get_spec [dict get $at_specs -id]] #G-046: expand any deferred display content of the source spec -
#its deferred map doesn't travel with the copied fields.
set copyfrom [private::expand_display_fields [get_spec [dict get $at_specs -id]]]
#we don't copy the @id info from the source #we don't copy the @id info from the source
#for now we only copy across if nothing set.. #for now we only copy across if nothing set..
#todo - bring across defaults for empty keys at targets? #todo - bring across defaults for empty keys at targets?
@ -3169,7 +3422,11 @@ tcl::namespace::eval punk::args {
} id_info $id_info {*}{ } id_info $id_info {*}{
} FORMS $F {*}{ } FORMS $F {*}{
} form_names [dict keys $F] {*}{ } form_names [dict keys $F] {*}{
} form_info $form_info {*}{ } form_info $form_info {*}[
# G-046: DISPLAY_DEFERRED maps inert display tokens -> {source <${...}-content> defspace <ns> dynamic <bool>}
# for display-only field content whose expansion was deferred out of parsing.
# Expanded on demand by private::expand_display_fields (empty when nothing deferred).
] DISPLAY_DEFERRED $deferred_display {*}{
} }
] ]
@ -3404,6 +3661,9 @@ tcl::namespace::eval punk::args {
set deflist [tcl::dict::get $id_cache_rawdef $realid] set deflist [tcl::dict::get $id_cache_rawdef $realid]
set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]]
#G-046: resolved_def re-emits definition text from the spec - deferred display
#tokens must never leak into consumer definitions, so expand first.
set specdict [private::expand_display_fields $specdict]
set opt_form [dict get $opts -form] set opt_form [dict get $opts -form]
if {[string is integer -strict $opt_form]} { if {[string is integer -strict $opt_form]} {
@ -4467,6 +4727,11 @@ tcl::namespace::eval punk::args {
#bas ic recursion blocker #bas ic recursion blocker
variable arg_error_isrunning 0 variable arg_error_isrunning 0
proc arg_error {msg spec_dict args} { proc arg_error {msg spec_dict args} {
#G-046: specs may arrive with display-only field content deferred (parse specs
#travel in error options as -argspecs). Expand for display before rendering.
if {[tcl::dict::exists $spec_dict DISPLAY_DEFERRED] && [tcl::dict::size [tcl::dict::get $spec_dict DISPLAY_DEFERRED]]} {
set spec_dict [private::expand_display_fields $spec_dict]
}
#todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path. #todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path.
#accept an option here so that we can still use full output for usage requests. #accept an option here so that we can still use full output for usage requests.
#This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args #This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args
@ -4800,7 +5065,19 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display] $t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display]
} else { } else {
lappend errlines "Description: $cmdhelp_display" #align continuation lines under the first line as the table renderer's
#cell does - relative indents among continuations preserved (G-046 item 4)
set desclines [split $cmdhelp_display \n]
set labelpad [string repeat " " [string length "Description: "]]
set descjoined [lindex $desclines 0]
foreach dline [lrange $desclines 1 end] {
if {$dline eq ""} {
append descjoined \n
} else {
append descjoined \n $labelpad $dline
}
}
lappend errlines "Description: $descjoined"
} }
incr h incr h
} }
@ -4819,7 +5096,7 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Example: $example_display] $t configure_header $h -colspans $arg_colspans -values [list Example: $example_display]
} else { } else {
lappend errlines "Example: $docurl_display" lappend errlines "Example: $example_display"
} }
incr h incr h
} }
@ -10653,9 +10930,17 @@ tcl::namespace::eval punk::args {
} }
tcl::dict::set $dname $argname_or_ident $existing tcl::dict::set $dname $argname_or_ident $existing
} else { } else {
#test: choice_multielement_clause if {$clause_size == 1} {
lset existing $element_index $chosen #single-element clause - value in $dname is the plain (non list-wrapped) string.
tcl::dict::set $dname $argname_or_ident $existing #overwrite wholesale: lset would treat the scalar as a list and list-quote
#values needing quoting (backslashes/spaces) e.g {\Deleted}, giving a different
#value shape than exact input (G-046 item 3)
tcl::dict::set $dname $argname_or_ident $chosen
} else {
#test: choice_multielement_clause
lset existing $element_index $chosen
tcl::dict::set $dname $argname_or_ident $existing
}
} }
} else { } else {
if {$is_multiple} { if {$is_multiple} {
@ -10965,6 +11250,7 @@ tcl::namespace::eval punk::args {
if {$spec eq ""} { if {$spec eq ""} {
return return
} }
set spec [private::expand_display_fields $spec] ;#G-046 @examples -help may be deferred
if {[dict exists $spec examples_info -help]} { if {[dict exists $spec examples_info -help]} {
set egdata [dict get $spec examples_info -help] set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata] return [punk::args::helpers::strip_nodisplay_lines $egdata]
@ -11779,6 +12065,19 @@ tcl::namespace::eval punk::args {
} [dict get $cinfo origin] {*}{ } [dict get $cinfo origin] {*}{
} }
] ]
#id_exists only sees definitions already loaded - registered argdocs
#(::punk::args::register::NAMESPACES) load lazily, and callers such as the
#punk::ns doc-lookup path only load the ensemble command's parent namespace.
#Load the namespaces the id_checks could resolve in, or a first call before
#they are loaded (e.g 'i <ensemble>' in a fresh shell) builds the definition
#without subhelp/choicelabel entries for documented subcommands.
set id_check_namespaces [list]
foreach checkid $id_checks {
set idns [namespace qualifiers $checkid]
if {$idns eq ""} {set idns ::}
if {$idns ni $id_check_namespaces} {lappend id_check_namespaces $idns}
}
punk::args::update_definitions $id_check_namespaces
set N [punk::ansi::a+ normal] set N [punk::ansi::a+ normal]
set RST [punk::ansi::a] set RST [punk::ansi::a]
foreach checkid $id_checks { foreach checkid $id_checks {
@ -13033,7 +13332,7 @@ package provide punk::args [tcl::namespace::eval punk::args {
tcl::namespace::path {::punk::args::lib ::punk::args::system} tcl::namespace::path {::punk::args::lib ::punk::args::system}
variable pkg punk::args variable pkg punk::args
variable version variable version
set version 0.4.0 set version 0.4.2
}] }]
return return

46
src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.3.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.4.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023 # (C) 2023
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::ns 0.1.3 # Application punk::ns 0.1.4
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -5597,8 +5597,25 @@ y" {return quirkykeyscript}
if {[llength $testresolved] == 1} { if {[llength $testresolved] == 1} {
#only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand #only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand
ledit queryargs -1 -1 {*}$args_remaining ;#prepend ledit queryargs -1 -1 {*}$args_remaining ;#prepend
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $estyle withid $rootdoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values - nothing to mark and
#nothing wrong with the user's (absent) input, so we show plain usage in the
#info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the
#full usage table INSIDE the raised error only for it to be discarded here -
#doubling display time for large argdocs (e.g 'i punk::args::define').
if {![llength $queryargs]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $advisory_estyle withid $rootdoc} parseresult]} {
if {![llength $queryargs]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -5679,8 +5696,25 @@ y" {return quirkykeyscript}
} }
if {$origindoc ne ""} { if {$origindoc ne ""} {
#important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc #important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $estyle withid $origindoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied trailing args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values (e.g 'i string is') - nothing
#to mark and nothing wrong with the user's (absent) input, so we show plain usage in
#the info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the full
#usage table INSIDE the raised error only for it to be discarded here - doubling
#display time for large argdocs (e.g 'i punk::args::define').
if {![llength $args_remaining]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $advisory_estyle withid $origindoc} parseresult]} {
if {![llength $args_remaining]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -7608,6 +7642,6 @@ namespace eval ::punk::args::register {
## Ready ## Ready
package provide punk::ns [tcl::namespace::eval punk::ns { package provide punk::ns [tcl::namespace::eval punk::ns {
variable version variable version
set version 0.1.3 set version 0.1.4
}] }]
return return

605
src/vfs/_vfscommon.vfs/modules/punk/args-0.4.0.tm → src/vfs/_vfscommon.vfs/modules/punk/args-0.4.2.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024 # (C) 2024
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::args 0.4.0 # Application punk::args 0.4.2
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -18,7 +18,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::args 0 0.4.0] #[manpage_begin punkshell_module_punk::args 0 0.4.2]
#[copyright "2024"] #[copyright "2024"]
#[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[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 --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}]
@ -1266,6 +1266,7 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[id_exists $id]} { if {[id_exists $id]} {
if {!$quiet} { if {!$quiet} {
puts stderr "punk::args::undefine clearing existing data for id:$id" puts stderr "punk::args::undefine clearing existing data for id:$id"
@ -1274,11 +1275,13 @@ tcl::namespace::eval punk::args {
set deflist [dict get $id_cache_rawdef $id] set deflist [dict get $id_cache_rawdef $id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} else { } else {
dict for {k v} $rawdef_cache_argdata { dict for {k v} $rawdef_cache_argdata {
if {[dict get $v id] eq $id} { if {[dict get $v id] eq $id} {
dict unset rawdef_cache_argdata $k dict unset rawdef_cache_argdata $k
dict unset argdefcache_display $k
} }
} }
dict for {k v} $rawdef_cache_about { dict for {k v} $rawdef_cache_about {
@ -1315,15 +1318,389 @@ tcl::namespace::eval punk::args {
variable rawdef_cache_about variable rawdef_cache_about
variable id_cache_rawdef variable id_cache_rawdef
variable rawdef_cache_argdata variable rawdef_cache_argdata
variable argdefcache_display
if {[dict exists $rawdef_cache_about $deflist -id]} { if {[dict exists $rawdef_cache_about $deflist -id]} {
set id [dict get $rawdef_cache_about $deflist -id] set id [dict get $rawdef_cache_about $deflist -id]
dict unset rawdef_cache_about $deflist dict unset rawdef_cache_about $deflist
dict unset rawdef_cache_argdata $deflist dict unset rawdef_cache_argdata $deflist
dict unset argdefcache_display $deflist
dict unset id_cache_rawdef $id dict unset id_cache_rawdef $id
} }
} }
# -- --- --- --- --- --- --- --- --- --- ---
# G-046 display-field deferral
# Expansion of ${...} content landing in display-only fields (-help on @cmd/@examples
# and argument records, @formdisplay -header/-body) is deferred out of resolve: the
# parse spec stores inert tokens plus a DISPLAY_DEFERRED map, and display consumers
# (arg_error, eg, resolved_def) expand on demand via private::expand_display_fields.
# -choicelabels stays eager - punk::ns reads it directly from parse specs during the
# subcommand walk.
variable argdefcache_display [tcl::dict::create] ;#display-expanded specs (non-dynamic definitions), keyed by raw deflist
variable display_expanding [list] ;#definition ids currently being display-expanded (reentrancy guard)
proc private::split_definition_records {optionspecs} {
#definition text -> list of records (factored out of resolve - G-046)
#records are delimited by newlines, but multiline values are allowed if properly
#quoted/braced - 'info complete' (on ansi-stripped accumulation) finds record ends.
set records [list]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
if {$in_record_continuation} {
#trim only the whitespace corresponding to the record indent - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#(note string first "" $str is fast and returns -1)
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
} else {
assert {$record_line == 0} punk::args::private::split_definition_records record_line
regexp {(\s*).*} $rawline _all record_base_indent
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
return $records
}
proc private::classify_display_tokens {placeholdertext tokenlist} {
#G-046: return the subset of tokenlist whose tokens land in display-only field
#values. Display-only: -help on @cmd/@examples and on argument records, and
#@formdisplay -header/-body. Everything else (record names, -choices, -default,
#-choicelabels, @form -synopsis, directive settings) is parse/synopsis-relevant
#and stays eagerly expanded.
set display_tokens [list]
if {![llength $tokenlist]} {
return $display_tokens
}
set records [split_definition_records $placeholdertext]
foreach rec $records {
set trimrec [tcl::string::trim $rec]
switch -- [tcl::string::index $trimrec 0] {
"" - # {continue}
}
if {[catch {set record_values [lassign $trimrec firstword]}]} {
continue ;#unparseable here - real errors surface in resolve's own record loop
}
if {[llength $record_values] % 2 != 0} {
continue
}
switch -glob -- $firstword {
@cmd - @examples {
set displaykeys {-help}
}
@formdisplay {
set displaykeys {-header -body}
}
@* {
set displaykeys {}
}
default {
#argument record
set displaykeys {-help}
}
}
if {![llength $displaykeys]} {continue}
foreach {k v} $record_values {
if {$k in $displaykeys && [string first \x01PADEFER $v] >= 0} {
foreach tk $tokenlist {
if {$tk ni $display_tokens && [string first $tk $v] >= 0} {
lappend display_tokens $tk
}
}
}
}
}
return $display_tokens
}
proc private::mask_display_params {normargs defspace is_dynamic} {
#G-046 phases 0-2: extract ${...} params without evaluation (tstr -eval 0),
#classify which land in display-only fields, and return
# [list <blocks-with-display-params-masked-by-inert-tokens> <deferred map>]
#Blocks without display params are returned untouched (original text) so the
#normal tstr path processes them bit-identically.
set blockparts [list]
set tokenlist [list]
set n 0
set phtext ""
foreach block $normargs {
if {[string first \$\{ $block] >= 0} {
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $block] ptlist paramlist
set btokens [list]
set phblock ""
set i 0
foreach param $paramlist {
set tk [tcl::string::cat \x01 PADEFER [incr n] \x02]
append phblock [lindex $ptlist $i] $tk
lappend btokens $tk
incr i
}
append phblock [lindex $ptlist $i]
lappend blockparts [list 1 $ptlist $paramlist $btokens]
lappend tokenlist {*}$btokens
append phtext $phblock \n
} else {
lappend blockparts [list 0 {} {} {}]
append phtext $block \n
}
}
if {![llength $tokenlist]} {
return [list $normargs {}]
}
set display_tokens [classify_display_tokens $phtext $tokenlist]
if {![llength $display_tokens]} {
return [list $normargs {}]
}
set deferred [tcl::dict::create]
set outblocks [list]
foreach block $normargs bp $blockparts {
lassign $bp hasparams ptlist paramlist btokens
if {!$hasparams} {
lappend outblocks $block
continue
}
set block_display 0
foreach tk $btokens {
if {$tk in $display_tokens} {
set block_display 1
break
}
}
if {!$block_display} {
lappend outblocks $block
continue
}
set masked ""
set i 0
foreach param $paramlist tk $btokens {
append masked [lindex $ptlist $i]
if {$tk in $display_tokens} {
append masked $tk
tcl::dict::set deferred $tk [tcl::dict::create source $param defspace $defspace dynamic $is_dynamic]
} else {
#parse-relevant param - reconstruct for normal tstr evaluation
append masked [tcl::string::cat \$\{ $param \}]
}
incr i
}
append masked [lindex $ptlist $i]
lappend outblocks $masked
}
return [list $outblocks $deferred]
}
proc private::expand_display_fields {spec} {
#G-046: expand deferred display-field content of a parse spec on demand.
#Returns the spec with display fields expanded and DISPLAY_DEFERRED emptied.
#Non-dynamic expansions are cached (keyed by raw deflist); @dynamic definitions
#re-expand each call so provider changes refresh (matching resolve semantics).
if {![tcl::dict::exists $spec DISPLAY_DEFERRED]} {
return $spec
}
set map [tcl::dict::get $spec DISPLAY_DEFERRED]
if {![tcl::dict::size $map]} {
return $spec
}
set id [tcl::dict::get $spec id]
upvar ::punk::args::id_cache_rawdef id_cache_rawdef
upvar ::punk::args::rawdef_cache_about rawdef_cache_about
upvar ::punk::args::argdefcache_display argdefcache_display
set deflist ""
set spec_dynamic 0
if {[tcl::dict::exists $id_cache_rawdef $id]} {
set deflist [tcl::dict::get $id_cache_rawdef $id]
if {[tcl::dict::exists $rawdef_cache_about $deflist -dynamic]} {
set spec_dynamic [tcl::dict::get $rawdef_cache_about $deflist -dynamic]
}
}
if {!$spec_dynamic && $deflist ne "" && [tcl::dict::exists $argdefcache_display $deflist]} {
return [tcl::dict::get $argdefcache_display $deflist]
}
upvar ::punk::args::display_expanding display_expanding
if {$id in $display_expanding} {
#reentrancy: deferred content is (indirectly) rendering help for an id whose
#display expansion is already in progress. Substitute the raw ${...} sources
#instead of evaluating - resolves cleanly, never loops. Not cached.
return [expand_display_slots $spec $map raw]
}
lappend display_expanding $id
try {
set spec [expand_display_slots $spec $map eval]
} finally {
set posn [lsearch -exact $display_expanding $id]
set display_expanding [lreplace $display_expanding $posn $posn]
}
tcl::dict::set spec DISPLAY_DEFERRED {}
if {!$spec_dynamic && $deflist ne ""} {
tcl::dict::set argdefcache_display $deflist $spec
}
return $spec
}
proc private::expand_display_slots {spec map mode} {
#walk the display-only slots of a spec and expand deferred tokens in place
foreach infokey {cmd_info examples_info} {
if {[tcl::dict::exists $spec $infokey -help]} {
set v [tcl::dict::get $spec $infokey -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec $infokey -help [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {fid fdict} [tcl::dict::get $spec FORMS] {
if {[tcl::dict::exists $fdict FORMDISPLAY]} {
tcl::dict::for {k v} [tcl::dict::get $fdict FORMDISPLAY] {
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid FORMDISPLAY $k [expand_deferred_text $v $map $mode]
}
}
}
tcl::dict::for {argname arginfo} [tcl::dict::get $fdict ARG_INFO] {
if {[tcl::dict::exists $arginfo -help]} {
set v [tcl::dict::get $arginfo -help]
if {[string first \x01PADEFER $v] >= 0} {
tcl::dict::set spec FORMS $fid ARG_INFO $argname -help [expand_deferred_text $v $map $mode]
}
}
}
}
return $spec
}
proc private::expand_deferred_text {text map mode} {
#replace deferred display tokens in a field value.
#mode 'eval': substitute each token's ${...} source in its recorded definition
#namespace; @dynamic sources get the second substitution round (the ${$DYN_X}
#idiom). mode 'raw': substitute the raw ${...} source text (reentrancy path).
#Multiline results align continuation lines with the leading whitespace of the
#token's line - the same 'line' paramindents treatment punk::args::lib::tstr
#applies to eagerly expanded params (G-046 item 2 for the @dynamic path).
set out ""
set firstline 1
foreach ln [split $text \n] {
if {!$firstline} {
append out \n
}
set firstline 0
if {[string first \x01PADEFER $ln] < 0} {
append out $ln
continue
}
regexp {^(\s*)} $ln _all lineindent
while {[regexp -indices {\x01PADEFER[0-9]+\x02} $ln tokenposns]} {
lassign $tokenposns t0 t1
set token [string range $ln $t0 $t1]
set replacement ""
if {[tcl::dict::exists $map $token]} {
set param [tcl::dict::get $map $token source]
set defspace [tcl::dict::get $map $token defspace]
set dynamic [tcl::dict::get $map $token dynamic]
if {$defspace eq ""} {
set defspace ::
}
if {$mode eq "raw"} {
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {[catch {tcl::namespace::eval $defspace [list ::subst $param]} presult]} {
#tstr behaviour on evaluation error: substitute the raw placeholder source
set replacement [tcl::string::cat \$\{ $param \}]
} else {
if {$dynamic && [string first \$\{ $presult] >= 0} {
#@dynamic second-round substitution
lassign [punk::args::lib::tstr -return list -eval 0 -undent 0 $presult] ptlist2 paramlist2
set r2 ""
set i 0
foreach param2 $paramlist2 {
append r2 [lindex $ptlist2 $i]
if {[catch {tcl::namespace::eval $defspace [list ::subst $param2]} p2result]} {
append r2 [tcl::string::cat \$\{ $param2 \}]
} else {
append r2 $p2result
}
incr i
}
append r2 [lindex $ptlist2 $i]
set presult $r2
}
set replacement $presult
}
}
}
if {$lineindent ne "" && [string first \n $replacement] >= 0} {
set rlines [split $replacement \n]
set replacement [lindex $rlines 0]
foreach rl [lrange $rlines 1 end] {
append replacement \n $lineindent $rl
}
}
set ln [string replace $ln $t0 $t1 $replacement]
}
append out $ln
}
return $out
}
# -- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::args::resolve @id -id ::punk::args::resolve
@cmd -name punk::args::resolve\ @cmd -name punk::args::resolve\
@ -1403,12 +1780,14 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: -help section processing is sometimes expensive (e.g tcl syntax
#highlighted examples) and isn't required for parsing of arguments. Display-only
#${...} params are masked with inert tokens here and expanded on demand at
#display time (private::expand_display_fields) with a separate cache.
set deferred_display {}
lassign [private::mask_display_params $normargs $defspace 0] normargs deferred_display
set optionspecs [list] set optionspecs [list]
#REVIEW - whilst this is only done once for each command definition, the -help section processing is sometimes expensive,
#and isn't required for parsing of arguments, so it unnecessarily slows first use of a command that uses punk::args and is heavily documented,
#especially if it has tcl syntax highlighted examples.
#- ideally we would delay expansion of -help sections until needed for display,
#and use a different cache key for the parsing vs display versions of the resolved definition.
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
if {$defspace ne ""} { if {$defspace ne ""} {
@ -1443,10 +1822,11 @@ tcl::namespace::eval punk::args {
#} #}
} else { } else {
set deferred_display {}
if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} {
#cached - so first round of substitution already done #cached - so first round of substitution already done
set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key]
lassign $pt_params ptlist paramlist lassign $pt_params ptlist paramlist deferred_display
set optionspecs "" set optionspecs ""
#subst is only being called on the parameters (contents of ${..}) #subst is only being called on the parameters (contents of ${..})
foreach pt $ptlist param $paramlist { foreach pt $ptlist param $paramlist {
@ -1463,6 +1843,11 @@ tcl::namespace::eval punk::args {
lappend normargs [tcl::string::map {\r\n \n} $a] lappend normargs [tcl::string::map {\r\n \n} $a]
} }
#G-046: mask display-only ${...} params (see non-dynamic branch note).
#Masked at round 1, so display payloads (including their round-2
#${$DYN_X} providers) never run during argument resolution.
lassign [private::mask_display_params $normargs $defspace 1] normargs deferred_display
set optionspecs [list] set optionspecs [list]
foreach block $normargs { foreach block $normargs {
if {[string first \$\{ $block] >= 0} { if {[string first \$\{ $block] >= 0} {
@ -1498,8 +1883,8 @@ tcl::namespace::eval punk::args {
append optionspecs $pt [uplevel $LVL [list ::subst $param]] append optionspecs $pt [uplevel $LVL [list ::subst $param]]
} }
} }
#key is the raw def, value is the 2 element list of textparts, paramparts #key is the raw def, value is the list of textparts, paramparts (and the G-046 deferred display map)
tcl::dict::set argdefcache_unresolved $cache_key $pt_params tcl::dict::set argdefcache_unresolved $cache_key [list {*}$pt_params $deferred_display]
} else { } else {
#wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition #wasn't really a 'dynamic' definition - no 2nd round parameter substitution in definition
puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required" puts stderr "punk::args::resolve - bad @dynamic tag for id:$id - no 2nd round substitution required"
@ -1557,141 +1942,7 @@ tcl::namespace::eval punk::args {
#set opt_solos [list] #set opt_solos [list]
#first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end #first process dashed and non-dashed record names without regard to whether non-dashed are at the beginning or end
set records [list] set records [private::split_definition_records $optionspecs]
set linebuild ""
set linelist [split $optionspecs \n]
set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#find the first record's base indent
foreach ln $linelist {
if {[tcl::string::trim $ln] eq ""} {continue}
regexp {(\s*).*} $ln _all record_base_indent
break ;#break at first non-empty
}
#puts "indent1:[ansistring VIEW $record_base_indent]"
set in_record_continuation 0
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
} else {
set has_punkansi 1
}
set record_id 0
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
# - we might reasonably expect them in default values or choices or help strings
# - square brackets in ansi aren't and can't be escaped if they're to work as literals in the data.
# - eg set line "set x \"a[a+ red]red[a]\""
# - 'info complete' will report 0, and subst would require -nocommand option or it will complain of missing close-bracket
if {$has_punkansi} {
set test_record [punk::ansi::ansistrip $record_so_far]
} else {
#review
#we only need to strip enough to stop interference with 'info complete'
set test_record [string map [list \x1b\[ ""] $record_so_far]
}
if {![tcl::info::complete $test_record]} {
#append linebuild [string trimleft $rawline] \n
if {$in_record_continuation} {
#incr record_line
#if {$record_line == 1} {
# #first continuation line sets the indent
#}
#///
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline \n
} else {
append linebuild $rawline \n
}
#trim only the whitespace corresponding to last record indent or record_base_indent + 4 spaces - not all whitespace on left
#this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form.
#Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent.
#ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position.
#(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW)
#(note string first "" $str is fast and returns -1)
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline \n
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline \n
#} else {
# append linebuild $rawline \n
#}
} else {
assert {$record_line == 0} punk::args::resolve record_line
regexp {(\s*).*} $rawline _all record_base_indent
#puts "indent: [ansistring VIEW -lf 1 $record_base_indent]"
#puts "indent from rawline:$rawline "
append linebuild $rawline \n
set in_record_continuation 1
}
incr record_line
} else {
#either we're on a single line record, or last line of multiline record
if {$record_line != 0} {
#trim only the whitespace corresponding to record_base_indent or record_base_indent + 4 spaces - not all whitespace on left
#if {[tcl::string::first "$record_base_indent " $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length "$record_base_indent "] end]
# append linebuild $trimmedline
#} elseif {[tcl::string::first $record_base_indent $rawline] == 0} {
# set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
# append linebuild $trimmedline
#} else {
# append linebuild $rawline
#}
if {[tcl::string::first $record_base_indent $rawline] == 0} {
set trimmedline [tcl::string::range $rawline [tcl::string::length $record_base_indent] end]
append linebuild $trimmedline
} else {
append linebuild $rawline
}
} else {
append linebuild $rawline
}
lappend records $linebuild
set linebuild ""
#prep for next record
set in_record_continuation 0
incr record_id
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {} set cmd_info {}
set package_info {} set package_info {}
@ -1854,7 +2105,9 @@ tcl::namespace::eval punk::args {
#however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable?
if {[dict exists $at_specs -id]} { if {[dict exists $at_specs -id]} {
set copyfrom [get_spec [dict get $at_specs -id]] #G-046: expand any deferred display content of the source spec -
#its deferred map doesn't travel with the copied fields.
set copyfrom [private::expand_display_fields [get_spec [dict get $at_specs -id]]]
#we don't copy the @id info from the source #we don't copy the @id info from the source
#for now we only copy across if nothing set.. #for now we only copy across if nothing set..
#todo - bring across defaults for empty keys at targets? #todo - bring across defaults for empty keys at targets?
@ -3169,7 +3422,11 @@ tcl::namespace::eval punk::args {
} id_info $id_info {*}{ } id_info $id_info {*}{
} FORMS $F {*}{ } FORMS $F {*}{
} form_names [dict keys $F] {*}{ } form_names [dict keys $F] {*}{
} form_info $form_info {*}{ } form_info $form_info {*}[
# G-046: DISPLAY_DEFERRED maps inert display tokens -> {source <${...}-content> defspace <ns> dynamic <bool>}
# for display-only field content whose expansion was deferred out of parsing.
# Expanded on demand by private::expand_display_fields (empty when nothing deferred).
] DISPLAY_DEFERRED $deferred_display {*}{
} }
] ]
@ -3404,6 +3661,9 @@ tcl::namespace::eval punk::args {
set deflist [tcl::dict::get $id_cache_rawdef $realid] set deflist [tcl::dict::get $id_cache_rawdef $realid]
set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]]
#G-046: resolved_def re-emits definition text from the spec - deferred display
#tokens must never leak into consumer definitions, so expand first.
set specdict [private::expand_display_fields $specdict]
set opt_form [dict get $opts -form] set opt_form [dict get $opts -form]
if {[string is integer -strict $opt_form]} { if {[string is integer -strict $opt_form]} {
@ -4467,6 +4727,11 @@ tcl::namespace::eval punk::args {
#bas ic recursion blocker #bas ic recursion blocker
variable arg_error_isrunning 0 variable arg_error_isrunning 0
proc arg_error {msg spec_dict args} { proc arg_error {msg spec_dict args} {
#G-046: specs may arrive with display-only field content deferred (parse specs
#travel in error options as -argspecs). Expand for display before rendering.
if {[tcl::dict::exists $spec_dict DISPLAY_DEFERRED] && [tcl::dict::size [tcl::dict::get $spec_dict DISPLAY_DEFERRED]]} {
set spec_dict [private::expand_display_fields $spec_dict]
}
#todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path. #todo - test a configurable flag (in the CALLER) for whether to do a faster return on the unhappy path.
#accept an option here so that we can still use full output for usage requests. #accept an option here so that we can still use full output for usage requests.
#This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args #This may be desired for codebases where tests based on 'catch' are used on procs that parse with punk::args
@ -4800,7 +5065,19 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display] $t configure_header $h -colspans $arg_colspans -values [list Description: $cmdhelp_display]
} else { } else {
lappend errlines "Description: $cmdhelp_display" #align continuation lines under the first line as the table renderer's
#cell does - relative indents among continuations preserved (G-046 item 4)
set desclines [split $cmdhelp_display \n]
set labelpad [string repeat " " [string length "Description: "]]
set descjoined [lindex $desclines 0]
foreach dline [lrange $desclines 1 end] {
if {$dline eq ""} {
append descjoined \n
} else {
append descjoined \n $labelpad $dline
}
}
lappend errlines "Description: $descjoined"
} }
incr h incr h
} }
@ -4819,7 +5096,7 @@ tcl::namespace::eval punk::args {
if {$use_table} { if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Example: $example_display] $t configure_header $h -colspans $arg_colspans -values [list Example: $example_display]
} else { } else {
lappend errlines "Example: $docurl_display" lappend errlines "Example: $example_display"
} }
incr h incr h
} }
@ -10653,9 +10930,17 @@ tcl::namespace::eval punk::args {
} }
tcl::dict::set $dname $argname_or_ident $existing tcl::dict::set $dname $argname_or_ident $existing
} else { } else {
#test: choice_multielement_clause if {$clause_size == 1} {
lset existing $element_index $chosen #single-element clause - value in $dname is the plain (non list-wrapped) string.
tcl::dict::set $dname $argname_or_ident $existing #overwrite wholesale: lset would treat the scalar as a list and list-quote
#values needing quoting (backslashes/spaces) e.g {\Deleted}, giving a different
#value shape than exact input (G-046 item 3)
tcl::dict::set $dname $argname_or_ident $chosen
} else {
#test: choice_multielement_clause
lset existing $element_index $chosen
tcl::dict::set $dname $argname_or_ident $existing
}
} }
} else { } else {
if {$is_multiple} { if {$is_multiple} {
@ -10965,6 +11250,7 @@ tcl::namespace::eval punk::args {
if {$spec eq ""} { if {$spec eq ""} {
return return
} }
set spec [private::expand_display_fields $spec] ;#G-046 @examples -help may be deferred
if {[dict exists $spec examples_info -help]} { if {[dict exists $spec examples_info -help]} {
set egdata [dict get $spec examples_info -help] set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata] return [punk::args::helpers::strip_nodisplay_lines $egdata]
@ -11779,6 +12065,19 @@ tcl::namespace::eval punk::args {
} [dict get $cinfo origin] {*}{ } [dict get $cinfo origin] {*}{
} }
] ]
#id_exists only sees definitions already loaded - registered argdocs
#(::punk::args::register::NAMESPACES) load lazily, and callers such as the
#punk::ns doc-lookup path only load the ensemble command's parent namespace.
#Load the namespaces the id_checks could resolve in, or a first call before
#they are loaded (e.g 'i <ensemble>' in a fresh shell) builds the definition
#without subhelp/choicelabel entries for documented subcommands.
set id_check_namespaces [list]
foreach checkid $id_checks {
set idns [namespace qualifiers $checkid]
if {$idns eq ""} {set idns ::}
if {$idns ni $id_check_namespaces} {lappend id_check_namespaces $idns}
}
punk::args::update_definitions $id_check_namespaces
set N [punk::ansi::a+ normal] set N [punk::ansi::a+ normal]
set RST [punk::ansi::a] set RST [punk::ansi::a]
foreach checkid $id_checks { foreach checkid $id_checks {
@ -13033,7 +13332,7 @@ package provide punk::args [tcl::namespace::eval punk::args {
tcl::namespace::path {::punk::args::lib ::punk::args::system} tcl::namespace::path {::punk::args::lib ::punk::args::system}
variable pkg punk::args variable pkg punk::args
variable version variable version
set version 0.4.0 set version 0.4.2
}] }]
return return

46
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.3.tm → src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.4.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023 # (C) 2023
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::ns 0.1.3 # Application punk::ns 0.1.4
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -5597,8 +5597,25 @@ y" {return quirkykeyscript}
if {[llength $testresolved] == 1} { if {[llength $testresolved] == 1} {
#only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand #only the command itself is in the args_resolved list - so we can't resolve to a deeper subcommand
ledit queryargs -1 -1 {*}$args_remaining ;#prepend ledit queryargs -1 -1 {*}$args_remaining ;#prepend
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $estyle withid $rootdoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values - nothing to mark and
#nothing wrong with the user's (absent) input, so we show plain usage in the
#info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the
#full usage table INSIDE the raised error only for it to be discarded here -
#doubling display time for large argdocs (e.g 'i punk::args::define').
if {![llength $queryargs]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $queryargs -form $opt_form -errorstyle $advisory_estyle withid $rootdoc} parseresult]} {
if {![llength $queryargs]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -5679,8 +5696,25 @@ y" {return quirkykeyscript}
} }
if {$origindoc ne ""} { if {$origindoc ne ""} {
#important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc #important not to use "-cache 1" for this parse - need to reflect dynamically updated ensembles etc
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $estyle withid $origindoc} parseresult]} { #advisory goodargs parse (marking of supplied words). With NO supplied trailing args
if {$opt_return eq "tableobject"} { #a failure only reflects missing required leaders/values (e.g 'i string is') - nothing
#to mark and nothing wrong with the user's (absent) input, so we show plain usage in
#the info scheme instead of the internal-looking parse error (G-046 item 5).
#Use -errorstyle minimal for that case: the $estyle rendering would build the full
#usage table INSIDE the raised error only for it to be discarded here - doubling
#display time for large argdocs (e.g 'i punk::args::define').
if {![llength $args_remaining]} {
set advisory_estyle minimal
} else {
set advisory_estyle $estyle
}
if {[catch {punk::args::parse $args_remaining -cache 0 -form $opt_form -errorstyle $advisory_estyle withid $origindoc} parseresult]} {
if {![llength $args_remaining]} {
if {!$scheme_received} {
dict set nextopts -scheme info
}
set result [punk::args::arg_error "" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} elseif {$opt_return eq "tableobject"} {
set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0] set result [punk::args::arg_error "$parseresult" [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0]
} else { } else {
set result $parseresult set result $parseresult
@ -7608,6 +7642,6 @@ namespace eval ::punk::args::register {
## Ready ## Ready
package provide punk::ns [tcl::namespace::eval punk::ns { package provide punk::ns [tcl::namespace::eval punk::ns {
variable version variable version
set version 0.1.3 set version 0.1.4
}] }]
return return
Write Preview
Loading…
Cancel
Save