diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index a7fe1047..9c7c728c 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -3461,8 +3461,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set codestack [list] if {[punk::ansi::ta::detect $text]} { set emit "" - set parts [punk::ansi::ta::split_codes $text] - foreach {pt code} $parts { + #set parts [punk::ansi::ta::split_codes $text] + set parts [punk::ansi::ta::split_codes_single $text] + foreach {pt codegroup} $parts { switch -- [llength $codestack] { 0 { append emit $base $pt $R @@ -3488,44 +3489,46 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } } - #parts ends on a pt - last code always empty string - if {$code ne ""} { - set c1c2 [tcl::string::range $code 0 1] - set leadernorm [tcl::string::range [tcl::string::map [list\ - \x1b\[ 7CSI\ - \x9b 8CSI\ - \x1b\( 7GFX\ - ] $c1c2] 0 3] - switch -- $leadernorm { - 7CSI - 8CSI { - if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set codestack [list $code] - } elseif {[punk::ansi::codetype::is_sgr $code]} { - #todo - make caching is_sgr method - set dup_posns [lsearch -all -exact $codestack $code] - set codestack [lremove $codestack {*}$dup_posns] - lappend codestack $code - } else { + #parts ends on a pt - last codegroup always empty string + if {$codegroup ne ""} { + foreach code [punk::ansi::ta::get_codes_single $codegroup] { + set c1c2 [tcl::string::range $code 0 1] + set leadernorm [tcl::string::range [tcl::string::map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] + switch -- $leadernorm { + 7CSI - 8CSI { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set codestack [list $code] + } elseif {[punk::ansi::codetype::is_sgr $code]} { + #todo - make caching is_sgr method + set dup_posns [lsearch -all -exact $codestack $code] + set codestack [lremove $codestack {*}$dup_posns] + lappend codestack $code + } else { - } - } - 7GFX { - switch -- [tcl::string::index $code 2] { - "0" { - set o_gx_state on } - "B" { - set o_gx_state off + } + 7GFX { + switch -- [tcl::string::index $code 2] { + "0" { + set o_gx_state on + } + "B" { + set o_gx_state off + } } } + default { + #other ansi codes + } } - default { - #other ansi codes - } + append emit $code } - append emit $code } } return [append emit $R] @@ -4847,6 +4850,15 @@ tcl::namespace::eval punk::ansi { #switch -- [tcl::string::index $cnorm 1][string index $cnorm end] {} # {[m} + #todo - detect multiple \x9b or \x1b and raise error - codes not split? + #if we don't - we can silently get 8CSI 7CSI in output! + if {[string last \x1b\[ $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is a 7CSI not at start)" + } + if {[string last \x9b $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is an 8CSI not at start)" + } + set cnorm [tcl::string::map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] switch -- [tcl::string::range $cnorm 0 3][tcl::string::index $cnorm end] { 7CSIm - 8CSIm { diff --git a/src/bootsupport/modules/punk/args-0.1.8.tm b/src/bootsupport/modules/punk/args-0.1.8.tm index 0147636c..9a90e2e4 100644 --- a/src/bootsupport/modules/punk/args-0.1.8.tm +++ b/src/bootsupport/modules/punk/args-0.1.8.tm @@ -326,7 +326,7 @@ tcl::namespace::eval punk::args { #We mightn't want the prefix to be longer just because of an alias #we should get -co -ce and -m from the above as abbreviations - set map [list %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] + set map [list %G% \x1b\[32m %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] lappend PUNKARGS [list [string map $map { @id -id ::punk::args::define @@ -540,40 +540,41 @@ tcl::namespace::eval punk::args { " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. + {Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \n. Using multiple text arguments may be useful to mix curly-braced and double-quoted strings to have finer control over interpolation when defining arguments. (this can also be handy for sections that pull resolved definition lines from existing definitions (by id) for re-use of argument specifications and help text) e.g the following definition passes 2 blocks as text arguments - definition { + ${[punk::args::tclcore::argdoc::example { + punk::args::define { @id -id ::myns::myfunc - @cmd -name myns::myfunc -help\\ - \"Description of command\" + @cmd -name myns::myfunc -help\ + "Description of command" - #The following option defines an option-value pair - #It may have aliases by separating them with a pipe | - -fg|-foreground -default blah -type string -help\\ - \"In the result dict returned by punk::args::parse + %G%#The following option defines an option-value pair%R% + %G%#It may have aliases by separating them with a pipe |%R% + -fg|-foreground -default blah -type string -help\ + "In the result dict returned by punk::args::parse the value used in the opts key will always be the last - entry, in this case -foreground\" - #The following option defines a flag style option (solo) - -flag1 -default 0 -type none -help\\ - \"Info about flag1 + entry, in this case -foreground" + %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. This line has no extra indent relative to first line 'Info about flag1' - This line indented a further 6 chars\" + This line indented a further 6 chars" @values -min 1 -max -1 - #Items that don't begin with * or - are value definitions + %G%#Items that don't begin with * or - are value definitions%R% v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" - " + } "@doc -name Manpage: -url [myfunc_manpage_geturl myns::myfunc]"}]} + } }]] proc New_command_form {name} { @@ -817,7 +818,8 @@ tcl::namespace::eval punk::args { 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 -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)" @@ -4205,7 +4207,7 @@ tcl::namespace::eval punk::args { } #check if enough remaining_rawargs to fill any required values - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } @@ -4229,7 +4231,7 @@ tcl::namespace::eval punk::args { break } - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } } @@ -4258,7 +4260,7 @@ tcl::namespace::eval punk::args { break } else { if {$valmin > 0} { - if {[llength $remaining_rawargs] -1 >= $valmin} { + if {[llength $remaining_rawargs] > $valmin} { lappend pre_values [lpop remaining_rawargs 0] dict incr leader_posn_names_assigned $leader_posn_name } else { @@ -5211,7 +5213,7 @@ tcl::namespace::eval punk::args { } else { set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" } - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5226,7 +5228,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5234,7 +5236,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -6160,7 +6162,10 @@ tcl::namespace::eval punk::args::lib { } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params [subst -nocommands -novariables $expression] + #JJJ + #REVIEW + #lappend params [subst -nocommands -novariables $expression] + lappend params $expression } append lastline [lindex $params end] ;#for current expression's position calc diff --git a/src/bootsupport/modules/textblock-0.1.3.tm b/src/bootsupport/modules/textblock-0.1.3.tm index ebd18fc1..2442e257 100644 --- a/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/bootsupport/modules/textblock-0.1.3.tm @@ -2330,7 +2330,8 @@ tcl::namespace::eval textblock { } } - set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + #set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + set spacemap [list hl "\UFFFE" vl "\UFFFE" tlc "\UFFFE" blc "\UFFFE" trc "\UFFFE" brc "\UFFFE"] ;#transparent overlay elements #set spacemap [list hl * vl * tlc * blc * trc * brc *] #-usecache 1 ok #hval is not raw headerval - it has been padded to required width and has ansi applied @@ -2349,7 +2350,9 @@ tcl::namespace::eval textblock { #this seems like a likely requirement. The first spanned column may well have different alignment requirements than the span. #(e.g if first spanned col happens to be numeric it probably warrants right textalign (if not blockalign) but we don't necessarily want the spanning header or even a non-spanning header to be right aligned) - set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + #header transparent space bug #JJJJ + #set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent \UFFFE $spanned_frame $hblock] #POTENTIAL BUG (fixed with spans_to_rhs above) #when -blockalign right and colspan extends to rhs - last char of longest of that spanlength will overlap right edge (if show_edge 1) #we need to shift 1 to the left when doing our overtype with blockalign right diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 8a4725c2..8b161608 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -3461,8 +3461,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set codestack [list] if {[punk::ansi::ta::detect $text]} { set emit "" - set parts [punk::ansi::ta::split_codes $text] - foreach {pt code} $parts { + #set parts [punk::ansi::ta::split_codes $text] + set parts [punk::ansi::ta::split_codes_single $text] + foreach {pt codegroup} $parts { switch -- [llength $codestack] { 0 { append emit $base $pt $R @@ -3488,44 +3489,46 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } } - #parts ends on a pt - last code always empty string - if {$code ne ""} { - set c1c2 [tcl::string::range $code 0 1] - set leadernorm [tcl::string::range [tcl::string::map [list\ - \x1b\[ 7CSI\ - \x9b 8CSI\ - \x1b\( 7GFX\ - ] $c1c2] 0 3] - switch -- $leadernorm { - 7CSI - 8CSI { - if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set codestack [list $code] - } elseif {[punk::ansi::codetype::is_sgr $code]} { - #todo - make caching is_sgr method - set dup_posns [lsearch -all -exact $codestack $code] - set codestack [lremove $codestack {*}$dup_posns] - lappend codestack $code - } else { + #parts ends on a pt - last codegroup always empty string + if {$codegroup ne ""} { + foreach code [punk::ansi::ta::get_codes_single $codegroup] { + set c1c2 [tcl::string::range $code 0 1] + set leadernorm [tcl::string::range [tcl::string::map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] + switch -- $leadernorm { + 7CSI - 8CSI { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set codestack [list $code] + } elseif {[punk::ansi::codetype::is_sgr $code]} { + #todo - make caching is_sgr method + set dup_posns [lsearch -all -exact $codestack $code] + set codestack [lremove $codestack {*}$dup_posns] + lappend codestack $code + } else { - } - } - 7GFX { - switch -- [tcl::string::index $code 2] { - "0" { - set o_gx_state on } - "B" { - set o_gx_state off + } + 7GFX { + switch -- [tcl::string::index $code 2] { + "0" { + set o_gx_state on + } + "B" { + set o_gx_state off + } } } + default { + #other ansi codes + } } - default { - #other ansi codes - } + append emit $code } - append emit $code } } return [append emit $R] @@ -4847,6 +4850,15 @@ tcl::namespace::eval punk::ansi { #switch -- [tcl::string::index $cnorm 1][string index $cnorm end] {} # {[m} + #todo - detect multiple \x9b or \x1b and raise error - codes not split? + #if we don't - we can silently get 8CSI 7CSI in output! + if {[string last \x1b\[ $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is a 7CSI not at start)" + } + if {[string last \x9b $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is an 8CSI not at start)" + } + set cnorm [tcl::string::map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] switch -- [tcl::string::range $cnorm 0 3][tcl::string::index $cnorm end] { 7CSIm - 8CSIm { diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 9e79bf7b..79fd3a41 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -326,7 +326,7 @@ tcl::namespace::eval punk::args { #We mightn't want the prefix to be longer just because of an alias #we should get -co -ce and -m from the above as abbreviations - set map [list %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] + set map [list %G% \x1b\[32m %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] lappend PUNKARGS [list [string map $map { @id -id ::punk::args::define @@ -540,40 +540,41 @@ tcl::namespace::eval punk::args { " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. + {Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \n. Using multiple text arguments may be useful to mix curly-braced and double-quoted strings to have finer control over interpolation when defining arguments. (this can also be handy for sections that pull resolved definition lines from existing definitions (by id) for re-use of argument specifications and help text) e.g the following definition passes 2 blocks as text arguments - definition { + ${[punk::args::tclcore::argdoc::example { + punk::args::define { @id -id ::myns::myfunc - @cmd -name myns::myfunc -help\\ - \"Description of command\" + @cmd -name myns::myfunc -help\ + "Description of command" - #The following option defines an option-value pair - #It may have aliases by separating them with a pipe | - -fg|-foreground -default blah -type string -help\\ - \"In the result dict returned by punk::args::parse + %G%#The following option defines an option-value pair%R% + %G%#It may have aliases by separating them with a pipe |%R% + -fg|-foreground -default blah -type string -help\ + "In the result dict returned by punk::args::parse the value used in the opts key will always be the last - entry, in this case -foreground\" - #The following option defines a flag style option (solo) - -flag1 -default 0 -type none -help\\ - \"Info about flag1 + entry, in this case -foreground" + %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. This line has no extra indent relative to first line 'Info about flag1' - This line indented a further 6 chars\" + This line indented a further 6 chars" @values -min 1 -max -1 - #Items that don't begin with * or - are value definitions + %G%#Items that don't begin with * or - are value definitions%R% v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" - " + } "@doc -name Manpage: -url [myfunc_manpage_geturl myns::myfunc]"}]} + } }]] proc New_command_form {name} { @@ -817,7 +818,8 @@ tcl::namespace::eval punk::args { 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 -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)" @@ -4205,7 +4207,7 @@ tcl::namespace::eval punk::args { } #check if enough remaining_rawargs to fill any required values - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } @@ -4229,7 +4231,7 @@ tcl::namespace::eval punk::args { break } - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } } @@ -4258,7 +4260,7 @@ tcl::namespace::eval punk::args { break } else { if {$valmin > 0} { - if {[llength $remaining_rawargs] -1 >= $valmin} { + if {[llength $remaining_rawargs] > $valmin} { lappend pre_values [lpop remaining_rawargs 0] dict incr leader_posn_names_assigned $leader_posn_name } else { @@ -5211,7 +5213,7 @@ tcl::namespace::eval punk::args { } else { set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" } - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5226,7 +5228,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5234,7 +5236,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -6160,7 +6162,10 @@ tcl::namespace::eval punk::args::lib { } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params [subst -nocommands -novariables $expression] + #JJJ + #REVIEW + #lappend params [subst -nocommands -novariables $expression] + lappend params $expression } append lastline [lindex $params end] ;#for current expression's position calc diff --git a/src/modules/punk/args/tclcore-999999.0a1.0.tm b/src/modules/punk/args/tclcore-999999.0a1.0.tm index 78bd01c0..ce4b6842 100644 --- a/src/modules/punk/args/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/tclcore-999999.0a1.0.tm @@ -341,34 +341,40 @@ tcl::namespace::eval punk::args::tclcore { #review #@values -form {*} #note "classify next argument as a value not a leader" #@values -form {*} - + @leaders -form {delay schedule_ms} -min 1 -max 1 ms -form {*} -type int -help\ "milliseconds" - @values -form {delay} -min 1 -max 1 - @values -form {schedule_ms} -min 2 + + @values -form {delay} -min 0 -max 0 + + @values -form {schedule_ms} -min 1 script -form {schedule_ms} -multiple 1 -optional 0 ref-help common_script_help @form -form {cancelid} -synopsis "after cancel id" - @values -min 2 -max 2 + @leaders -min 1 -max 1 cancel -choices {cancel} + @values -min 1 -max 1 id @form -form {cancelscript} -synopsis "after cancel script ?script...?" - @values -min 2 + @leaders -min 1 cancel -choices {cancel} + @values -min 1 script -multiple 1 -optional 0 ref-help common_script_help @form -form {schedule_idle} -synopsis "after idle script ?script...?" - @values -min 2 + @leaders -min 1 -max 1 idle -choices {idle} + @values -min 1 script -multiple 1 -optional 0 ref-help common_script_help @form -form {info} -synopsis "after info ?id?" - @values -min 0 -max 2 + @leaders -min 1 -max 1 info -choices {info} + @values -min 0 -max 1 id -optional 1 } "@doc -name Manpage: -url [manpage_tcl after]" ] @@ -815,6 +821,64 @@ tcl::namespace::eval punk::args::tclcore { key -type string -multiple 1 -optional 0 } "@doc -name Manpage: -url [manpage_tcl dict]" ] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::tcl::dict::for + @cmd -name "Builtin: tcl::dict::for" -help\ + "This command takes three arguments, the first a two-element list of + variable names (for the key and value respectively of each mapping in + the dictionary), the second the dictionary value to iterate across, and + the third a script to be evaluated for each mapping with the key and + value variable set appropriately (in the manner of ${$B}foreach${$N}). + The result of the command is an empty string. If any evlauation of the + body generates a ${$B}TCL_BREAK${$N} result, no further pairs from the + dictionary will be iterated over and the ${$B}dict for${$N} command will + terminate successfully immediately. If any evaluation of the body generates + a ${$B}TCL_CONTINUE${$N} result, this shall be treated exactly like a + normal ${$B}TCL_OK${$N} result. The order of iteration is the order in which + the keys were inserted into the dictionary." + @values -min 3 -max 3 + "{keyVariable valueVariable}" -type list -minsize 2 -maxsize 2 + dictionaryValue -type dict + body -type string -help\ + "Tcl script" + } "@doc -name Manpage: -url [manpage_tcl dict]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + proc example {str} { + set str [string trimleft $str \n] + set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block -- $str]] + set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"] + #puts $result + return $result + } + lappend PUNKARGS [list { + @id -id ::tcl::dict::get + @cmd -name "Builtin: tcl::dict::get" -help\ + "Given a dictionary value (first argument) and a key (second argument), this + will retrieve the value for that key. Where several keys are supplied, the + behaviour of the command shall be as if the result of ${$B}dict get $dictVal $key${$N} + was passed as the first argument to ${$B}dict get${$N} with the remaining + arguments as second (and possibly subsequent) arguments. This facilitates + lookups in nested dictionaries. For example, the following two commands are + equivalent: + ${[punk::args::tclcore::argdoc::example { + dict get $dict foo bar spong + dict get [dict get [dict get $dict foo] bar] spong\ + } + ]} + If no keys are provided, ${$B}dict get${$N} will return a list containing pairs + of elements in a manner similar to ${$B}array get${$N}. That is, the first + element of each pair would be the key and the second element would be the value + for that key. + It is an error to attempt to retrieve a value for a key that is not present in + the dictionary. + " + @values -min 1 -max -1 + dictionaryValue -type dict + key -type string -multiple 1 -optional 1 + } "@doc -name Manpage: -url [manpage_tcl dict]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::tcl::dict::replace @cmd -name "Builtin: tcl::dict::replace" -help\ @@ -1553,6 +1617,41 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl llength]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::lmap + @cmd -name "Builtin: lmap" -help\ + "The ${$B}lmap${$N} command implements a loop where the loop variable(s) + take on values from one or more lists, and the loop returns a list of results + collected from each iteration. + In the simplest case there is one loop variable, ${$I}varname${$NI} and one ${$I}list${$NI}, + that is a list of values to assign to ${$I}varName${$NI}. The ${$I}body${$NI} + argument is a Tcl script. For each element of ${$I}list${$NI} (in order from first + to last), ${$B}lmap${$N} assigns the contents of the element to ${$I}varName${$NI} + as if the ${$B}lindex${$NI} command had been used to extract the element, then + calls the Tcl interpreter to execute ${$I}body${$NI}. + If execution of the body completes normally then the result of body is appended + to an accumulator list. ${$B}lmap${$N} returns the accumulator list. + + In the general case there can be more than one value list, and each value list + can be associated with a list of loop variables. During each iteration of the + loop the variable of each ${$I}varlist${$NI} are assigned consecutive values from + the corresponding ${$I}list${$NI}. Values in each ${$I}list${$NI} are used in order from + first to last, and each value is used exactly once. The total number of loop + iterations is large enough to use up all the values from all the value lists. + If a value list does not contain enough elements for each of its loop variables + in each iteration, empty values are used for the missing elements. + + The ${$B}break${$N} and ${$B}continue${$N} statements may be invoked inside ${$I}body${$NI}, + with the same effect as in the ${$B}for${$N} and ${$B}foreach${$N} commands. + In these cases the body does not complete normally and the result is not appended + to the accumulator list." + @values + "varlist list" -type {list list} -multiple 1 -optional 0 + body -type string -optional 0 -help\ + "Tcl script" + } "@doc -name Manpage: -url [manpage_tcl lmap]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lpop @cmd -name "builtin: lpop" -help\ @@ -1669,6 +1768,19 @@ tcl::namespace::eval punk::args::tclcore { @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} } "@doc -name Manpage: -url [manpage_tcl lremove]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lreverse + @cmd -name "builtin: lreverse" -help\ + "Reverse the order of a list. + The ${$B}lreverse${$N} command returns a list that has the same elements + as its input list, ${$I}list${$NI}, exept with the elements in reverse + order." + @values -min 1 -max 1 + list -type list -help\ + "tcl list as a value" + } "@doc -name Manpage: -url [manpage_tcl lreverse]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -1737,6 +1849,67 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl lset]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lseq + @cmd -name "builtin: lseq" -help\ + "Build a numeric sequence returned as a list. + The ${$B}lseq${$N} command creates a sequence of numeric values using the given + parameters ${$I}start${$NI}, ${$I}end${$NI} and ${$I}step${$NI}. The ${$I}operation${$NI} + argument \"..\" or \"${$B}to${$N}\" defines the range. The \"${$B}count${$N}\" option is + used to defina a count of the number of elements in the list. A short form use of the + command, with a single ${$I}count${$NI} value, will creat a range from 0 to ${$I}count-1${$NI}. + The ${$B}lseq${$N} command can produce both increasing and decreasing sequences. + When both ${$I}start${$NI} and ${$I}end${$NI} are provided without a ${$I}step${$NI} value, + then if ${$I}start${$NI} <= ${$I}end${$NI}, the sequence will be increasing and if + ${$I}start${$NI} > ${$I}end${$NI} it will be decreasing. If a ${$I}step${$NI} value is + included, it's sign should agree with the direction of the sequence + (descending -> negative and ascending -> positive), otherwise an empty list is returned. + For example: + ${[punk::args::tclcore::argdoc::example { + % lseq 1 to 5 ;#increasing + -> 1 2 3 4 5 + + % lseq 5 to 1 ;#decreasing + -> 5 4 3 2 1 + + % lseq 6 to 1 by 2 ;#decreasing, step wrong sign, empty list + + % lseq 1 5 by 0 ;#all step sizes of 0 produce an empty list + }]} + + The numeric arguments ${$I}start${$NI}, ${$I}end${$NI}, ${$I}step${$NI} and ${$I}count${$NI}, may + also be a valid expression. The expression will be evaluated and the numeric result will + be used. An expression that does not evaluate to a number will produce an invalid argument error. + ${$I}Start${$NI} defines the initial value and ${$I}end${$NI} defines the limit, not necessarily + the last value. ${$B}lseq${$N} produces a list with ${$B}count${$N} elements and if ${$B}count${$N} + is not supplied, it is computed as: + count = int( (end - start + step) / step) + " + @form -form range + @leaders -min 0 -max 0 + @values -min 2 -max 5 + start -type number|expr + ..|to -type string -choices {.. to} -optional 1 + end -type number|expr + "by step" -type {literal number|expr} -optional 1 + + @form -form start_count + @leaders -min 0 -max 0 + @values -min 3 -max 5 + start -type number|expr + count -type literal + countelements -type number|expr + "by step" -type {literal number|expr} -optional 1 + + @form -form count + @leaders -min 0 -max 0 + @values -min 1 -max 3 + countelements -type number|expr + "by step" -type {literal number|expr} -optional 1 + + } "@doc -name Manpage: -url [manpage_tcl lreverse]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } diff --git a/src/modules/punk/imap4-999999.0a1.0.tm b/src/modules/punk/imap4-999999.0a1.0.tm index 411cbff9..5bdb01d6 100644 --- a/src/modules/punk/imap4-999999.0a1.0.tm +++ b/src/modules/punk/imap4-999999.0a1.0.tm @@ -1512,13 +1512,14 @@ tcl::namespace::eval punk::imap4 { Returns the Tcl channel to use in subsequent calls to the API. Other API commands will return zero on success. e.g + ${[punk::args::tclcore::argdoc::example { % set chan [CONNECT mail.example.com] sock123aaa456789 % AUTH_PLAIN $chan user pass 0 ... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ... % LOGOUT $chan - 0" + 0}]}" @leaders -min 0 -max 0 -debug -type boolean -default 0 -help\ "Display some of the cli/server interaction on stdout diff --git a/src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test b/src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test index a816c75c..4e09ea6f 100644 --- a/src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test +++ b/src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test @@ -69,6 +69,20 @@ namespace eval ::testspace { x a y b ] + + test parse_withdef_leader_multiple {Test named leader with -multiple true}\ + -setup $common -body { + #should not error + set argd [punk::args::parse {a b c} withdef {@leaders -min 0} {L -multiple 1} {@values -min 1 -max 1} V] + lappend result [dict get $argd leaders] + lappend result [dict get $argd values] + }\ + -cleanup { + }\ + -result [list\ + {L {a b}} {V c} + ] + test parse_withdef_leader_min_max {Test unnamed leaders with -min and -max}\ -setup $common -body { #should not error - should allocate d to values diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 1a20bee2..60c637e4 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -2330,7 +2330,8 @@ tcl::namespace::eval textblock { } } - set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + #set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + set spacemap [list hl "\UFFFE" vl "\UFFFE" tlc "\UFFFE" blc "\UFFFE" trc "\UFFFE" brc "\UFFFE"] ;#transparent overlay elements #set spacemap [list hl * vl * tlc * blc * trc * brc *] #-usecache 1 ok #hval is not raw headerval - it has been padded to required width and has ansi applied @@ -2349,7 +2350,9 @@ tcl::namespace::eval textblock { #this seems like a likely requirement. The first spanned column may well have different alignment requirements than the span. #(e.g if first spanned col happens to be numeric it probably warrants right textalign (if not blockalign) but we don't necessarily want the spanning header or even a non-spanning header to be right aligned) - set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + #header transparent space bug #JJJJ + #set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent \UFFFE $spanned_frame $hblock] #POTENTIAL BUG (fixed with spans_to_rhs above) #when -blockalign right and colspan extends to rhs - last char of longest of that spanlength will overlap right edge (if show_edge 1) #we need to shift 1 to the left when doing our overtype with blockalign right diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index a7fe1047..9c7c728c 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -3461,8 +3461,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set codestack [list] if {[punk::ansi::ta::detect $text]} { set emit "" - set parts [punk::ansi::ta::split_codes $text] - foreach {pt code} $parts { + #set parts [punk::ansi::ta::split_codes $text] + set parts [punk::ansi::ta::split_codes_single $text] + foreach {pt codegroup} $parts { switch -- [llength $codestack] { 0 { append emit $base $pt $R @@ -3488,44 +3489,46 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } } - #parts ends on a pt - last code always empty string - if {$code ne ""} { - set c1c2 [tcl::string::range $code 0 1] - set leadernorm [tcl::string::range [tcl::string::map [list\ - \x1b\[ 7CSI\ - \x9b 8CSI\ - \x1b\( 7GFX\ - ] $c1c2] 0 3] - switch -- $leadernorm { - 7CSI - 8CSI { - if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set codestack [list $code] - } elseif {[punk::ansi::codetype::is_sgr $code]} { - #todo - make caching is_sgr method - set dup_posns [lsearch -all -exact $codestack $code] - set codestack [lremove $codestack {*}$dup_posns] - lappend codestack $code - } else { + #parts ends on a pt - last codegroup always empty string + if {$codegroup ne ""} { + foreach code [punk::ansi::ta::get_codes_single $codegroup] { + set c1c2 [tcl::string::range $code 0 1] + set leadernorm [tcl::string::range [tcl::string::map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] + switch -- $leadernorm { + 7CSI - 8CSI { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set codestack [list $code] + } elseif {[punk::ansi::codetype::is_sgr $code]} { + #todo - make caching is_sgr method + set dup_posns [lsearch -all -exact $codestack $code] + set codestack [lremove $codestack {*}$dup_posns] + lappend codestack $code + } else { - } - } - 7GFX { - switch -- [tcl::string::index $code 2] { - "0" { - set o_gx_state on } - "B" { - set o_gx_state off + } + 7GFX { + switch -- [tcl::string::index $code 2] { + "0" { + set o_gx_state on + } + "B" { + set o_gx_state off + } } } + default { + #other ansi codes + } } - default { - #other ansi codes - } + append emit $code } - append emit $code } } return [append emit $R] @@ -4847,6 +4850,15 @@ tcl::namespace::eval punk::ansi { #switch -- [tcl::string::index $cnorm 1][string index $cnorm end] {} # {[m} + #todo - detect multiple \x9b or \x1b and raise error - codes not split? + #if we don't - we can silently get 8CSI 7CSI in output! + if {[string last \x1b\[ $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is a 7CSI not at start)" + } + if {[string last \x9b $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is an 8CSI not at start)" + } + set cnorm [tcl::string::map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] switch -- [tcl::string::range $cnorm 0 3][tcl::string::index $cnorm end] { 7CSIm - 8CSIm { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.8.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.8.tm index 0147636c..9a90e2e4 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.8.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.8.tm @@ -326,7 +326,7 @@ tcl::namespace::eval punk::args { #We mightn't want the prefix to be longer just because of an alias #we should get -co -ce and -m from the above as abbreviations - set map [list %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] + set map [list %G% \x1b\[32m %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] lappend PUNKARGS [list [string map $map { @id -id ::punk::args::define @@ -540,40 +540,41 @@ tcl::namespace::eval punk::args { " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. + {Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \n. Using multiple text arguments may be useful to mix curly-braced and double-quoted strings to have finer control over interpolation when defining arguments. (this can also be handy for sections that pull resolved definition lines from existing definitions (by id) for re-use of argument specifications and help text) e.g the following definition passes 2 blocks as text arguments - definition { + ${[punk::args::tclcore::argdoc::example { + punk::args::define { @id -id ::myns::myfunc - @cmd -name myns::myfunc -help\\ - \"Description of command\" + @cmd -name myns::myfunc -help\ + "Description of command" - #The following option defines an option-value pair - #It may have aliases by separating them with a pipe | - -fg|-foreground -default blah -type string -help\\ - \"In the result dict returned by punk::args::parse + %G%#The following option defines an option-value pair%R% + %G%#It may have aliases by separating them with a pipe |%R% + -fg|-foreground -default blah -type string -help\ + "In the result dict returned by punk::args::parse the value used in the opts key will always be the last - entry, in this case -foreground\" - #The following option defines a flag style option (solo) - -flag1 -default 0 -type none -help\\ - \"Info about flag1 + entry, in this case -foreground" + %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. This line has no extra indent relative to first line 'Info about flag1' - This line indented a further 6 chars\" + This line indented a further 6 chars" @values -min 1 -max -1 - #Items that don't begin with * or - are value definitions + %G%#Items that don't begin with * or - are value definitions%R% v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" - " + } "@doc -name Manpage: -url [myfunc_manpage_geturl myns::myfunc]"}]} + } }]] proc New_command_form {name} { @@ -817,7 +818,8 @@ tcl::namespace::eval punk::args { 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 -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)" @@ -4205,7 +4207,7 @@ tcl::namespace::eval punk::args { } #check if enough remaining_rawargs to fill any required values - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } @@ -4229,7 +4231,7 @@ tcl::namespace::eval punk::args { break } - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } } @@ -4258,7 +4260,7 @@ tcl::namespace::eval punk::args { break } else { if {$valmin > 0} { - if {[llength $remaining_rawargs] -1 >= $valmin} { + if {[llength $remaining_rawargs] > $valmin} { lappend pre_values [lpop remaining_rawargs 0] dict incr leader_posn_names_assigned $leader_posn_name } else { @@ -5211,7 +5213,7 @@ tcl::namespace::eval punk::args { } else { set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" } - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5226,7 +5228,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5234,7 +5236,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -6160,7 +6162,10 @@ tcl::namespace::eval punk::args::lib { } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params [subst -nocommands -novariables $expression] + #JJJ + #REVIEW + #lappend params [subst -nocommands -novariables $expression] + lappend params $expression } append lastline [lindex $params end] ;#for current expression's position calc diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm index ebd18fc1..2442e257 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm @@ -2330,7 +2330,8 @@ tcl::namespace::eval textblock { } } - set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + #set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + set spacemap [list hl "\UFFFE" vl "\UFFFE" tlc "\UFFFE" blc "\UFFFE" trc "\UFFFE" brc "\UFFFE"] ;#transparent overlay elements #set spacemap [list hl * vl * tlc * blc * trc * brc *] #-usecache 1 ok #hval is not raw headerval - it has been padded to required width and has ansi applied @@ -2349,7 +2350,9 @@ tcl::namespace::eval textblock { #this seems like a likely requirement. The first spanned column may well have different alignment requirements than the span. #(e.g if first spanned col happens to be numeric it probably warrants right textalign (if not blockalign) but we don't necessarily want the spanning header or even a non-spanning header to be right aligned) - set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + #header transparent space bug #JJJJ + #set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent \UFFFE $spanned_frame $hblock] #POTENTIAL BUG (fixed with spans_to_rhs above) #when -blockalign right and colspan extends to rhs - last char of longest of that spanlength will overlap right edge (if show_edge 1) #we need to shift 1 to the left when doing our overtype with blockalign right diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index a7fe1047..9c7c728c 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -3461,8 +3461,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set codestack [list] if {[punk::ansi::ta::detect $text]} { set emit "" - set parts [punk::ansi::ta::split_codes $text] - foreach {pt code} $parts { + #set parts [punk::ansi::ta::split_codes $text] + set parts [punk::ansi::ta::split_codes_single $text] + foreach {pt codegroup} $parts { switch -- [llength $codestack] { 0 { append emit $base $pt $R @@ -3488,44 +3489,46 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } } - #parts ends on a pt - last code always empty string - if {$code ne ""} { - set c1c2 [tcl::string::range $code 0 1] - set leadernorm [tcl::string::range [tcl::string::map [list\ - \x1b\[ 7CSI\ - \x9b 8CSI\ - \x1b\( 7GFX\ - ] $c1c2] 0 3] - switch -- $leadernorm { - 7CSI - 8CSI { - if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set codestack [list $code] - } elseif {[punk::ansi::codetype::is_sgr $code]} { - #todo - make caching is_sgr method - set dup_posns [lsearch -all -exact $codestack $code] - set codestack [lremove $codestack {*}$dup_posns] - lappend codestack $code - } else { + #parts ends on a pt - last codegroup always empty string + if {$codegroup ne ""} { + foreach code [punk::ansi::ta::get_codes_single $codegroup] { + set c1c2 [tcl::string::range $code 0 1] + set leadernorm [tcl::string::range [tcl::string::map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] + switch -- $leadernorm { + 7CSI - 8CSI { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set codestack [list $code] + } elseif {[punk::ansi::codetype::is_sgr $code]} { + #todo - make caching is_sgr method + set dup_posns [lsearch -all -exact $codestack $code] + set codestack [lremove $codestack {*}$dup_posns] + lappend codestack $code + } else { - } - } - 7GFX { - switch -- [tcl::string::index $code 2] { - "0" { - set o_gx_state on } - "B" { - set o_gx_state off + } + 7GFX { + switch -- [tcl::string::index $code 2] { + "0" { + set o_gx_state on + } + "B" { + set o_gx_state off + } } } + default { + #other ansi codes + } } - default { - #other ansi codes - } + append emit $code } - append emit $code } } return [append emit $R] @@ -4847,6 +4850,15 @@ tcl::namespace::eval punk::ansi { #switch -- [tcl::string::index $cnorm 1][string index $cnorm end] {} # {[m} + #todo - detect multiple \x9b or \x1b and raise error - codes not split? + #if we don't - we can silently get 8CSI 7CSI in output! + if {[string last \x1b\[ $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is a 7CSI not at start)" + } + if {[string last \x9b $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is an 8CSI not at start)" + } + set cnorm [tcl::string::map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] switch -- [tcl::string::range $cnorm 0 3][tcl::string::index $cnorm end] { 7CSIm - 8CSIm { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.8.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.8.tm index 0147636c..9a90e2e4 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.8.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.8.tm @@ -326,7 +326,7 @@ tcl::namespace::eval punk::args { #We mightn't want the prefix to be longer just because of an alias #we should get -co -ce and -m from the above as abbreviations - set map [list %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] + set map [list %G% \x1b\[32m %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] lappend PUNKARGS [list [string map $map { @id -id ::punk::args::define @@ -540,40 +540,41 @@ tcl::namespace::eval punk::args { " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. + {Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \n. Using multiple text arguments may be useful to mix curly-braced and double-quoted strings to have finer control over interpolation when defining arguments. (this can also be handy for sections that pull resolved definition lines from existing definitions (by id) for re-use of argument specifications and help text) e.g the following definition passes 2 blocks as text arguments - definition { + ${[punk::args::tclcore::argdoc::example { + punk::args::define { @id -id ::myns::myfunc - @cmd -name myns::myfunc -help\\ - \"Description of command\" + @cmd -name myns::myfunc -help\ + "Description of command" - #The following option defines an option-value pair - #It may have aliases by separating them with a pipe | - -fg|-foreground -default blah -type string -help\\ - \"In the result dict returned by punk::args::parse + %G%#The following option defines an option-value pair%R% + %G%#It may have aliases by separating them with a pipe |%R% + -fg|-foreground -default blah -type string -help\ + "In the result dict returned by punk::args::parse the value used in the opts key will always be the last - entry, in this case -foreground\" - #The following option defines a flag style option (solo) - -flag1 -default 0 -type none -help\\ - \"Info about flag1 + entry, in this case -foreground" + %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. This line has no extra indent relative to first line 'Info about flag1' - This line indented a further 6 chars\" + This line indented a further 6 chars" @values -min 1 -max -1 - #Items that don't begin with * or - are value definitions + %G%#Items that don't begin with * or - are value definitions%R% v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" - " + } "@doc -name Manpage: -url [myfunc_manpage_geturl myns::myfunc]"}]} + } }]] proc New_command_form {name} { @@ -817,7 +818,8 @@ tcl::namespace::eval punk::args { 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 -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)" @@ -4205,7 +4207,7 @@ tcl::namespace::eval punk::args { } #check if enough remaining_rawargs to fill any required values - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } @@ -4229,7 +4231,7 @@ tcl::namespace::eval punk::args { break } - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } } @@ -4258,7 +4260,7 @@ tcl::namespace::eval punk::args { break } else { if {$valmin > 0} { - if {[llength $remaining_rawargs] -1 >= $valmin} { + if {[llength $remaining_rawargs] > $valmin} { lappend pre_values [lpop remaining_rawargs 0] dict incr leader_posn_names_assigned $leader_posn_name } else { @@ -5211,7 +5213,7 @@ tcl::namespace::eval punk::args { } else { set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" } - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5226,7 +5228,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5234,7 +5236,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -6160,7 +6162,10 @@ tcl::namespace::eval punk::args::lib { } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params [subst -nocommands -novariables $expression] + #JJJ + #REVIEW + #lappend params [subst -nocommands -novariables $expression] + lappend params $expression } append lastline [lindex $params end] ;#for current expression's position calc diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm index ebd18fc1..2442e257 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm @@ -2330,7 +2330,8 @@ tcl::namespace::eval textblock { } } - set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + #set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + set spacemap [list hl "\UFFFE" vl "\UFFFE" tlc "\UFFFE" blc "\UFFFE" trc "\UFFFE" brc "\UFFFE"] ;#transparent overlay elements #set spacemap [list hl * vl * tlc * blc * trc * brc *] #-usecache 1 ok #hval is not raw headerval - it has been padded to required width and has ansi applied @@ -2349,7 +2350,9 @@ tcl::namespace::eval textblock { #this seems like a likely requirement. The first spanned column may well have different alignment requirements than the span. #(e.g if first spanned col happens to be numeric it probably warrants right textalign (if not blockalign) but we don't necessarily want the spanning header or even a non-spanning header to be right aligned) - set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + #header transparent space bug #JJJJ + #set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent \UFFFE $spanned_frame $hblock] #POTENTIAL BUG (fixed with spans_to_rhs above) #when -blockalign right and colspan extends to rhs - last char of longest of that spanlength will overlap right edge (if show_edge 1) #we need to shift 1 to the left when doing our overtype with blockalign right diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm index a7fe1047..9c7c728c 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm @@ -3461,8 +3461,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set codestack [list] if {[punk::ansi::ta::detect $text]} { set emit "" - set parts [punk::ansi::ta::split_codes $text] - foreach {pt code} $parts { + #set parts [punk::ansi::ta::split_codes $text] + set parts [punk::ansi::ta::split_codes_single $text] + foreach {pt codegroup} $parts { switch -- [llength $codestack] { 0 { append emit $base $pt $R @@ -3488,44 +3489,46 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } } - #parts ends on a pt - last code always empty string - if {$code ne ""} { - set c1c2 [tcl::string::range $code 0 1] - set leadernorm [tcl::string::range [tcl::string::map [list\ - \x1b\[ 7CSI\ - \x9b 8CSI\ - \x1b\( 7GFX\ - ] $c1c2] 0 3] - switch -- $leadernorm { - 7CSI - 8CSI { - if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set codestack [list $code] - } elseif {[punk::ansi::codetype::is_sgr $code]} { - #todo - make caching is_sgr method - set dup_posns [lsearch -all -exact $codestack $code] - set codestack [lremove $codestack {*}$dup_posns] - lappend codestack $code - } else { + #parts ends on a pt - last codegroup always empty string + if {$codegroup ne ""} { + foreach code [punk::ansi::ta::get_codes_single $codegroup] { + set c1c2 [tcl::string::range $code 0 1] + set leadernorm [tcl::string::range [tcl::string::map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] + switch -- $leadernorm { + 7CSI - 8CSI { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set codestack [list $code] + } elseif {[punk::ansi::codetype::is_sgr $code]} { + #todo - make caching is_sgr method + set dup_posns [lsearch -all -exact $codestack $code] + set codestack [lremove $codestack {*}$dup_posns] + lappend codestack $code + } else { - } - } - 7GFX { - switch -- [tcl::string::index $code 2] { - "0" { - set o_gx_state on } - "B" { - set o_gx_state off + } + 7GFX { + switch -- [tcl::string::index $code 2] { + "0" { + set o_gx_state on + } + "B" { + set o_gx_state off + } } } + default { + #other ansi codes + } } - default { - #other ansi codes - } + append emit $code } - append emit $code } } return [append emit $R] @@ -4847,6 +4850,15 @@ tcl::namespace::eval punk::ansi { #switch -- [tcl::string::index $cnorm 1][string index $cnorm end] {} # {[m} + #todo - detect multiple \x9b or \x1b and raise error - codes not split? + #if we don't - we can silently get 8CSI 7CSI in output! + if {[string last \x1b\[ $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is a 7CSI not at start)" + } + if {[string last \x9b $c] > 0} { + error "::punk::ansi::codetype::sgr_merge_singles bad entry in codelist [ansistring VIEW $c] (There is an 8CSI not at start)" + } + set cnorm [tcl::string::map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] switch -- [tcl::string::range $cnorm 0 3][tcl::string::index $cnorm end] { 7CSIm - 8CSIm { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.8.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.8.tm index 0147636c..9a90e2e4 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.8.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.8.tm @@ -326,7 +326,7 @@ tcl::namespace::eval punk::args { #We mightn't want the prefix to be longer just because of an alias #we should get -co -ce and -m from the above as abbreviations - set map [list %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] + set map [list %G% \x1b\[32m %B% \x1b\[1m %R% \x1b\[m %N% \x1b\[22m %I% \x1b\[3m %NI% \x1b\[23m ] lappend PUNKARGS [list [string map $map { @id -id ::punk::args::define @@ -540,40 +540,41 @@ tcl::namespace::eval punk::args { " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. + {Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \n. Using multiple text arguments may be useful to mix curly-braced and double-quoted strings to have finer control over interpolation when defining arguments. (this can also be handy for sections that pull resolved definition lines from existing definitions (by id) for re-use of argument specifications and help text) e.g the following definition passes 2 blocks as text arguments - definition { + ${[punk::args::tclcore::argdoc::example { + punk::args::define { @id -id ::myns::myfunc - @cmd -name myns::myfunc -help\\ - \"Description of command\" + @cmd -name myns::myfunc -help\ + "Description of command" - #The following option defines an option-value pair - #It may have aliases by separating them with a pipe | - -fg|-foreground -default blah -type string -help\\ - \"In the result dict returned by punk::args::parse + %G%#The following option defines an option-value pair%R% + %G%#It may have aliases by separating them with a pipe |%R% + -fg|-foreground -default blah -type string -help\ + "In the result dict returned by punk::args::parse the value used in the opts key will always be the last - entry, in this case -foreground\" - #The following option defines a flag style option (solo) - -flag1 -default 0 -type none -help\\ - \"Info about flag1 + entry, in this case -foreground" + %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. This line has no extra indent relative to first line 'Info about flag1' - This line indented a further 6 chars\" + This line indented a further 6 chars" @values -min 1 -max -1 - #Items that don't begin with * or - are value definitions + %G%#Items that don't begin with * or - are value definitions%R% v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" - " + } "@doc -name Manpage: -url [myfunc_manpage_geturl myns::myfunc]"}]} + } }]] proc New_command_form {name} { @@ -817,7 +818,8 @@ tcl::namespace::eval punk::args { 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 -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)" @@ -4205,7 +4207,7 @@ tcl::namespace::eval punk::args { } #check if enough remaining_rawargs to fill any required values - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } @@ -4229,7 +4231,7 @@ tcl::namespace::eval punk::args { break } - if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength <= $valmin} { + if {$valmin > 0 && [llength $remaining_rawargs] - $stridelength < $valmin} { break } } @@ -4258,7 +4260,7 @@ tcl::namespace::eval punk::args { break } else { if {$valmin > 0} { - if {[llength $remaining_rawargs] -1 >= $valmin} { + if {[llength $remaining_rawargs] > $valmin} { lappend pre_values [lpop remaining_rawargs 0] dict incr leader_posn_names_assigned $leader_posn_name } else { @@ -5211,7 +5213,7 @@ tcl::namespace::eval punk::args { } else { set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" } - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5226,7 +5228,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -5234,7 +5236,7 @@ tcl::namespace::eval punk::args { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg } } } @@ -6160,7 +6162,10 @@ tcl::namespace::eval punk::args::lib { } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params [subst -nocommands -novariables $expression] + #JJJ + #REVIEW + #lappend params [subst -nocommands -novariables $expression] + lappend params $expression } append lastline [lindex $params end] ;#for current expression's position calc diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm index 3855921a..61e76831 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm @@ -341,34 +341,40 @@ tcl::namespace::eval punk::args::tclcore { #review #@values -form {*} #note "classify next argument as a value not a leader" #@values -form {*} - + @leaders -form {delay schedule_ms} -min 1 -max 1 ms -form {*} -type int -help\ "milliseconds" - @values -form {delay} -min 1 -max 1 - @values -form {schedule_ms} -min 2 + + @values -form {delay} -min 0 -max 0 + + @values -form {schedule_ms} -min 1 script -form {schedule_ms} -multiple 1 -optional 0 ref-help common_script_help @form -form {cancelid} -synopsis "after cancel id" - @values -min 2 -max 2 + @leaders -min 1 -max 1 cancel -choices {cancel} + @values -min 1 -max 1 id @form -form {cancelscript} -synopsis "after cancel script ?script...?" - @values -min 2 + @leaders -min 1 cancel -choices {cancel} + @values -min 1 script -multiple 1 -optional 0 ref-help common_script_help @form -form {schedule_idle} -synopsis "after idle script ?script...?" - @values -min 2 + @leaders -min 1 -max 1 idle -choices {idle} + @values -min 1 script -multiple 1 -optional 0 ref-help common_script_help @form -form {info} -synopsis "after info ?id?" - @values -min 0 -max 2 + @leaders -min 1 -max 1 info -choices {info} + @values -min 0 -max 1 id -optional 1 } "@doc -name Manpage: -url [manpage_tcl after]" ] @@ -815,6 +821,64 @@ tcl::namespace::eval punk::args::tclcore { key -type string -multiple 1 -optional 0 } "@doc -name Manpage: -url [manpage_tcl dict]" ] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::tcl::dict::for + @cmd -name "Builtin: tcl::dict::for" -help\ + "This command takes three arguments, the first a two-element list of + variable names (for the key and value respectively of each mapping in + the dictionary), the second the dictionary value to iterate across, and + the third a script to be evaluated for each mapping with the key and + value variable set appropriately (in the manner of ${$B}foreach${$N}). + The result of the command is an empty string. If any evlauation of the + body generates a ${$B}TCL_BREAK${$N} result, no further pairs from the + dictionary will be iterated over and the ${$B}dict for${$N} command will + terminate successfully immediately. If any evaluation of the body generates + a ${$B}TCL_CONTINUE${$N} result, this shall be treated exactly like a + normal ${$B}TCL_OK${$N} result. The order of iteration is the order in which + the keys were inserted into the dictionary." + @values -min 3 -max 3 + "{keyVariable valueVariable}" -type list -minsize 2 -maxsize 2 + dictionaryValue -type dict + body -type string -help\ + "Tcl script" + } "@doc -name Manpage: -url [manpage_tcl dict]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + proc example {str} { + set str [string trimleft $str \n] + set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block -- $str]] + set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"] + #puts $result + return $result + } + lappend PUNKARGS [list { + @id -id ::tcl::dict::get + @cmd -name "Builtin: tcl::dict::get" -help\ + "Given a dictionary value (first argument) and a key (second argument), this + will retrieve the value for that key. Where several keys are supplied, the + behaviour of the command shall be as if the result of ${$B}dict get $dictVal $key${$N} + was passed as the first argument to ${$B}dict get${$N} with the remaining + arguments as second (and possibly subsequent) arguments. This facilitates + lookups in nested dictionaries. For example, the following two commands are + equivalent: + ${[punk::args::tclcore::argdoc::example { + dict get $dict foo bar spong + dict get [dict get [dict get $dict foo] bar] spong\ + } + ]} + If no keys are provided, ${$B}dict get${$N} will return a list containing pairs + of elements in a manner similar to ${$B}array get${$N}. That is, the first + element of each pair would be the key and the second element would be the value + for that key. + It is an error to attempt to retrieve a value for a key that is not present in + the dictionary. + " + @values -min 1 -max -1 + dictionaryValue -type dict + key -type string -multiple 1 -optional 1 + } "@doc -name Manpage: -url [manpage_tcl dict]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::tcl::dict::replace @cmd -name "Builtin: tcl::dict::replace" -help\ @@ -1553,6 +1617,41 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl llength]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::lmap + @cmd -name "Builtin: lmap" -help\ + "The ${$B}lmap${$N} command implements a loop where the loop variable(s) + take on values from one or more lists, and the loop returns a list of results + collected from each iteration. + In the simplest case there is one loop variable, ${$I}varname${$NI} and one ${$I}list${$NI}, + that is a list of values to assign to ${$I}varName${$NI}. The ${$I}body${$NI} + argument is a Tcl script. For each element of ${$I}list${$NI} (in order from first + to last), ${$B}lmap${$N} assigns the contents of the element to ${$I}varName${$NI} + as if the ${$B}lindex${$NI} command had been used to extract the element, then + calls the Tcl interpreter to execute ${$I}body${$NI}. + If execution of the body completes normally then the result of body is appended + to an accumulator list. ${$B}lmap${$N} returns the accumulator list. + + In the general case there can be more than one value list, and each value list + can be associated with a list of loop variables. During each iteration of the + loop the variable of each ${$I}varlist${$NI} are assigned consecutive values from + the corresponding ${$I}list${$NI}. Values in each ${$I}list${$NI} are used in order from + first to last, and each value is used exactly once. The total number of loop + iterations is large enough to use up all the values from all the value lists. + If a value list does not contain enough elements for each of its loop variables + in each iteration, empty values are used for the missing elements. + + The ${$B}break${$N} and ${$B}continue${$N} statements may be invoked inside ${$I}body${$NI}, + with the same effect as in the ${$B}for${$N} and ${$B}foreach${$N} commands. + In these cases the body does not complete normally and the result is not appended + to the accumulator list." + @values + "varlist list" -type {list list} -multiple 1 -optional 0 + body -type string -optional 0 -help\ + "Tcl script" + } "@doc -name Manpage: -url [manpage_tcl lmap]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lpop @cmd -name "builtin: lpop" -help\ @@ -1669,6 +1768,19 @@ tcl::namespace::eval punk::args::tclcore { @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} } "@doc -name Manpage: -url [manpage_tcl lremove]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lreverse + @cmd -name "builtin: lreverse" -help\ + "Reverse the order of a list. + The ${$B}lreverse${$N} command returns a list that has the same elements + as its input list, ${$I}list${$NI}, exept with the elements in reverse + order." + @values -min 1 -max 1 + list -type list -help\ + "tcl list as a value" + } "@doc -name Manpage: -url [manpage_tcl lreverse]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -1737,6 +1849,67 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl lset]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lseq + @cmd -name "builtin: lseq" -help\ + "Build a numeric sequence returned as a list. + The ${$B}lseq${$N} command creates a sequence of numeric values using the given + parameters ${$I}start${$NI}, ${$I}end${$NI} and ${$I}step${$NI}. The ${$I}operation${$NI} + argument \"..\" or \"${$B}to${$N}\" defines the range. The \"${$B}count${$N}\" option is + used to defina a count of the number of elements in the list. A short form use of the + command, with a single ${$I}count${$NI} value, will creat a range from 0 to ${$I}count-1${$NI}. + The ${$B}lseq${$N} command can produce both increasing and decreasing sequences. + When both ${$I}start${$NI} and ${$I}end${$NI} are provided without a ${$I}step${$NI} value, + then if ${$I}start${$NI} <= ${$I}end${$NI}, the sequence will be increasing and if + ${$I}start${$NI} > ${$I}end${$NI} it will be decreasing. If a ${$I}step${$NI} value is + included, it's sign should agree with the direction of the sequence + (descending -> negative and ascending -> positive), otherwise an empty list is returned. + For example: + ${[punk::args::tclcore::argdoc::example { + % lseq 1 to 5 ;#increasing + -> 1 2 3 4 5 + + % lseq 5 to 1 ;#decreasing + -> 5 4 3 2 1 + + % lseq 6 to 1 by 2 ;#decreasing, step wrong sign, empty list + + % lseq 1 5 by 0 ;#all step sizes of 0 produce an empty list + }]} + + The numeric arguments ${$I}start${$NI}, ${$I}end${$NI}, ${$I}step${$NI} and ${$I}count${$NI}, may + also be a valid expression. The expression will be evaluated and the numeric result will + be used. An expression that does not evaluate to a number will produce an invalid argument error. + ${$I}Start${$NI} defines the initial value and ${$I}end${$NI} defines the limit, not necessarily + the last value. ${$B}lseq${$N} produces a list with ${$B}count${$N} elements and if ${$B}count${$N} + is not supplied, it is computed as: + count = int( (end - start + step) / step) + " + @form -form range + @leaders -min 0 -max 0 + @values -min 2 -max 5 + start -type number|expr + ..|to -type string -choices {.. to} -optional 1 + end -type number|expr + "by step" -type {literal number|expr} -optional 1 + + @form -form start_count + @leaders -min 0 -max 0 + @values -min 3 -max 5 + start -type number|expr + count -type literal + countelements -type number|expr + "by step" -type {literal number|expr} -optional 1 + + @form -form count + @leaders -min 0 -max 0 + @values -min 1 -max 3 + countelements -type number|expr + "by step" -type {literal number|expr} -optional 1 + + } "@doc -name Manpage: -url [manpage_tcl lreverse]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm b/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm index 0c8b848b..f11fbac8 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm @@ -1512,13 +1512,14 @@ tcl::namespace::eval punk::imap4 { Returns the Tcl channel to use in subsequent calls to the API. Other API commands will return zero on success. e.g + ${[punk::args::tclcore::argdoc::example { % set chan [CONNECT mail.example.com] sock123aaa456789 % AUTH_PLAIN $chan user pass 0 ... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ... % LOGOUT $chan - 0" + 0}]}" @leaders -min 0 -max 0 -debug -type boolean -default 0 -help\ "Display some of the cli/server interaction on stdout diff --git a/src/vfs/_vfscommon.vfs/modules/test/punk/args-0.1.5.tm b/src/vfs/_vfscommon.vfs/modules/test/punk/args-0.1.5.tm index c99f99fe..046d6cc2 100644 Binary files a/src/vfs/_vfscommon.vfs/modules/test/punk/args-0.1.5.tm and b/src/vfs/_vfscommon.vfs/modules/test/punk/args-0.1.5.tm differ diff --git a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm index ebd18fc1..2442e257 100644 --- a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm +++ b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm @@ -2330,7 +2330,8 @@ tcl::namespace::eval textblock { } } - set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + #set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] ;#transparent overlay elements + set spacemap [list hl "\UFFFE" vl "\UFFFE" tlc "\UFFFE" blc "\UFFFE" trc "\UFFFE" brc "\UFFFE"] ;#transparent overlay elements #set spacemap [list hl * vl * tlc * blc * trc * brc *] #-usecache 1 ok #hval is not raw headerval - it has been padded to required width and has ansi applied @@ -2349,7 +2350,9 @@ tcl::namespace::eval textblock { #this seems like a likely requirement. The first spanned column may well have different alignment requirements than the span. #(e.g if first spanned col happens to be numeric it probably warrants right textalign (if not blockalign) but we don't necessarily want the spanning header or even a non-spanning header to be right aligned) - set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + #header transparent space bug #JJJJ + #set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] + set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent \UFFFE $spanned_frame $hblock] #POTENTIAL BUG (fixed with spans_to_rhs above) #when -blockalign right and colspan extends to rhs - last char of longest of that spanlength will overlap right edge (if show_edge 1) #we need to shift 1 to the left when doing our overtype with blockalign right