From b368ce51acd028df04ca32f2e150f2b5d2b66f3b Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Thu, 23 Oct 2025 02:02:50 +1100 Subject: [PATCH] punk::ns and punk::args better processing of ensemble commands with leading parameters, documentation and layout improvements --- src/modules/argparsingtest-999999.0a1.0.tm | 4 +- src/modules/punk-0.1.tm | 50 +- src/modules/punk/ansi-999999.0a1.0.tm | 40 +- src/modules/punk/args-999999.0a1.0.tm | 346 ++- src/modules/punk/args-buildversion.txt | 2 +- .../args/moduledoc/tclcore-999999.0a1.0.tm | 1956 +++++++++++++---- .../args/moduledoc/tkcore-999999.0a1.0.tm | 4 +- src/modules/punk/imap4-999999.0a1.0.tm | 88 +- src/modules/punk/lib-999999.0a1.0.tm | 111 +- src/modules/punk/lib-buildversion.txt | 2 +- src/modules/punk/netbox-999999.0a1.0.tm | 155 +- src/modules/punk/netbox/man-999999.0a1.0.tm | 8 +- src/modules/punk/ns-999999.0a1.0.tm | 232 +- src/modules/punk/path-999999.0a1.0.tm | 2 +- .../args-0.1.5_testsuites/args/args.test | 17 + .../lib-0.1.3_testsuites/lib/compat.test | 30 + .../lib/index_functions.test | 79 + .../compat.test#..+lib+compat.test.fauxlink | 0 ....test#..+lib+index_functions.test.fauxlink | 0 .../lib-999999.0a1.0.tm | 211 ++ src/modules/test/punk/lib-buildversion.txt | 3 + src/modules/textblock-999999.0a1.0.tm | 122 +- 22 files changed, 2577 insertions(+), 885 deletions(-) create mode 100644 src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/compat.test create mode 100644 src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/index_functions.test create mode 100644 src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/tests/compat.test#..+lib+compat.test.fauxlink create mode 100644 src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/tests/index.test#..+lib+index_functions.test.fauxlink create mode 100644 src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-999999.0a1.0.tm create mode 100644 src/modules/test/punk/lib-buildversion.txt diff --git a/src/modules/argparsingtest-999999.0a1.0.tm b/src/modules/argparsingtest-999999.0a1.0.tm index 31f69dc9..41960c16 100644 --- a/src/modules/argparsingtest-999999.0a1.0.tm +++ b/src/modules/argparsingtest-999999.0a1.0.tm @@ -297,7 +297,7 @@ namespace eval argparsingtest { } punk::args::define { - @id -id ::test1_punkargs_by_id + @id -id ::argparsingtest::test1_punkargs_by_id @cmd -name argtest4 -help "test of punk::args::parse comparative performance" @opts -anyopts 0 -return -default string -type string @@ -314,7 +314,7 @@ namespace eval argparsingtest { @values } proc test1_punkargs_by_id {args} { - set argd [punk::args::get_by_id ::test1_punkargs_by_id $args] + set argd [punk::args::get_by_id ::argparsingtest::test1_punkargs_by_id $args] return [tcl::dict::get $argd opts] } diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 90b3d334..e05e1d42 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -577,18 +577,18 @@ namespace eval punk { @leaders -min 0 -max 0 @opts -returnlines -type string -typesynopsis matched|all -default breaksandmatches -choicecolumns 1 -choices {matched all breaksandmatches} -choicelabels { - "matched"\ - " Return only lines that matched." - "breaksandmatches"\ - " Return configured --break= lines in between non-consecutive matches" - "all"\ - " Return all lines. - This has a similar effect to the 'grep' trick of matching on 'pattern|$' - (The $ matches all lines that have an end; ie all lines, but there is no - associated character to which to apply highlighting) - except that when instead using -returnlines all with --line-number, the * - indicator after the linenumber will only be highlighted for lines with matches, - and the following matchcount will indicate zero for non-matching lines." + "matched"\ + " Return only lines that matched." + "breaksandmatches"\ + " Return configured --break= lines in between non-consecutive matches" + "all"\ + " Return all lines. + This has a similar effect to the 'grep' trick of matching on 'pattern|$' + (The $ matches all lines that have an end; ie all lines, but there is no + associated character to which to apply highlighting) + except that when instead using -returnlines all with --line-number, the * + indicator after the linenumber will only be highlighted for lines with matches, + and the following matchcount will indicate zero for non-matching lines." } -B|--before-context= -parsekey "--before-context" -default 0 -type integer -typesynopsis num -C|--context= -parsekey "--context" -default 0 -type integer -typesynopsis num -help\ @@ -609,9 +609,9 @@ namespace eval punk { " -ansistrip -type none -help\ "Strip all ansi codes from the input string before processing. - This is not necessary for regex matching purposes, as the matching is always - performed on the ansistripped characters anyway, but by stripping ANSI, the - result only has the ANSI supplied by the -highlight option." + This is not necessary for regex matching purposes, as the matching is always + performed on the ansistripped characters anyway, but by stripping ANSI, the + result only has the ANSI supplied by the -highlight option." #-n|--line-number as per grep utility, except that we include a * for matches -n|--line-number -type none -help\ @@ -7153,8 +7153,8 @@ namespace eval punk { -exclude_punctlines -default 1 -type boolean -show_largest -default 0 -type integer -help\ "Report the top largest linecount files. - The value represents the number of files - to report on." + The value represents the number of files + to report on." } " #we could map away whitespace and use string is punct - but not as flexible? review -punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] } @@ -7384,7 +7384,7 @@ namespace eval punk { #dict of list-len 2 is equiv to dict of dict with one keyval pair #-------------------------------- - + #!!!todo fix - linedict is unfinished and non-functioning #linedict based on indents @@ -7615,23 +7615,23 @@ namespace eval punk { -showcount -type boolean -default 1 -help\ "Display a leading indicator in brackets showing the number of arg values present." -ansi -type integer -default 1 -nocase 1 -choices {0 1 2 VIEW 3 VIEWCODES 4 VIEWSTYLES} -choicelabels { - 0 "Strip ANSI codes from display + 0 " Strip ANSI codes from display of values. The disply output will still be colourised if -ansibase has not been set to empty string or [a+ normal]. The stderr or stdout channels may also have an ansi colour. (see 'colour off' or punk::config)" - 1 "Leave value as is" - 2 "Display the ANSI codes and + 1 " Leave value as is" + 2 " Display the ANSI codes and other control characters inline with replacement indicators. e.g esc, newline, space, tab" - VIEW "Alias for 2" - 3 "Display as per 2 but with + VIEW " Alias for 2" + 3 " Display as per 2 but with colourised ANSI replacement codes." - VIEWCODES "Alias for 3" - 4 "Display ANSI and control + VIEWCODES " Alias for 3" + 4 " Display ANSI and control chars in default colour, but apply the contained ansi to the text portions so they display diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 3ce6d7d0..99deefb5 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -3287,31 +3287,32 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #indent of 1 space is important for clarity in i -return string a+ output dict set SGR_samples $k " [punk::ansi::a+ $k]sample\x1b\[m" } + set SGR_help\ {SGR code from the list below, or an integer corresponding to the code e.g 31 = red. - A leading capital letter indicates a codename applies to the background colour. - Other accepted codes are: - term- Term- foreground/background where int is 0-255 terminal color - term- Term- foreground/background + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background - web- Web- + web- Web- - x11- X11- + x11- X11- - tk- Tk- + tk- Tk- - rgb--- Rgb--- foreground/background where are the - 0-255 int values for red, green and blue. - rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 - The acceptable values for colours can be queried using - punk::ansi::a? term - punk::ansi::a? web - punk::ansi::a? x11 - punk::ansi::a? tk + The acceptable values for colours can be queried using + punk::ansi::a? term + punk::ansi::a? web + punk::ansi::a? x11 + punk::ansi::a? tk - Example to set foreground red and background cyan followed by a reset: - set str \"[a+ red Cyan]sample text[a]\" + Example to set foreground red and background cyan followed by a reset: + set str \"[a+ red Cyan]sample text[a]\" } lappend PUNKARGS [list { @id -id ::punk::ansi::a+ @@ -3325,6 +3326,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu -choicelabels {%choicelabels%}\ -choicecolumns 5 -choiceprefix 0 -choicerestricted 0 -help\ "%SGR_help%" + #note SGR_help string has same level of indent as placeholder }]] lappend PUNKARGS [list { @@ -8140,7 +8142,7 @@ tcl::namespace::eval punk::ansi::ansistring { #return empty string for each index that is out of range #review - this is possibly too slow to be very useful as is. # consider converting to oo and maintaining state of ansisplits so we don't repeat relatively expensive operations for same string - #see also punk::lindex_resolve / punk::lindex_get for ways to handle tcl list/string indices without parsing them. + #see also punk::lib::lindex_resolve / punk::lindex_get for ways to handle tcl list/string indices without parsing them. proc INDEXABSOLUTE {string args} { set payload_len -1 ;# -1 as token to indicate we haven't calculated it yet (only want to call it once at most) set testindices [list] @@ -8169,6 +8171,8 @@ tcl::namespace::eval punk::ansi::ansistring { } else { set offset 0 } + #2025 -BROKEN - doesn't handle indices with both + and - + #see updated punk::lib::lindex_resolve #by now, if op = + then offset = 0 so we only need to handle the minus case if {$payload_len == -1} { set payload_len [punk::ansi::ansistring::length $string] ;#a little bit wasteful - but hopefully no big deal diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 40d703cd..2a79e5af 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -274,7 +274,13 @@ tcl::namespace::eval ::punk::args {} # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args { - + package require punk::assertion + #if 'package forget' was called on this package (e.g when loading test::punk::args) then assert may already exist in the namespace + #procs can be overridden silently, but not imports + catch { + namespace import ::punk::assertion::assert + } + punk::assertion::active 1 variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::define at the end. @@ -607,6 +613,13 @@ tcl::namespace::eval punk::args { If allows more than one choice the value is a list consisting of items in the choices made available through entries in -choices/-choicegroups. + -unindentedfields {} + for fields with multi-line values, tell the resolver to treat + them as unindented. ie do no indent/unindent processing of + whitespace in the values. In a definition script, these fields + should have their value strings placed with reference to the + left margin in the source code. ie all whitespace in the source + is preserved. -minsize (type dependant) -maxsize (type dependant) -range (type dependant - only valid if -type is a single item) @@ -651,11 +664,14 @@ tcl::namespace::eval punk::args { %G%#The following option defines a flag style option (solo)%R% -flag1 -default 0 -type none -help\ "Info about flag1 - subsequent help lines auto-dedented by whitespace to left - of corresponding record start (in this case -flag1) - + first 4 spaces if they are all present. + subsequent help lines assume indent of 4 spaces with + reference to the record start (in this case -flag1). This line has no extra indent relative to first line 'Info about flag1' This line indented a further 6 chars" + %G%#To disable source indent processing, add for example + %G%# -unindentedfields {-help} to the argument line + %G%#This will require aligning the -help text with reference to the left + %G%#margin in the source of the definition. @values -min 1 -max -1 %G%#Items that don't begin with * or - are value definitions%R% @@ -677,6 +693,7 @@ tcl::namespace::eval punk::args { -choiceprefix 1\ -choicerestricted 1\ -choicemultiple {1 1}\ + -unindentedfields {}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -692,6 +709,7 @@ tcl::namespace::eval punk::args { -choiceprefix 1\ -choicerestricted 1\ -choicemultiple {1 1}\ + -unindentedfields {}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -711,6 +729,7 @@ tcl::namespace::eval punk::args { -choiceprefix 1\ -choicerestricted 1\ -choicemultiple {1 1}\ + -unindentedfields {}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -943,18 +962,40 @@ tcl::namespace::eval punk::args { foreach a $textargs { lappend normargs [tcl::string::map {\r\n \n} $a] } - set optionspecs [join $normargs \n] - if {[string first \$\{ $optionspecs] > 0} { - if {$defspace ne ""} { - #normal/desired case - #set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]] - set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -paramindents none -allowcommands $optionspecs]] - } else { - #todo - deprecate/stop from happening? - puts stderr "punk::args::resolve calling tstr for id:$id with no known definition space (-defspace empty)" - set optionspecs [uplevel $LVL [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]] - } - } + + set optionspecs [list] + foreach block $normargs { + if {[string first \$\{ $block] > 0} { + if {$defspace ne ""} { + set block [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -undent 1 $block]] + } else { + puts stderr "punk::args::resolve calling tstr for id:$id with no known definition space (-defspace empty)" + set block [uplevel $LVL [list punk::args::lib::tstr -return string -eval 1 -allowcommands $block]] + } + } + lappend optionspecs $block + } + set optionspecs [join $optionspecs \n] + + #set optionspecs [join $normargs \n] + #if {[string first \$\{ $optionspecs] > 0} { + # if {$defspace ne ""} { + # #normal/desired case + # #JJJ + # #set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]] + # #set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -paramindents none -allowcommands $optionspecs]] + # set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -undent 1 $optionspecs]] + # #set optionspecs [list] + # #foreach spec $optionspecs { + # # set spec [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -undent 1 $spec]] + # # lappend optionspecs $spec + # #} + # } else { + # #todo - deprecate/stop from happening? + # puts stderr "punk::args::resolve calling tstr for id:$id with no known definition space (-defspace empty)" + # set optionspecs [uplevel $LVL [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]] + # } + #} } else { if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { @@ -979,9 +1020,9 @@ tcl::namespace::eval punk::args { # -arg -choices {${$DYN_CHOICES}} -help "${$RED}important info${$RST}" #} if {$defspace ne ""} { - #set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]] + set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]] #JJJ - review - set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -paramindents none $optionspecs]] + #set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -paramindents none $optionspecs]] } #REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?) if {[string first \$\{ $optionspecs] > 0} { @@ -1023,21 +1064,25 @@ tcl::namespace::eval punk::args { set linebuild "" set linelist [split $optionspecs \n] - set lastindent "" + 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 lastindent + regexp {(\s*).*} $ln _all record_base_indent break ;#break at first non-empty } - #puts "indent1:[ansistring VIEW $lastindent]" - set in_record 0 + #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 { - set recordsofar [tcl::string::cat $linebuild $rawline] + #puts stderr "$record_line $rawline" + 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 @@ -1045,53 +1090,95 @@ tcl::namespace::eval punk::args { # - 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_complete [punk::ansi::ansistrip $recordsofar] + 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_complete [string map [list \x1b\[ ""] $recordsofar] + set test_record [string map [list \x1b\[ ""] $record_so_far] } - if {![tcl::info::complete $test_complete]} { + if {![tcl::info::complete $test_record]} { #append linebuild [string trimleft $rawline] \n - if {$in_record} { - #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + 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 "$lastindent " $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] - append linebuild $trimmedline \n - } elseif {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] 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 + #} 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 { - set in_record 1 - regexp {(\s*).*} $rawline _all lastindent - #puts "indent: [ansistring VIEW -lf 1 $lastindent]" + 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 { - set in_record 0 - #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left - if {[tcl::string::first "$lastindent " $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] - append linebuild $trimmedline - } elseif {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline + #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 } } + #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 package_info {} set id_info {} ;#e.g -children ?? @@ -1344,6 +1431,8 @@ tcl::namespace::eval punk::args { #e.g -name # -summary # -help + # + # -cmdtype set cmd_info [dict merge $cmd_info $at_specs] } doc { @@ -1382,6 +1471,7 @@ tcl::namespace::eval punk::args { #if no -max explicitly specified, and llength OPT_NAMES == 0 and OPT_ANY == 0 - -max will be set to 0 below. dict set F $fid OPT_MAX $v } + -unindentedfields - -minsize - -maxsize - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choiceprefixreservelist - -choicerestricted { @@ -1485,6 +1575,7 @@ tcl::namespace::eval punk::args { -any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -type -range -typeranges -default -defaultdisplaytype -typedefaults -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\ + -unindentedfields\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1584,6 +1675,7 @@ tcl::namespace::eval punk::args { -typeranges { tcl::dict::set tmp_leaderspec_defaults -range $v } + -unindentedfields - -minsize - -maxsize - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefixdenylist - -choiceprefixreservelist - -nocase { #review - only apply to certain types? @@ -1622,6 +1714,7 @@ tcl::namespace::eval punk::args { -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -nocase -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ + -unindentedfields\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ -unnamed\ @@ -1662,6 +1755,7 @@ tcl::namespace::eval punk::args { #set val_max $v dict set F $fid VAL_MAX $v } + -unindentedfields - -minsize - -maxsize - -choices - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choiceprefixreservelist - -choicerestricted - -nocase { #review - only apply to certain types? @@ -1741,6 +1835,7 @@ tcl::namespace::eval punk::args { -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -nocase\ + -unindentedfields\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1878,13 +1973,16 @@ tcl::namespace::eval punk::args { #set all_choices [_resolve_get_record_choices] foreach fid $record_form_ids { - if {[dict get $F $fid argspace] eq "leaders"} { - dict set F $fid argspace "options" - } elseif {[dict get $F $fid argspace] eq "values"} { - error "punk::args::resolve - invalid placement of line '$rec' - must come before @values (command form:'$fid') @id:$DEF_definition_id" + switch -exact -- [dict get $F $fid argspace] { + leaders { + dict set F $fid argspace "options" + } + values { + error "punk::args::resolve - invalid placement of line '$rec' - must come before @values (command form:'$fid') @id:$DEF_definition_id" + } } set record_type option - + dict set F $fid OPT_NAMES [list {*}[dict get $F $fid OPT_NAMES] $argname] } @@ -2062,6 +2160,7 @@ tcl::namespace::eval punk::args { -parsekey - -group { tcl::dict::set spec_merged -typesynopsis $specval } + -unindentedfields - -solo - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choiceprefixreservelist - -choicerestricted - -choicelabels - -choiceinfo - @@ -2169,6 +2268,7 @@ tcl::namespace::eval punk::args { -default -defaultdisplaytype -typedefaults\ -minsize -maxsize -choices -choicegroups\ -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ + -unindentedfields\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ -ensembleparameter\ @@ -2399,7 +2499,7 @@ tcl::namespace::eval punk::args { -override dictionary The members of each override sub dictionary are usually options beginning with a dash. The key 'name' can be used to override the name of the leader/option/value itself. - e.g + e.g punk::args::resolved_def -types values -override {version {name version1 -optional 0}} (shared)::package version " @leaders -min 0 -max 0 @@ -2462,16 +2562,21 @@ tcl::namespace::eval punk::args { #a definition id must not begin with "-" ??? review for {set i 0} {$i < [llength $args]} {incr i} { set a [lindex $args $i] - if {$a in {-type -types}} { - incr i - dict set opts -types [lindex $args $i] - } elseif {[string match -* $a]} { - incr i - dict set opts $a [lindex $args $i] - } else { - set id [lindex $args $i] - set patterns [lrange $args $i+1 end] - break + switch -exact -- $a { + -type - -types { + incr i + dict set opts -types [lindex $args $i] + } + default { + if {[string match -* $a]} { + incr i + dict set opts $a [lindex $args $i] + } else { + set id [lindex $args $i] + set patterns [lrange $args $i+1 end] + break + } + } } if {$i == [llength $args]-1} { punk::args::parse $args withid ::punk::args::resolved_def @@ -3349,6 +3454,7 @@ tcl::namespace::eval punk::args { #limit colours to standard 16 so that themes can apply to help output variable arg_error_isrunning if {$arg_error_isrunning} { + set arg_error_isrunning 0 error "arg_error already running - error in arg_error?\n triggering errmsg: $msg" } @@ -3518,6 +3624,11 @@ tcl::namespace::eval punk::args { set cmdname [Dict_getdef $spec_dict cmd_info -name ""] set cmdsummary [Dict_getdef $spec_dict cmd_info -summary ""] set cmdhelp [Dict_getdef $spec_dict cmd_info -help ""] + #=========== + #unindentedfields ? + set maxundent 4 + set cmdhelp [punk::lib::undent " $cmdhelp" $maxundent] + #=========== set docname [Dict_getdef $spec_dict doc_info -name "Manual:"] set docurl [Dict_getdef $spec_dict doc_info -url ""] @@ -3865,6 +3976,13 @@ tcl::namespace::eval punk::args { set help "" if {[dict exists $form_dict OPT_GROUPS $thisgroup -help]} { set help [dict get $form_dict OPT_GROUPS $thisgroup -help] + #field in @directiveline was -grouphelp + #review - where to specify -unindentedfields for a group? do we really need it? + #if {"-grouphelp" ni $unindentedfields} { + set maxundent 4 + set help " $help" + set help [punk::lib::undent $help $maxundent] + #} } if {$thisgroup_parsekey eq ""} { set groupinfo "(documentation group)" @@ -3935,6 +4053,7 @@ tcl::namespace::eval punk::args { } else { set default "" } + set unindentedfields [Dict_getdef $arginfo -unindentedfields {}] set help [Dict_getdef $arginfo -help ""] set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] @@ -3979,18 +4098,26 @@ tcl::namespace::eval punk::args { } else { set prefixmsg "" } - set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] - set choiceinfodict [Dict_getdef $arginfo -choiceinfo {}] - set formattedchoices [dict create] ;#use dict rather than array to preserve order - append help "Choices$prefixmsg$casemsg" + set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] + set choiceinfodict [Dict_getdef $arginfo -choiceinfo {}] + set formattedchoices [dict create] ;#use dict rather than array to preserve order + if {$help eq ""} { + #first line of help - no included base of 4 indent is the normal state of first help lines in definitions scripts + #align fully left to distinguish from previous argument help text + append help "Choices$prefixmsg$casemsg" + } else { + #we are on a subsequent line of -help. Indent the usual base of 4 + desired offset + #offset of 2 to align with choices table + append help " Choices$prefixmsg$casemsg" + } if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { if {$choicemultiple_max == -1} { - append help \n " The value can be a list of $choicemultiple_min or more of these choices" + append help \n " The value can be a list of $choicemultiple_min or more of these choices" } else { if {$choicemultiple_min eq $choicemultiple_max} { - append help \n " The value must be a list of $choicemultiple_min of these choices" + append help \n " The value must be a list of $choicemultiple_min of these choices" } else { - append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" + append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" } } } @@ -4006,7 +4133,16 @@ tcl::namespace::eval punk::args { set cdisplay $c } if {[dict exists $choicelabeldict $c]} { - append cdisplay \n [dict get $choicelabeldict $c] + #append cdisplay \n [dict get $choicelabeldict $c] + + if {"-choicelabels" ni $unindentedfields} { + set maxundent 4 + set ctext " [dict get $choicelabeldict $c]" + set ctext [punk::lib::undent $ctext $maxundent] + } else { + set ctext [dict get $choicelabeldict $c] + } + append cdisplay \n $ctext } if {[dict exists $parsedvalues $arg] && [dict get $parsedvalues $arg] eq $c} { dict lappend formattedchoices $groupname [punk::ansi::ansiwrap reverse $cdisplay] @@ -4082,7 +4218,16 @@ tcl::namespace::eval punk::args { } set cdisplay "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]$mk" if {[dict exists $choicelabeldict $c]} { - append cdisplay \n [dict get $choicelabeldict $c] + #append cdisplay \n [dict get $choicelabeldict $c] + #undent + if {"-choicelabels" ni $unindentedfields} { + set maxundent 4 + set ctext " [dict get $choicelabeldict $c]" + set ctext [punk::lib::undent $ctext $maxundent] + } else { + set ctext [dict get $choicelabeldict $c] + } + append cdisplay \n $ctext } #puts "-- parsed:$parsedvalues arg:$arg c:$c" if {[dict exists $parsedvalues $arg] && [dict get $parsedvalues $arg] eq $c} { @@ -4180,9 +4325,9 @@ tcl::namespace::eval punk::args { } } else { if {$groupname eq ""} { - append help \n " " $CLR(errormsg)(no choices defined)$RST + append help \n " " $CLR(errormsg)(no choices defined)$RST } else { - append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST + append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST } } } @@ -4202,7 +4347,7 @@ tcl::namespace::eval punk::args { $obj configure_column $i -blockalign left incr i } - append help \n[textblock::join -- " " [$obj print]] + append help \n[textblock::join -- " " [$obj print]] ;#4 for standard source-layout indent + 2 #------------- #todo - tests #see special case double reset at end of content in textblock class table get_column_by_index @@ -4227,9 +4372,9 @@ tcl::namespace::eval punk::args { if {![dict get $arginfo -choicerestricted]} { #when -choicemultiple - the -type refers to each selection if {[dict get $arginfo -type] eq "string"} { - append help "\n (values not in defined choices are allowed)" + append help "\n (values not in defined choices are allowed)" } else { - append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" } } } @@ -4266,6 +4411,14 @@ tcl::namespace::eval punk::args { } } + # ============================================= + #REVIEW + if {"-help" ni $unindentedfields} { + # see punk::args::resolve + set maxundent 4 + set help [punk::lib::undent " $help" $maxundent] + } + # ============================================= if {$use_table} { if {$hint ne ""} { set col1 $argshow\n$hint @@ -4934,7 +5087,7 @@ tcl::namespace::eval punk::args { set clause_member_optional 0 } set tp [string trim $tp ?] - switch -glob $tp { + switch -glob -- $tp { literal* { set litinfo [string range $tp 7 end] set match [string range $litinfo 1 end-1] @@ -5226,7 +5379,7 @@ tcl::namespace::eval punk::args { #more complex type_expressions would require a bracketing syntax - (and probably pre-parsing) #or perhaps more performant, RPN to avoid bracket parsing #if literal(..), literalprefix(..), stringstartswith(..) etc can have pipe symbols and brackets etc - we can't just use split - #if we require -type to always be treated as a list - and if an element is length 1 - require it to + #if we require -type to always be treated as a list - and if an element is length 1 - require it to #have properly balanced brackets that don't contain | ( ) etc we can simplify - REVIEW #consider: @@ -6239,7 +6392,7 @@ tcl::namespace::eval punk::args { #no pass for this clause - fetch first? error and raise #todo - return error containing clause_indices so we can report more than one failing element at once? foreach e $clauseresult { - switch -exact [lindex $e 0] { + switch -exact -- [lindex $e 0] { errorcode { #errorcode msg ${$NI} -optional 0 } "@doc -name Manpage: -url [manpage_tcl dict]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::tcl::dict::values + @cmd -name "Built-in: tcl::dict::values"\ + -summary\ + "list all values or values matching globPattern"\ + -help\ + "Return a list of all values in the given dictionary value. If a pattern is supplied, only those + values that match it (according to the rules of string match) will be returned. The returned + values will be in the order of that the keys associated with those values were inserted into the + dictionary." + @values -min 1 -max 2 + dictionaryValue -type dict + globPattern -type string -optional 1 + } "@doc -name Manpage: -url [manpage_tcl dict]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::tcl::dict::with @@ -1906,13 +2265,140 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { key -type any -typesynopsis {${$I}key${$NI}} -optional 1 -multiple 1 body -type script -typesynopsis ${$I}body