diff --git a/src/modules/argparsingtest-999999.0a1.0.tm b/src/modules/argparsingtest-999999.0a1.0.tm index 41960c16..a6a7d014 100644 --- a/src/modules/argparsingtest-999999.0a1.0.tm +++ b/src/modules/argparsingtest-999999.0a1.0.tm @@ -340,6 +340,10 @@ namespace eval argparsingtest { set argd [punk::args::parse $args withid ::argparsingtest::test1_punkargs2] return [tcl::dict::get $argd opts] } + proc test1_punkargs2_parsecache {args} { + set argd [punk::args::parse $args -cache 1 withid ::argparsingtest::test1_punkargs2] + return [tcl::dict::get $argd opts] + } proc test1_punkargs_validate_ansistripped {args} { diff --git a/src/modules/patternpunk-1.1.tm b/src/modules/patternpunk-1.1.tm index bd3f44bd..27a93bd5 100644 --- a/src/modules/patternpunk-1.1.tm +++ b/src/modules/patternpunk-1.1.tm @@ -116,10 +116,10 @@ punk::args::define { @id -id "::>punk . poses" @cmd -name ">punk . poses" -help "Show or list the poses for the Punk mascot" -censored -default 1 -type boolean -help "Set true to include mild toilet humour poses" - -return -default table -choices {list table} + -return -default table -choices {names table list dict} } >punk .. Method poses {args} { - set argd [punk::args::get_by_id ">punk . poses" $args] + set argd [punk::args::parse $args withid "::>punk . poses"] set censored [dict get $argd opts -censored] set return [dict get $argd opts -return] @@ -143,14 +143,32 @@ punk::args::define { #allow toilet humour lappend poses piss poop } - if {$return eq "list"} { - return $poses - } - set cells [list] - foreach pose $poses { - lappend cells "$pose\n\n[>punk . $pose]" + switch -- $return { + names { + return $poses + } + list { + set result [list] + foreach pose $poses { + lappend result [list $pose [>punk . $pose]] + } + return $result + } + dict { + set result [dict create] + foreach pose $poses { + dict set result $pose [>punk . $pose] + } + return $result + } + table { + set cells [list] + foreach pose $poses { + lappend cells "$pose\n\n[>punk . $pose]" + } + return [textblock::list_as_table -show_hseps 1 -columns 4 $cells] + } } - textblock::list_as_table -show_hseps 1 -columns 4 $cells } >punk .. Property front [string trim { @@ -370,7 +388,7 @@ _+ +_ #TODO - reuse textblock::gcross arguments - but reorder for error display >punk .. Method gcross {{size 1} args} { package require textblock - set argd [punk::args::get_by_id ::textblock::gcross [list {*}$args $size]] + set argd [punk::args::parse [list {*}$args $size] withid ::textblock::gcross] textblock::gcross {*}$args $size } diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 99deefb5..1f52be5a 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -171,7 +171,8 @@ tcl::namespace::eval punk::ansi::class { } default { puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x" - punk::args::get_by_id "::punk::ansi::class::class_ansi render_to_input_line" $args + punk::args::parse $args withid "::punk::ansi::class::class_ansi render_to_input_line" + return } } } @@ -2763,7 +2764,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu @values -min 0 -max 0 }] proc sgr_cache {args} { - set argd [punk::args::get_by_id ::punk::ansi::sgr_cache $args] + set argd [punk::args::parse $args withid ::punk::ansi::sgr_cache] set action [dict get $argd opts -action] set pretty [dict get $argd opts -pretty] @@ -3943,7 +3944,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend codestack $code } else { #jjtest - apend emit $code + append emit $code } } 7GFX { diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 1a08e77d..a26b98c7 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -295,6 +295,8 @@ tcl::namespace::eval ::punk::args::helpers { tcl\ " Very basic tcl syntax highlighting of braces,square brackets and comments." + -title -type string -default "" + -titlealign -type string -choices {left centre right} } text -type string }] @@ -313,10 +315,12 @@ tcl::namespace::eval ::punk::args::helpers { set defaults [dict create\ -padright 2\ -syntax tcl\ + -title ""\ + -titlealign left\ ] dict for {o v} $optlist { switch -- $o { - -padright - -syntax {} + -padright - -syntax - -title - -titlealign {} default { punk::args::parse $args withid ::punk::args::helpers::example return @@ -324,8 +328,10 @@ tcl::namespace::eval ::punk::args::helpers { } } set opts [dict merge $defaults $optlist] - set opt_padright [dict get $opts -padright] - set opt_syntax [dict get $opts -syntax] + set opt_padright [dict get $opts -padright] + set opt_syntax [dict get $opts -syntax] + set opt_title [dict get $opts -title] + set opt_titlealign [dict get $opts -titlealign] if {[string index $str 0] eq "\n"} { set str [string range $str 1 end] @@ -342,7 +348,13 @@ tcl::namespace::eval ::punk::args::helpers { if {$opt_padright > 0} { set str [textblock::join -- $str [string repeat " " $opt_padright]] } - set str [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] + + if {$opt_title ne ""} { + set title "[a+ term-black Term-silver]$opt_title[a]" + } else { + set title "" + } + set str [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey white] -ansiborder [a+ term-black Term-silver] -titlealign $opt_titlealign -title $title -boxlimits {hl} -type block $str]] #puts stderr ------------------- #puts $str #puts stderr ------------------- @@ -353,11 +365,11 @@ tcl::namespace::eval ::punk::args::helpers { tcl { #result lines often indicated in examples by \u2192 → #however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?) - set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one - set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {;\s*(#.*)} $str] + set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one + set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str] #TODO - fix grepstr highlighting (bg issues - why?) - set str [punk::grepstr -return all -highlight {Web-gray term-darkblue} {\{|\}} $str] - set str [punk::grepstr -return all -highlight {Web-gray term-orange1} {\[|\]} $str] + set str [punk::grepstr -return all -highlight {Term-grey term-darkblue} {\{|\}} $str] + set str [punk::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str] #puts stderr ------------------- #puts $str #puts stderr ------------------- @@ -368,8 +380,8 @@ tcl::namespace::eval ::punk::args::helpers { return $result } lappend PUNKARGS [list { - @id -id ::punk::args::helpers::strip_nodisplay_comments - @cmd -name punk::args::helpers::strip_nodisplay_comments\ + @id -id ::punk::args::helpers::strip_nodisplay_lines + @cmd -name punk::args::helpers::strip_nodisplay_lines\ -summary\ "strip # lines."\ -help\ @@ -378,13 +390,13 @@ tcl::namespace::eval ::punk::args::helpers { prior to examining each line for the # tag." @values -min 1 -max 1 text -optional 0 -help\ - "punk::args::define scripts must have properly balanced braces etc + {punk::args::define scripts must have properly balanced braces etc as per Tcl rules. Sometimes it is desired to display help text or examples demonstrating unbalanced braces etc, but without escaping it in a way that shows the escaping backslash in the help text. This balancing requirement includes curly braces in comments. eg - ${[punk::args::helpers::example { + ${[punk::args::helpers::example -title " Example 1a " { proc bad_syntax {args} { #eg this is an unbalanced left curly brace { # balancing right curly brace } @@ -397,7 +409,7 @@ tcl::namespace::eval ::punk::args::helpers { The actual text is in a placeholder call to punk::args::helpers::example to provide basic syntax highlighting and box background, and looks like the following, but without the left-hand side pipe symbols. - ${[punk::args::helpers::example -syntax none { + ${[punk::args::helpers::example -syntax none -title " Example 1b " { | proc bad_syntax {args} { | #eg this is an unbalanced left curly brace { | # balancing right curly brace } @@ -405,20 +417,33 @@ tcl::namespace::eval ::punk::args::helpers { | } }]} + Technically a proc body can exist with an unbalanced brace in a comment + like that and would still run without issue. However, such a definition + couldn't be placed in a tcl file to be sourced, nor directly evaluated + with eval. + A # comment can also be used just for commenting the help source inline. - - The ${[B]}strip_nodisplay_comments${[N]} function is called automatically + Note that an opening square bracket can't be balanced by a line beginning + with the # character. + The non-comment form @# is available so help lines beginning + with this token will also be stripped. This can be used to 'close' a + section of text that happens to look like a command block. This should + only be used if there is some reason the opening square bracket can't + be rewritten in the help doc to be escaped with a backslash. + + The ${[B]}strip_nodisplay_lines${[N]} function is called automatically by the help text generators in punk::args, and generally shouldn't need to be used directly, but nevertheless resides in in punk::args::helpers alongside the ${[B]}example${[N]} function which is intended for writers of punk::args::define scripts (command documentors) to use. - " + } }] - proc strip_nodisplay_comments {text} { + proc strip_nodisplay_lines {text} { set display "" foreach ln [split $text \n] { - if {![string match "#*" [string trimleft [punk::ansi::ansistrip $ln]]]} { + set stripped [string trimleft [punk::ansi::ansistrip $ln]] + if {![string match "#*" $stripped] && ![string match "@#*" $stripped]} { append display $ln \n } } @@ -578,6 +603,7 @@ tcl::namespace::eval punk::args { directive-options: -help %B%@seealso%N% ?opt val...? directive-options: -name -url (for footer - unimplemented) + %B%@instance%N% ?opt val...? Some other options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults @@ -789,9 +815,15 @@ tcl::namespace::eval punk::args { column. For the @examples directive this is the text for examples as displayed with 'eg ' + The -help string can be delimited with double quotes or with + curly braces, the choice will affect what inner chars require + backslash escaping - but neither type of help block is + automatically subject to variable or command substitution aside + from those specifically wrapped in placeholders. + For cases where unbalanced braces, double quotes are to be displayed to the user without visible backslash escapes, - see 'i ::punk::args::helpers::strip_nodisplay_comments' + see 'i ::punk::args::helpers::strip_nodisplay_lines' " -dynamic -type boolean -default 0 -help\ "If -dynamic is true, tstr interpolations of the form \$\{\$var\} @@ -1363,13 +1395,15 @@ tcl::namespace::eval punk::args { #puts stderr 4[lindex $records 4] #puts stderr 5[lindex $records 5] #puts stderr 6[lindex $records 6] - + set cmd_info {} set package_info {} set id_info {} ;#e.g -children ?? set doc_info {} #set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table set seealso_info {} + #set credits_info {} ;#e.g see interp man CREDITS section todo - where to display? + set instance_info {} set keywords_info {} set examples_info {} ###set leader_min 0 @@ -1401,8 +1435,9 @@ tcl::namespace::eval punk::args { puts stdout "----------------------------------------------" puts stderr "rec: $rec" set ::testrecord $rec - puts "records: $records" puts stdout "----------------------------------------------" + puts "records: $records" + puts stdout "==============================================" } set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict if {[llength $record_values] % 2 != 0} { @@ -2046,6 +2081,10 @@ tcl::namespace::eval punk::args { #like @doc, except displays in footer, multiple - sub-table? set seealso_info [dict merge $seealso_info $at_specs] } + instance { + #todo! + set instance_info [dict merge $instance_info $at_specs] + } keywords { #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? set keywords_info [dict merge $keywords_info $at_specs] @@ -2621,6 +2660,7 @@ tcl::namespace::eval punk::args { doc_info $doc_info\ package_info $package_info\ seealso_info $seealso_info\ + instance_info $instance_info\ keywords_info $keywords_info\ examples_info $examples_info\ id_info $id_info\ @@ -2653,9 +2693,9 @@ tcl::namespace::eval punk::args { namespace eval argdoc { - variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @leaders @opts @values leaders opts values} + variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @instance @leaders @opts @values leaders opts values} variable resolved_def_TYPE_CHOICEGROUPS { - directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso} + directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso @instance} argumenttypes {leaders opts values} remaining_defaults {@leaders @opts @values} } @@ -2872,7 +2912,7 @@ tcl::namespace::eval punk::args { dict set resultdict @id [list -id [dict get $specdict id]] } } - foreach directive {@package @cmd @doc @examples @seealso} { + foreach directive {@package @cmd @doc @examples @seealso @instance} { set dshort [string range $directive 1 end] if {"$directive" in $included_directives} { if {[dict exists $opt_override $directive]} { @@ -2939,7 +2979,7 @@ tcl::namespace::eval punk::args { } } } - @package - @cmd - @doc - @examples - @seealso { + @package - @cmd - @doc - @examples - @seealso - @instance { if {"$type" in $included_directives} { set tp [string range $type 1 end] ;# @package -> package if {[dict exists $opt_override $type]} { @@ -3863,7 +3903,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" #set cmdhelp_display [a+ brightwhite]$cmdhelp[a] #set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)] - set cmdhelp [punk::args::helpers::strip_nodisplay_comments $cmdhelp] + set cmdhelp [punk::args::helpers::strip_nodisplay_lines $cmdhelp] set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp] } else { set cmdhelp_display "" @@ -4248,7 +4288,7 @@ tcl::namespace::eval punk::args { } set unindentedfields [Dict_getdef $arginfo -unindentedfields {}] set help [Dict_getdef $arginfo -help ""] - set help [punk::args::helpers::strip_nodisplay_comments $help] + set help [punk::args::helpers::strip_nodisplay_lines $help] set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] @@ -4804,7 +4844,6 @@ tcl::namespace::eval punk::args { Will usually match the command name" }] proc usage {args} { - #lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received set id [dict get $values id] set real_id [real_id $id] @@ -4909,6 +4948,12 @@ tcl::namespace::eval punk::args { #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #todo - configurable per interp/namespace -errorstyle -type string -default enhanced -choices {enhanced standard basic minimal} + -cache -type boolean -default 0 -help\ + {Use sparingly. + This uses a cache for same arguments being parsed against + the same definition. + It is a minor speedup suitable for when a small set of similar + (and generally small) arguments are repeatedly used by a function.} @values -min 2 @@ -4934,6 +4979,7 @@ tcl::namespace::eval punk::args { how to process the definition." }] + variable parse_cache [dict create] proc parse {args} { #puts "punk::args::parse --> '$args'" set tailtype "" ;#withid|withdef @@ -4998,6 +5044,7 @@ tcl::namespace::eval punk::args { set defaultopts [dict create\ -form {*}\ -errorstyle standard\ + -cache 0\ ] #todo - load override_errorstyle from configuration @@ -5006,7 +5053,7 @@ tcl::namespace::eval punk::args { set opts [dict merge $defaultopts $opts] dict for {k v} $opts { switch -- $k { - -form - -errorstyle { + -form - -errorstyle - -cache { } default { #punk::args::usage $args withid ::punk::args::parse ?? @@ -5043,7 +5090,19 @@ tcl::namespace::eval punk::args { } try { #puts stdout "parse --> get_dict $parseargs -form [dict get $opts -form]" - set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]] + if {![dict get $opts -cache]} { + set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]] + } else { + variable parse_cache + set key [list $parseargs $deflist [dict get $opts -form]] + if {[dict exists $parse_cache $key]} { + set result [dict get $parse_cache $key] + } else { + set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]] + dict set parse_cache $key $result + } + return $result + } } trap {PUNKARGS VALIDATION} {msg erroropts} { set opt_errorstyle [dict get $opts -errorstyle] @@ -7397,7 +7456,7 @@ tcl::namespace::eval punk::args { # ----------------------------------------------- # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) tcl::dict::with argspecs {} ;#turn keys into vars - #e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info,id_info,form_names + #e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names # ----------------------------------------------- set opt_form [dict get $proc_opts -form] if {$opt_form eq "*"} { @@ -9349,7 +9408,7 @@ tcl::namespace::eval punk::args { } if {[dict exists $spec examples_info -help]} { set egdata [dict get $spec examples_info -help] - return [punk::args::helpers::strip_nodisplay_comments $egdata] + return [punk::args::helpers::strip_nodisplay_lines $egdata] } else { return "no @examples defined for $id" } @@ -9374,7 +9433,8 @@ tcl::namespace::eval punk::args { cmditem -multiple 1 -optional 0 }] proc synopsis {args} { - set argd [punk::args::parse $args withid ::punk::args::synopsis] + #synopsis potentially called repeatedly with same args? use -cache 1 + set argd [punk::args::parse $args -cache 1 withid ::punk::args::synopsis] if {[catch {package require punk::ansi} errM]} { set has_punkansi 0 diff --git a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm index f90afc36..a32fc215 100644 --- a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm @@ -132,38 +132,6 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { namespace import ::punk::args::helpers::* - #proc example {str} { - # if {[string index $str 0] eq "\n"} { - # set str [string range $str 1 end] - # } - # if {[string index $str end] eq "\n"} { - # set str [string range $str 0 end-1] - # } - # #example is intended to run from a source doc that has already been dedented appropriately based on context - # # - we don't want to further undent, hence -undent 0 - # set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]] - # #puts stderr ------------------- - # #puts $str - # #puts stderr ------------------- - - # set str [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] - # #puts stderr ------------------- - # #puts $str - # #puts stderr ------------------- - - # #rudimentary colourising (not full tcl syntax parsing) - # #highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments - # set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one - # #TODO - fix grepstr highlighting (bg issues - why?) - # set str [punk::grepstr -return all -highlight {Web-gray term-darkblue} {\{|\}} $str] - # set str [punk::grepstr -return all -highlight {Web-gray term-orange1} {\[|\]} $str] - # #puts stderr ------------------- - # #puts $str - # #puts stderr ------------------- - - # set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"] - # return $result - #} } @@ -4356,7 +4324,33 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 0 arg -type string -optional 1 -multiple 1 -help\ "Usually, but not necessarily a proper Tcl list" - } "@doc -name Manpage: -url [manpage_tcl concat]" ] + } "@doc -name Manpage: -url [manpage_tcl concat]"\ + { + @examples -help { + Although concat will concatenate lists, flattening them in the process (so giving the following interactive session): + ${[example { + % ${$B}concat${$N} a b {c d e} {f {g h}} + a b c d e f {g h} + }]} + it will also concatenate things that are not lists, as can be seen from this session: + ${[example { + % ${$B}concat${$N} " a b {c " d " e} f" + a b {c d e} f + }]} + Note also that the concatenation does not remove spaces from the middle of values, as can be seen here: + ${[example { + % ${$B}concat${$N} "a b c" { d e f } + a b c d e f + }]} + (i.e., there are three spaces between each of the a, the b and the c). + + For true list concatenation, the ${$B}list${$N} command should be used with expansion of each input list: + ${[example { + % list {*}"a b c" {*}{ d e f } + a b c d e f + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @@ -4386,7 +4380,44 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { varName -help "" value - } "@doc -name Manpage: -url [manpage_tcl const]" ] + } "@doc -name Manpage: -url [manpage_tcl const]"\ + { + @examples -help { + Create a constant in a procedure: + ${[example { + proc foo {a b} { + ${$B}const${$N} BAR 12345 + return [expr {$a + $b + $BAR}] + } + }]} + Create a constant in a namespace to factor out a regular expression: + ${[example { + namespace eval someNS { + ${$B}const${$N} FOO_MATCHER {(?i)\mfoo\M} + + proc findFoos str { + variable FOO_MATCHER + regexp -all $FOO_MATCHER $str + } + + proc findFooIndices str { + variable FOO_MATCHER + regexp -all -indices $FOO_MATCHER $str + } + } + }]} + Making a constant in a loop doesn't error: + ${[example { + proc foo {n} { + set result {} + for {set i 0} {$i < $n} {incr i} { + ${$B}const${$N} X 123 + lappend result [expr {$X + $i**2}] + } + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::continue @@ -4478,7 +4509,17 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { code -type list -optional 1 -help\ "machine-readable data to store in -errorcode return option" - } "@doc -name Manpage: -url [manpage_tcl error]" ] + } "@doc -name Manpage: -url [manpage_tcl error]"\ + { + @examples -help { + Generate an error if a basic mathematical operation fails: + ${[example { + if {1+2 != 3} { + ${$B}error${$N} "something is very wrong with addition" + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::eval @@ -5160,6 +5201,125 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } }] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # ::interp subcommands + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # ::interp alias + punk::args::define { + @id -id "::interp aliases" + @cmd -name "Built-in: ::interp aliases"\ + -summary\ + "List interp aliases"\ + -help\ + "This command returns a Tcl list of the tokens of all the source commands for aliases defined in the interpreter + identified by ${$I}path${$NI}. The tokens correspond to the values returned when the aliases were created (which may not be + the same as the current names of the commands)." + @values -min 0 -max 1 + path -type string -optional 1 + } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl aliases]" + + punk::args::define { + @id -id "::interp bgerror" + @cmd -name "Built-in: ::interp bgerror"\ + -summary\ + "Get/set interp's background error handler"\ + -help\ + "This command either gets or sets the current background exception handler for the interpreter identified by path. + If cmdPrefix is absent, the current background exception handler is returned, and if it is present, it is a list + of words (of minimum length one) that describes what to set the interpreter's background exception handler to. + See the BACKGROUND EXCEPTION HANDLING section for more details." + @values -min 1 -max 2 + path -type string -optional 0 + cmdPrefix -type list -optional 1 + } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl aliases]" + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # ::interp + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + set INTERP_CHOICES [list alias aliases bgerror cancel children create debug delete eval exists expose hide hidden invokehidden issafe limit marktrusted recursionlimit share target transfer] + #manual synopses for subcommands not yet defined + set INTERP_CHOICELABELS [subst -novariables { + }] + set INTERP_CHOICEGROUPS [dict create\ + "" {}\ + lifecycle {create delete exists children}\ + ] + set INTERP_GROUPALLOCATED [list] + dict for {g glist} $INTERP_CHOICEGROUPS { + lappend INTERP_GROUPALLOCATED {*}$glist + } + foreach sub $INTERP_CHOICES { + if {$sub ni $INTERP_GROUPALLOCATED} { + dict lappend INTERP_CHOICEGROUPS "" $sub + } + } + set INTERP_CHOICEINFO [dict create] + foreach sub $INTERP_CHOICES { + #default for all + dict set INTERP_CHOICEINFO $sub {{doctype native}} + } + foreach id [punk::args::get_ids "::interp *"] { + if {[llength $id] == 2} { + lassign $id _ sub + dict set INTERP_CHOICEINFO $sub {{doctype native} {doctype punkargs}} + #override manual synopsis entry + dict set INTERP_CHOICELABELS $sub [punk::ansi::a+ normal][punk::args::synopsis "::interp $sub"] + } + } + + #III + punk::args::define { + @id -id ::interp + @cmd -name "Built-in: ::interp"\ + -summary\ + "Create and manipulate Tcl interpreters."\ + -help\ + "" + @leaders -min 1 -max 1 + subcommand -type string\ + -choicecolumns 2\ + -choicegroups\ + {${$INTERP_CHOICEGROUPS}}\ + -unindentedfields {-choicelabels}\ + -choicelabels\ + {${$INTERP_CHOICELABELS}}\ + -choiceinfo {${$INTERP_CHOICEINFO}} + @values -unnamed true + } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl interp]"\ + { + @examples -help { + Creating and using an alias for a command in the current interpreter: + ${[example { + ${$B}interp alias${$N} {} getIndex {} lsearch {alpha beta gamma delta} + set idx [getIndex delta] + }]} + Executing an arbitrary command in a safe interpreter where every invocation of ${$B}lappend${$N} is logged: + ${[example { + set i [${$B}interp create${$N} -safe] + ${$B}interp hide${$N} $i lappend + ${$B}interp alias${$N} $i lappend {} loggedLappend $i + proc loggedLappend {i args} { + puts "logged invocation of lappend $args" + ${$B}interp invokehidden${$N} $i lappend {*}$args + } + ${$B}interp eval${$N} $i $someUntrustedScript + }]} + Setting a resource limit on an interpreter so that an infinite loop terminates. + ${[example { + set i [${$B}interp create${$N}] + ${$B}interp limit${$N} $i command -value 1000 + ${$B}interp eval${$N} $i { + set x 0 + while {1} { + puts "Counting up... [incr x]" + } + } + }]} + } + } + + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @dynamic @@ -6790,6 +6950,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } } + #III punk::args::define { @id -id ::package @cmd -name "Built-in: ::package"\ @@ -7012,6 +7173,170 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } "@doc -name Manpage: -url [manpage_tcl read]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::regsub + @cmd -name "Built-in: regsub"\ + -summary\ + "Perform substitutions based on regular expression pattern matching."\ + -help\ + "This command matches the regular expression ${$I}exp${$NI} against ${$I}string${$NI}, and either copies string to the + variable whose name is given by ${$I}varName${$NI} or returns ${$I}string${$NI} if ${$I}varName${$NI} is not present. (Regular + expression matching is described in the re_syntax reference page.) If there is a match, then while + copying ${$I}string${$NI} to ${$I}varName${$NI} (or to the result of this command if ${$I}varName${$NI} is not present) the portion + of string that matched ${$I}exp${$NI} is replaced with ${$I}subSpec${$NI}. If ${$I}subSpec${$NI} contains a “&” or “\0”, then it is + replaced in the substitution with the portion of ${$I}string${$NI} that matched ${$I}exp${$NI}. If ${$I}subSpec${$NI} contains a “\n”, + where n is a digit between 1 and 9, then it is replaced in the substitution with the portion of + ${$I}string${$NI} that matched the n'th parenthesized subexpression of ${$I}exp${$NI}. Additional backslashes may be used + in ${$I}subSpec${$NI} to prevent special interpretation of “&”, “\0”, “\n” and backslashes. The use of + backslashes in ${$I}subSpec${$NI} tends to interact badly with the Tcl parser's use of backslashes, so it is + generally safest to enclose ${$I}subSpec${$NI} in braces if it includes backslashes. + + If the initial arguments to ${$B}regsub${$N} start with - then they are treated as switches." + @leaders -min 0 -max 0 + @opts + -all -type none -help\ + {All ranges in string that match exp are found and substitution is performed for each of + these ranges. Without this switch only the first matching range is found and substituted. + If ${$B}-all${$N} is specified, then “&” and “\n” sequences are handled for each substitution using + the information from the corresponding match.} + -command -type none -help\ + {Changes the handling of subSpec so that it is not treated as a template for a substitution + string and the substrings “&” and “\n” no longer have special meaning. Instead subSpec must + be a command prefix, that is, a non-empty list. The substring of string that matches exp, + and then each substring that matches each capturing sub-RE within exp are appended as + additional elements to that list. (The items appended to the list are much like what regexp + -inline would return). The completed list is then evaluated as a Tcl command, and the result + of that command is the substitution string. Any error or exception from command evaluation + becomes an error or exception from the ${$B}regsub${$N} command. + + If -all is not also given, the command callback will be invoked at most once (exactly when + the regular expression matches). If -all is given, the command callback will be invoked for + each matched location, in sequence. The exact location indices that matched are not made + available to the script. + + See EXAMPLES (cmd: eg regsub) for illustrative cases.} + -expanded -type none -help\ + "Enables use of the expanded regular expression syntax where whitespace and comments are ignored. + This is the same as specifying the (?x) embedded option (see the re_syntax manual page). + " + -line -type none -help\ + "Enables newline-sensitive matching. By default, newline is a completely ordinary character with + no special meaning. With this flag, “[^” bracket expressions and “.” never match newline, “^” + @# ] + matches an empty string after any newline in addition to its normal function, and “$” matches + an empty string before any newline in addition to its normal function. This flag is equivalent + to specifying both ${$B}-linestop${$N} and ${$B}-lineanchor${$N}, or the (?n) embedded option (see the re_syntax + manual page). + " + -linestop -type none -help\ + "Changes the behavior of “[^” bracket expressions and “.” so that they stop at newlines. This is + @# ] + the same as specifying the (?p) embedded option (see the re_syntax manual page). + " + -lineanchor -type none -help\ + "Changes the behavior of “^” and “$” (the “anchors”) so they match the beginning and end of a + line respectively. This is the same as specifying the (?w) embedded option (see the re_syntax + manual page)." + -nocase -type none -help\ + "Upper-case characters in string will be converted to lower-case before matching against exp; + however, substitutions specified by subSpec use the original unconverted form of string." + -start -type indexexpression -typesynopsis {${$I}index${$NI}} -help\ + "Specifies a character index offset into the string to start matching the regular + expression at. The index value is interpreted in the same manner as the index + argument to string index. When using this switch, “^” will not match the + beginning of the line, and \A will still match the start of the string at index. + index will be constrained to the bounds of the input string." + -- -type none + @values -min 3 -max 4 + exp -type string -help "regular expression" + string + subSpec -type string -help "substitution specification" + varName -type string -optional 1 -help\ + "If ${$I}varName${$NI} is supplied, the command returns a count of the number of matching + ranges that were found and replaced, otherwise the string after replacement is + returned. See the manual entry for ${$B}regexp${$N} for details on the interpretation of + regular expressions." + } "@doc -name Manpage: -url [manpage_tcl regsub]"\ + { + @examples -help { + Replace (in the string in variable ${$I}string${$NI}) every instance of ${$B}foo${$N} which is a word by itself with ${$B}bar${$N}: + ${[example { + ${$B}regsub${$N} -all {\mfoo\M} $string bar string + }]} + or (using the “basic regular expression” syntax): + ${[example { + ${$B}regsub${$N} -all {(?b)\} $string bar string + }]} + Insert double-quotes around the first instance of the word ${$B}interesting${$N}, however it is capitalized. + ${[example { + ${$B}regsub${$N} -nocase {\yinteresting\y} $string {"&"} string + }]} + Convert all non-ASCII and Tcl-significant characters into \u escape sequences by using ${$B}regsub${$N} and ${$B}subst${$N} in combination: + ${[example { + # This RE is just a character class for almost everything "bad" + set RE {[][{};#\\\$ \r\t\u0080-\uffff]} + + # We will substitute with a fragment of Tcl script in brackets + set substitution {[format \\\\u%04x [scan "\\&" %c]]} + + # Now we apply the substitution to get a subst-string that + # will perform the computational parts of the conversion. Note + # that newline is handled specially through string map since + # backslash-newline is a special sequence. + set quoted [subst [string map {\n {\\u000a}} \ + [${$B}regsub${$N} -all $RE $string $substitution]]] + }]} + The above operation can be done using ${$B}regsub -command${$N} instead, which is often faster. + (A full pre-computed string map would be faster still, but the cost of computing the map + for a transformation as complex as this can be quite large.) + ${[example { + # This RE is just a character class for everything "bad" + set RE {[][{};#\\\$\s\u0080-\uffff]} + + # This encodes what the RE described above matches + proc encodeChar {ch} { + # newline is handled specially since backslash-newline is a + # special sequence. + if {$ch eq "\n"} { + return "\\u000a" + } + # No point in writing this as a one-liner + scan $ch %c charNumber + format "\\u%04x" $charNumber + } + + set quoted [${$B}regsub${$N} -all -command $RE $string encodeChar] + }]} + Decoding a URL-encoded string using ${$B}regsub -command${$N}, a lambda term and the ${$B}apply${$N} command. + ${[example { + # Match one of the sequences in a URL-encoded string that needs + # fixing, converting + to space and %XX to the right character + # (e.g., %7e becomes ~) + set RE {(\+)|%([0-9A-Fa-f]{2})} + + # Note that -command uses a command prefix, not a command name + set decoded [${$B}regsub${$N} -all -command $RE $string {apply {{- p h} { + # + is a special case; handle directly + if {$p eq "+"} { + return " " + } + # convert hex to a char + scan $h %x charNumber + format %c $charNumber + }}}] + }]} + The ${$B}-command${$N} option can also be useful for restricting the range of commands such as ${$B}string totitle${$N}: + ${[example { + set message "the quIck broWn fOX JUmped oVer the laZy dogS..." + puts [${$B}regsub${$N} -all -command {\w+} $message {string totitle}] + # → The Quick Brown Fox Jumped Over The Lazy Dogs.. + }]} + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::rename @@ -7027,7 +7352,22 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 2 -max 2 oldName -type string newName -type string - } "@doc -name Manpage: -url [manpage_tcl rename]" + } "@doc -name Manpage: -url [manpage_tcl rename]"\ + { + @examples -help { + The ${$B}rename${$N} command can be used to wrap the standard Tcl commands with your own monitoring machinery. + For example, you might wish to count how often the ${$B}source${$N} command is called: + ${[example { + ${$B}rename${$N} ::source ::theRealSource + set sourceCount 0 + proc ::source args { + global sourceCount + puts "called source for the [incr sourceCount]'th time" + uplevel 1 ::theRealSource $args + } + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -10395,35 +10735,6 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# Secondary API namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval punk::args::moduledoc::tclcore::lib { - tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase - tcl::namespace::path [tcl::namespace::parent] - #*** !doctools - #[subsection {Namespace punk::args::moduledoc::tclcore::lib}] - #[para] Secondary functions that are part of the API - #[list_begin definitions] - - #proc utility1 {p1 args} { - # #*** !doctools - # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] - # #[para]Description of utility1 - # return 1 - #} - - - - #*** !doctools - #[list_end] [comment {--- end definitions namespace punk::args::moduledoc::tclcore::lib ---}] -} -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ - - - -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ - namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace diff --git a/src/modules/punk/basictelnet-999999.0a1.0.tm b/src/modules/punk/basictelnet-999999.0a1.0.tm index f2392b62..3a591d12 100644 --- a/src/modules/punk/basictelnet-999999.0a1.0.tm +++ b/src/modules/punk/basictelnet-999999.0a1.0.tm @@ -472,7 +472,7 @@ namespace eval punk::basictelnet { "TCP port" } proc telnet {args} { - set argd [punk::args::get_by_id ::punk::basictelnet::telnet $args] + set argd [punk::args::parse $args withid ::punk::basictelnet::telnet] set server [dict get $argd values server] set port [dict get $argd values port] set tmode [dict get $argd opts -mode] diff --git a/src/modules/punk/blockletter-999999.0a1.0.tm b/src/modules/punk/blockletter-999999.0a1.0.tm index f097deba..a9f80b1f 100644 --- a/src/modules/punk/blockletter-999999.0a1.0.tm +++ b/src/modules/punk/blockletter-999999.0a1.0.tm @@ -130,7 +130,7 @@ tcl::namespace::eval punk::blockletter { proc logo {args} { variable logo_letter_colours variable default_frametype - set argd [punk::args::get_by_id ::punk::blockletter::logo $args] + set argd [punk::args::parse $args withid ::punk::blockletter::logo] set f [dict get $argd opts -frametype] set bd [dict get $argd opts -outlinecolour] set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary @@ -225,11 +225,11 @@ tcl::namespace::eval punk::blockletter { -frametype -default {${$default_frametype}} @values -min 1 -max 1 str -help "Text to convert to blockletters - Requires terminal font to support relevant block characters" - " - }] + Requires terminal font to support relevant block characters" + " + }] proc text {args} { - set argd [punk::args::get_by_id ::punk::blockletter::text $args] + set argd [punk::args::parse $args withid ::punk::blockletter::text] set opts [dict get $argd opts] set str [dict get $argd values str] set str [string map {\r\n \n} $str] @@ -293,7 +293,7 @@ tcl::namespace::eval punk::blockletter::lib { }] proc block {args} { upvar ::punk::blockletter::default_frametype ft - set argd [punk::args::get_by_id ::punk::blockletter::lib::block $args] + set argd [punk::args::parse $args withid ::punk::blockletter::lib::block] set bg [dict get $argd opts -bgcolour] set bd [dict get $argd opts -bordercolour] set h [dict get $argd opts -height] diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 1950ab8f..510fdbe5 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -669,21 +669,21 @@ namespace eval punk::console { prudent." @values -min 2 -max 2 query -type string -help\ - "ANSI sequence such as \x1b\[?6n which + {ANSI sequence such as \x1b\[?6n which should elicit a response by the terminal - on stdin" + on stdin} capturingendregex -type string -help\ - "capturingendregex should capture ANY prefix, whole escape match - and a subcapture + {capturingendregex should capture ANY prefix, whole escape match - and a subcapture of the data we're interested in; and match at end of string. ie {(.*)(ESC(info)end)$} e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} - we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)" + we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)} }] #todo - check capturingendregex value supplied has appropriate captures and tail-anchor proc get_ansi_response_payload {args} { #we pay a few 10s of microseconds to use punk::args::parse (on the happy path) #seems reasonable for the flexibility in this case. - set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload] + set argd [punk::args::parse $args -cache 1 withid ::punk::console::internal::get_ansi_response_payload] lassign [dict values $argd] leaders opts values received set inoutchannels [dict get $opts -terminal] @@ -1507,7 +1507,7 @@ namespace eval punk::console { or omit to query cell size." } proc cell_size {args} { - set argd [punk::args::get_by_id ::punk::console::cell_size $args] + set argd [punk::args::parse $args -cache 1 withid ::punk::console::cell_size] set inoutchannels [dict get $argd opts -inoutchannels] set newsize [dict get $argd values newsize] @@ -1551,7 +1551,7 @@ namespace eval punk::console { #only works in raw mode for windows terminal - (esc in output stripped?) why? # works in line mode for alacrity and wezterm proc test_is_vt52 {args} { - set argd [punk::args::get_by_id ::punk::console::test_is_vt52 $args] + set argd [punk::args::parse $args -cache 1 withid ::punk::console::test_is_vt52] set inoutchannels [dict get $argd opts -inoutchannels] #ESC / K VT52 without printer #ESC / M VT52 with printer diff --git a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm index f15ec2b7..4e54f8d5 100644 --- a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm @@ -44,14 +44,18 @@ namespace eval punk::mix::commandset::layout { #per layout functions punk::args::define { @dynamic - @id -id ::punk::mix::commandset::layout::files + @id -id ::punk::mix::commandset::layout::files + @cmd -name punk::mix::commandset::layout::files -synopsis\ + "list files in project layout"\ + -help\ + "" -datetime -default "%Y-%m-%dT%H:%M:%S" -help\ "Datetime format for mtime. Use empty string for no datetime output" @values -min 1 -max 1 layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}} } proc files {args} { - set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args] + set argd [punk::args::parse $args withid ::punk::mix::commandset::layout::files] set layout [dict get $argd values layout] set dtformat [dict get $argd opts -datetime] diff --git a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm index 8328ef27..9feaba21 100644 --- a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm @@ -44,7 +44,7 @@ namespace eval punk::mix::commandset::loadedlib { If search is not prefixed with '=' the search is case insensitive." } proc search {args} { - set argd [punk::args::get_by_id ::punk::mix::commandset::loadedlib::search $args] + set argd [punk::args::parse $args withid ::punk::mix::commandset::loadedlib::search] set searchstrings [dict get $argd values searchstring] set opts [dict get $argd opts] set opt_return [dict get $opts -return] diff --git a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm index 177f1461..011ae58e 100644 --- a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm @@ -132,7 +132,6 @@ namespace eval punk::mix::commandset::module { globsearches -default * -multiple 1 } proc templates_dict {args} { - #set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args] set argd [punk::args::parse $args withid ::punk::mix::commandset::module::templates_dict] package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { @@ -146,7 +145,10 @@ namespace eval punk::mix::commandset::module { set moduletypes [punk::mix::cli::lib::module_types] punk::args::define [subst { @id -id ::punk::mix::commandset::module::new - @cmd -name "punk::mix::commandset::module::new" -help\ + @cmd -name "punk::mix::commandset::module::new"\ + -synopsis\ + "create .tm module file from template"\ + -help\ "Create a new module file in the appropriate folder within src/modules. If the name given in the module argument is namespaced, the necessary subfolder(s) will be used or created." @@ -173,7 +175,7 @@ namespace eval punk::mix::commandset::module { proc new {args} { set year [clock format [clock seconds] -format %Y] # use \uFFFD because unicode replacement char should consistently render as 1 wide - set argd [punk::args::get_by_id ::punk::mix::commandset::module::new $args] + set argd [punk::args::parse $args withid ::punk::mix::commandset::module::new] lassign [dict values $argd] leaders opts values received set module [dict get $values module] diff --git a/src/modules/punk/nav/fs-999999.0a1.0.tm b/src/modules/punk/nav/fs-999999.0a1.0.tm index 5cacc6f0..9e7783b3 100644 --- a/src/modules/punk/nav/fs-999999.0a1.0.tm +++ b/src/modules/punk/nav/fs-999999.0a1.0.tm @@ -644,7 +644,7 @@ tcl::namespace::eval punk::nav::fs { @values -min 0 -max -1 -unnamed true } proc dirfiles {args} { - set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles $args] + set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles] lassign [dict values $argd] leaders opts values_dict set opt_stripbase [dict get $opts -stripbase] @@ -1005,7 +1005,7 @@ tcl::namespace::eval punk::nav::fs { #todo - color key via repl-telemetry? help command? documentation? or add tag columns as done in namespace listing? proc dirfiles_dict_as_lines {args} { package require overtype - set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles_dict_as_lines $args] + set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict_as_lines] lassign [dict values $argd] leaders opts vals set list_of_dicts [dict values $vals] diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 919484dd..a961e6cd 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -2447,7 +2447,8 @@ tcl::namespace::eval punk::ns { "Name of ensemble command for which subcommand info is gathered." } proc ensemble_subcommands {args} { - set argd [punk::args::get_by_id ::punk::ns::ensemble_subcommands $args] + #puts stderr "---> punk::ns::ensemble_subcommands $args" + set argd [punk::args::parse $args -cache 1 withid ::punk::ns::ensemble_subcommands] set opts [dict get $argd opts] set origin [dict get $argd values origin] @@ -3087,6 +3088,7 @@ tcl::namespace::eval punk::ns { }] append argdef \n $vline append argdef \n "@values -unnamed true" + append argdef \n "@instance -help {instance info derived from id (instance)::$origin ?}" punk::args::define $argdef } @@ -3331,7 +3333,7 @@ tcl::namespace::eval punk::ns { } variable cmdinfo_reducerid 0 proc cmdinfo {args} { - set argd [punk::args::parse $args withid ::punk::ns::cmdinfo] + set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdinfo] lassign [dict values $argd] leaders opts values received set cmdlist [dict get $values cmditem] @@ -5670,7 +5672,7 @@ tcl::namespace::eval punk::ns { e.g ::mynamespace::a* ::mynamespace::j*" } proc nsimport_noclobber {args} { - lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received + lassign [dict values [punk::args::parse $args withid ::punk::ns::nsimport_noclobber]] leaders opts values received set sourcepatterns [dict get $values sourcepattern] set nscaller [uplevel 1 {namespace current}] @@ -5828,12 +5830,12 @@ tcl::namespace::eval punk::ns { "Command names for which to show help info" } interp alias {} i+ {}\ - .=args> punk::args::get_by_id ::i+ |argd>\ - .=>2 dict get values cmd |cmds>\ - .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ - .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ - .=objs>2 lmap t {$t print} |tables>\ - .=objs>2 lmap t {$t destroy} |>\ + .=args>1 punk::args::parse withid ::i+ |argd>\ + .=>2 dict get values cmd |cmds>\ + .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ + .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ + .=objs>2 lmap t {$t print} |tables>\ + .=objs>2 lmap t {$t destroy} |>\ .=tables>* textblock::join --