From 23f08b63d64350e336778d59ba4de41bbd050751 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 3 Feb 2024 00:42:53 +1100 Subject: [PATCH] belated shell*.tm version bumps, bootsupport --- src/bootsupport/modules/punk/ansi-0.1.0.tm | 379 +++++++++- src/bootsupport/modules/punk/console-0.1.0.tm | 8 +- src/bootsupport/modules/punk/lib-0.1.0.tm | 696 ++++++++++++++++++ src/bootsupport/modules/punk/ns-0.1.0.tm | 5 +- ...llfilter-0.1.8.tm => shellfilter-0.1.9.tm} | 0 .../{shellrun-0.1.tm => shellrun-0.1.1.tm} | 0 ...hellthread-1.6.tm => shellthread-1.6.1.tm} | 0 7 files changed, 1063 insertions(+), 25 deletions(-) rename src/modules/{shellfilter-0.1.8.tm => shellfilter-0.1.9.tm} (100%) rename src/modules/{shellrun-0.1.tm => shellrun-0.1.1.tm} (100%) rename src/modules/{shellthread-1.6.tm => shellthread-1.6.1.tm} (100%) diff --git a/src/bootsupport/modules/punk/ansi-0.1.0.tm b/src/bootsupport/modules/punk/ansi-0.1.0.tm index d465796c..a499afb3 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.0.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.0.tm @@ -83,6 +83,7 @@ namespace eval punk::ansi { #Note that a? is actually a pattern. We can't explicitly match it without also matcing a+ ab etc. Presumably this won't matter here. namespace export\ {a?} {a+} a \ + ansistring\ convert*\ clear*\ cursor_*\ @@ -105,8 +106,12 @@ namespace eval punk::ansi { #NOTE - we are assuming an OSC or DCS started with one type of sequence (7 or 8bit) can be terminated by either 7 or 8 bit ST (or BEL e.g wezterm ) #This using a different type of ST to that of the opening sequence is presumably unlikely in the wild - but who knows? + variable standalone_codes + set standalone_codes [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + #review - there doesn't seem to be an \x1b#7 + # https://espterm.github.io/docs/VT100%20escape%20codes.html + #self-contained 2 byte ansi escape sequences - review more? - variable ansi_2byte_codes_dict set ansi_2byte_codes_dict [dict create\ "reset_terminal" "\u001bc"\ "save_cursor_posn" "\u001b7"\ @@ -119,11 +124,50 @@ namespace eval punk::ansi { "DECPNM norm keypad" "\x1b>"\ ] + #control strings + #https://www.ecma-international.org/wp-content/uploads/ECMA-48_5th_edition_june_1991.pdf + # + #A control string is a string of bit combinations which may occur in the data stream as a logical entity for + #control purposes. A control string consists of an opening delimiter, a command string or a character string, + #and a terminating delimiter, the STRING TERMINATOR (ST). + #A command string is a sequence of bit combinations in the range 00/08 to 00/13 and 02/00 to 07/14. + #A character string is a sequence of any bit combination, except those representing START OF STRING + #(SOS) or STRING TERMINATOR (ST). + #The interpretation of the command string or the character string is not defined by this Standard, but instead + #requires prior agreement between the sender and the recipient of the data. + #The opening delimiters defined in this Standard are + #a) APPLICATION PROGRAM COMMAND (APC) + #b) DEVICE CONTROL STRING (DCS) + #c) OPERATING SYSTEM COMMAND (OSC) + #d) PRIVACY MESSAGE (PM) + #e) START OF STRING (SOS) + # #debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway. # "PM - Privacy Message" "\u001b^somethinghidden\033\\"\ #The intent is that it's not rendered to the terminal - so on balance it seems best to strip it out. #todo - review - printing_length calculations affected by whether terminal honours PMs or not. detect and accomodate. + #review - can terminals handle SGR codes within a PM? + #Wezterm will hide PM,SOS,APC - but not any part following an SGR code - i.e it seems to terminate hiding before the ST (apparently at the ) + proc controlstring_PM {text} { + return "\x1b^${text}\033\\" + } + proc controlstring_PM8 {text} { + return "\x9e${text}\x9c" + } + proc controlstring_SOS {text} { + return "\x1bX${text}\033\\" + } + proc controlstring_SOS8 {text} { + return "\x98${text}\x9c" + } + proc controlstring_APC {text} { + return "\x1b_${text}\033\\" + } + proc controlstring_APC8 {text} { + return "\x9f${text}\x9c" + } + #candidate for zig/c implementation? proc stripansi {text} { #*** !doctools @@ -133,6 +177,7 @@ namespace eval punk::ansi { #todo - character set selection - SS2 SS3 - how are they terminated? REVIEW variable escape_terminals ;#dict + variable standalone_codes ;#map to empty string set text [convert_g0 $text] @@ -145,9 +190,7 @@ namespace eval punk::ansi { #\x1b#6 double-width line #\x1b#8 dec test fill screen - set clean_map_2b [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> ""] - set clean_map_3b [list \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] - set text [string map [concat $clean_map_2b $clean_map_3b] $text] + set text [string map $standalone_codes $text] #we process char by char - line-endings whether \r\n or \n should be processed as per any other character. #line endings can theoretically occur within an ansi escape sequence payload (review e.g title?) @@ -169,7 +212,7 @@ namespace eval punk::ansi { if {$u in $endseq} { set in_escapesequence 0 } elseif {$uv in $endseq} { - set in_escapseequence 2b ;#flag next byte as last in sequence + set in_escapesequence 2b ;#flag next byte as last in sequence } } else { #handle both 7-bit and 8-bit CSI and OSC @@ -179,7 +222,7 @@ namespace eval punk::ansi { set in_escapesequence OSC } elseif {[regexp {^(?:\033P|\u0090)} $uv]} { set in_escapesequence DCS - } elseif {[regexp {^(?:\033X|\u0098|\033^|\u009E|\033_|\u009F)} $uv]} { + } elseif {[regexp {^(?:\033X|\u0098|\033\^|\u009E|\033_|\u009F)} $uv]} { #SOS,PM,APC - all terminated with ST set in_escapesequence MISC } else { @@ -248,7 +291,7 @@ namespace eval punk::ansi { proc colourmap1 {{bgname White}} { package require textblock - set bg [textblock::block 3 33 "[a+ $bgname] [a]"] + set bg [textblock::block 33 3 "[a+ $bgname] [a]"] set colormap "" for {set i 0} {$i <= 7} {incr i} { append colormap "_[a+ white bold 48\;5\;$i] $i [a]" @@ -258,7 +301,7 @@ namespace eval punk::ansi { } proc colourmap2 {{bgname White}} { package require textblock - set bg [textblock::block 3 39 "[a+ $bgname] [a]"] + set bg [textblock::block 39 3 "[a+ $bgname] [a]"] set colormap "" for {set i 8} {$i <= 15} {incr i} { append colormap "_[a+ black normal 48\;5\;$i] $i [a]" ;#black normal is blacker than black bold - which often displays as a grey @@ -691,6 +734,7 @@ namespace eval punk::ansi { return "\u0090+q$payload\u009c" } namespace eval codetype { + #Functions that operate on a single ansi code sequence - not a sequence, and not codes embedded in another string proc is_sgr {code} { #SGR (Select Graphic Rendition) - codes ending in 'm' - e.g colour/underline #we will accept and pass through the less common colon separator (ITU Open Document Architecture) @@ -701,13 +745,13 @@ namespace eval punk::ansi { #review - what about CSI n : m H where row n happens to be current line? regexp {\033\[[0-9]*(:?C|D|G)$} } - #pure SGR reset + #pure SGR reset with no other functions proc is_sgr_reset {code} { #todo 8-bit csi regexp {\033\[0*m$} $code } #whether this code has 0 (or equivalently empty) parameter (but may set others) - #if an SGR code as a reset in it - we don't need to carry forward any previous SGR codes + #if an SGR code has a reset in it - we don't need to carry forward any previous SGR codes #it generally only makes sense for the reset to be the first entry - otherwise the code has ineffective portions #However - detecting zero or empty parameter in other positions requires knowing all other codes that may allow zero or empty params. #We will only look at initial parameter as this is the well-formed normal case. @@ -723,6 +767,9 @@ namespace eval punk::ansi { return 0 } } + + #has_sgr_reset - rather than support this function - create an sgr normalize function that removes dead params and brings reset to front of param list? + } namespace eval sequence_type { proc is_Fe {code} { @@ -773,14 +820,35 @@ namespace eval punk::ansi::ta { #OSC - termnate with BEL (\a \007) or ST (string terminator \033\\) # 8-byte string terminator is \x9c (\u009c) - #test - non-greedy - variable re_esc_osc1 {(?:\033\]).*?\007} - variable re_esc_osc2 {(?:\033\]).*?\033\\} - variable re_esc_osc3 {(?:\u009d).*?\u009c} + #non-greedy via "*?" doesn't seem to work like this.. + #variable re_esc_osc1 {(?:\033\]).*?\007} + #variable re_esc_osc2 {(?:\033\]).*?\033\\} + #variable re_esc_osc3 {(?:\u009d).*?\u009c} + + #non-greedy by excluding ST terminators + #TODO - FIX? see re_ST below + variable re_esc_osc1 {(?:\033\])(?:[^\007]*)\007} + variable re_esc_osc2 {(?:\033\])(?:[^\033]*)\033\\} + variable re_esc_osc3 {(?:\u009d)(?:[^\u009c]*)?\u009c} variable re_osc_open {(?:\033\]|\u009d).*} - variable re_ansi_detect "${re_csi_open}|${re_esc_osc1}|${re_esc_osc2}" + #standalone_codes [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + + #see stripansi + set re_start_ST {^(?:\033X|\u0098|\033\^|\u009e|\033_|\u009f)} + #ST terminators [list \007 \033\\ \u009c] + + #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST) + #non-greedy by exclusion of ST terminators in body + #!!! + #TODO - fix. we need to match \033\\ not just \033 ! could be colour codes nested in a privacy msg/string + #This will currently terminate the code too early in this case + #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions) + variable re_ST {(?:\033X|\u0098|\033\^|\u009E|\033_|\u009F)(?:[^\033\007\u009c]*)(?:\033\\|\007|\u009c)} + + variable re_ansi_detect "${re_csi_open}|${re_esc_osc1}|${re_esc_osc2}|${re_standalones}|${re_start_ST}" #detect any ansi escapes #review - only detect 'complete' codes - or just use the opening escapes for performance? @@ -851,7 +919,9 @@ namespace eval punk::ansi::ta { variable re_esc_osc1 variable re_esc_osc2 variable re_csi_code - punk::ansi::internal::splitx $text "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}" + variable re_standalones + variable re_ST + punk::ansi::internal::splitx $text "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_standalones}|${re_ST}" } # -- --- --- --- --- --- @@ -871,7 +941,9 @@ namespace eval punk::ansi::ta { variable re_esc_osc1 variable re_esc_osc2 variable re_csi_code - set re "(?:${re_csi_code}|${re_esc_osc1}|${re_esc_osc2})+" + variable re_standalones + variable re_ST + set re "(?:${re_csi_code}|${re_standalones}|${re_ST}|${re_esc_osc1}|${re_esc_osc2})+" return [_perlish_split $re $text] } #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) @@ -879,7 +951,9 @@ namespace eval punk::ansi::ta { variable re_esc_osc1 variable re_esc_osc2 variable re_csi_code - set re "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}" + variable re_standalones + variable re_ST + set re "${re_csi_code}|${re_standalones}|${re_ST}|${re_esc_osc1}|${re_esc_osc2}" return [_perlish_split $re $text] } @@ -890,10 +964,26 @@ namespace eval punk::ansi::ta { } set list [list] set start 0 + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW while {[regexp -start $start -indices -- $re $text match]} { lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + lappend list [string range $text $start $matchStart-1] [string index $text $matchStart] + incr start + if {$start >= [string length $text]} { + break + } + continue + } lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] set start [expr {$matchEnd+1}] + + #? + if {$start >= [string length $text]} { + break + } } lappend list [string range $text $start end] return $list @@ -911,19 +1001,264 @@ namespace eval punk::ansi::ta { namespace eval punk::ansi::ansistring { #*** !doctools #[subsection {Namespace punk::ansi::ansistring}] - #[para]punk::ansi::string ensemble + #[para]punk::ansi::ansistring ensemble - ansi-aware string operations + #[para]Working with strings containing ansi in a way that preserves/understands the codes is always going to be significantly slower than working with plain strings + #[para]Just as working with other forms of markup such as HTML - you simply need to be aware of the tradeoffs and design accordingly. #[list_begin definitions] + namespace path [list ::punk::ansi ::punk::ansi::ta] namespace ensemble create - namespace export length - + namespace export length trim trimleft trimright index VIEW + #todo - expose _splits_ methods so caller can work efficiently with the splits themselves + #we need to consider whether these can be agnostic towards splits from split_codes vs split_codes_single + + #\UFFFD - replacement char or \U2426 + + #using ISO 2047 graphical representations of control characters + #00 NUL Null ⎕ U+2395 NU + #01 TC1, SOH Start of Heading ⌈ U+2308 SH + #02 TC2, STX Start of Text ⊥ U+22A5 SX + #03 TC3, ETX End of Text ⌋ U+230B EX + #04 TC4, EOT End of Transmission ⌁ U+2301[9] ET + #05 TC5, ENQ Enquiry ⊠[a] U+22A0 EQ + #06 TC6, ACK Acknowledge ✓ U+2713 AK + #07 BEL Bell ⍾ U+237E[9] BL + #08 FE0, BS Backspace ⤺ —[b] BS + #09 FE1, HT Horizontal Tabulation ⪫ U+2AAB HT + #0A FE2, LF Line Feed ≡ U+2261 LF + #0B FE3, VT Vertical Tabulation ⩛ U+2A5B VT + #0C FE4, FF Form Feed ↡ U+21A1 FF + #0D FE5, CR Carriage Return ⪪ U+2AAA CR + #0E SO Shift Out ⊗ U+2297 SO + #0F SI Shift In ⊙ U+2299 SI + #10 TC7, DLE Data Link Escape ⊟ U+229F DL + #11 DC1, XON, CON[10] Device Control 1 ◷ U+25F7 D1 + #12 DC2, RPT,[10] TAPE[c] Device Control 2 ◶ U+25F6 D2 + #13 DC3, XOF, XOFF Device Control 3 ◵ U+25F5 D3 + #14 DC4, COF, KMC,[10] TAPE[c] Device Control 4 ◴ U+25F4 D4 + #15 TC8, NAK Negative Acknowledge ⍻ U+237B[9] NK + #16 TC9, SYN Synchronization ⎍ U+238D SY + #17 TC10, ETB End of Transmission Block ⊣ U+22A3 EB + #18 CAN Cancel ⧖ U+29D6 CN + #19 EM End of Medium ⍿ U+237F[9] EM + #1A SUB Substitute Character ␦ U+2426[12] SB + #1B ESC Escape ⊖ U+2296 EC + #1C IS4, FS File Separator ◰ U+25F0 FS + #1D IS3, GS Group Separator ◱ U+25F1 GS + #1E IS2, RS Record Separator ◲ U+25F2 RS + #1F IS1 US Unit Separator ◳ U+25F3 US + #20 SP Space △ U+25B3 SP + #7F DEL Delete ▨ —[d] DT + proc VIEW {string} { + return [string map [list \033 \U2296 \007 \U237E] $string] + } + proc length {string} { - string length [ansistrip $string] + #*** !doctools + #[call [fun length] [arg string]] + #[para]Returns the length of the string without ansi codes + #[para]This will not count strings hidden inside a 'privacy message' or other ansi codes which may have content between their opening escape and their termination sequence. + #[para]This is equivalent to calling string length on the result of stripansi $string + #[para]Note that this returns the number of characters in the payload, and is not always the same as the width of the string as rendered on a terminal. + #[para]To get the width, use punk::ansi::printing_length instead, which is also ansi aware. + string length [stripansi $string] } + proc trimleft {string args} { + set intext 0 + set out "" + #for split_codes only first or last pt can be empty string + foreach {pt ansiblock} [split_codes $string] { + if {!$intext} { + if {$pt eq "" || [regexp {^\s+$} $pt]} { + append out $ansiblock + } else { + append out [string trimleft $pt]$ansiblock + set intext 1 + } + } else { + append out $pt$ansiblock + } + } + return $out + } + proc trimright {string} { + if {$string eq ""} {return ""} ;#excludes the case where split_codes would return nothing + set rtrimmed_list [lreverse [_splits_trimleft [lreverse [split_codes $string]]]] + return [join $rtrimmed_list ""] + } + proc trim {string} { + #make sure we do our ansi-scanning split only once - so use list-based trim operations + #order of left vs right probably makes zero difference - as any reduction the first operation can do is only in terms of characters at other end of list - not in total list length + #we save a single function call by calling both here rather than _splits_trim + join [_splits_trimright [_splits_trimleft [split_codes $string]]] "" + } + proc index {string index} { + #*** !doctools + #[call [fun index] [arg string] [arg index]] + #[para]Takes a string that possibly contains ansi codes such as colour,underline etc (SGR codes) + #[para]Returns the character (with applied ansi effect) at position index + #[para]The string could contain non SGR ansi codes - and these will (mostly) be ignored, so shouldn't affect the output. + #[para]Some terminals don't hide 'privacy message' and other strings within an ESC X ESC ^ or ESC _ sequence (terminated by ST) + #[para]It's arguable some of these are application specific - but this function takes the view that they are probably non-displaying - so index won't see them. + #[para]todo: SGR codes within ST-terminated strings not yet ignored properly + #[para]If the caller wants just the character - they should use a normal string index after calling stripansi, or call stripansi afterwards. + #[para]As any operation using end-+ will need to strip ansi to precalculate the length anyway; the caller should probably just use stripansi and standard string index if the ansi coded output isn't required and they are using and end-based index. + #[para]In fact, any operation where the ansi info isn't required in the output would probably be slightly more efficiently obtained by using stripansi and normal string operations on that. + #[para]The returned character will (possibly) have a leading ansi escape sequence but no trailing escape sequence - even if the string was taken from a position immediately before a reset or other SGR ansi code + #[para]The ansi-code prefix in the returned string is built up by concatenating previous SGR ansi codes seen - but it is optimised to re-start the process if any full SGR reset is encountered. + #[para]The code sequence doesn't detect individual properties being turned on and then off again, only full resets; so in some cases the ansi-prefix may not be as short as it could be. + #[para]This shouldn't make any difference to the visual output - but a possible future enhancement is something to produce the shortest ansi sequence possible + #[para]Notes: + #[para]This function has to split the whole string into plaintext & ansi codes even for a very low index + #[para]Some sort of generator that parses more of the string as required might be more efficient for large chunks. + #[para]For end-x operations we have to pre-calculate the content-length by stripping the ansi - which is also potentially sub-optimal + + set splits [split_codes_single $string]; #we get empty pt(plaintext) between each ansi code that is in a run + + #todo - end-x +/-x+/-x etc + set original_index $index + + set index [string map [list _ ""] $index] + #short-circuit some trivial cases + if {[string is integer -strict $index]} { + if {$index < 0} {return ""} + #this only short-circuits an index greater than length including ansi-chars + #we don't want to spend cycles stripping ansi for this test so code below will still have to handle index just larger than content-length but still less than entire length + if {$index > [string length $string]} {return ""} + } else { + if {[string match end* $index]} { + #for end- we will probably have to blow a few cycles stripping first and calculate the length + if {$index ne "end"} { + set op [string index $index 3] + set offset [string range $index 4 end] + if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"} + if {$op eq "+" && $offset != 0} { + return "" + } + } else { + set offset 0 + } + #by now, if op = + then offset = 0 so we only need to handle the minus case + set payload_len [punk::ansi::ansistring::length $string] ;#a little bit wasteful - but hopefully no big deal + if {$offset == 0} { + set index [expr {$payload_len-1}] + } else { + set index [expr {($payload_len-1) - $offset}] + } + if {$index < 0} { + #don't waste time splitting and looping the string + return "" + } + } else { + #we are trying to avoid evaluating unbraced expr of potentially insecure origin + regexp {^([+-]{0,1})(.*)} $index _match sign tail ;#should always match - even empty string + if {[string is integer -strict $tail]} { + #plain +- + if {$op eq "-"} { + #return nothing for negative indices as per Tcl's lindex etc + return "" + } + set index $tail + } else { + if {[regexp {(.*)([+-])(.*)} $index _match a op b]} { + if {[string is integer -strict $a] && [string is integer -strict $b]} { + if {$op eq "-"} { + set index [expr {$a - $b}] + } else { + set index [expr {$a + $b}] + } + } else { + error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?" + } + } else { + error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?" + } + } + } + } + + #any pt could be empty if using split_codes_single (or just first and last pt if split_codes) + set low -1 + set high -1 + set pt_index -2 + set pt_found -1 + set char "" + set codes_in_effect "" + #we can't only apply leading sequence from previous code - as there may be codes in effect from earlier, so we have to track as we go + #(this would apply even if we used split_codes - but then we would need to do further splitting of each codeset anyway) + foreach {pt code} $splits { + incr pt_index 2 + if {$pt ne ""} { + set low [expr {$high + 1}] ;#last high + incr high [string length $pt] + } + + if {$pt ne "" && ($index >= $low && $index <= $high)} { + set pt_found $pt_index + set char [string index $pt $index-$low] + break + } + + if {[punk::ansi::codetype::is_sgr_reset $code]} { + #we can throw away previous codes_in_effect + set codes_in_effect "" + } else { + #may have partial resets - but we don't want to track individual states of SGR features + #A possible feature would be some function to optimise an ansi code sequence - which we could then apply at the end. + #we don't apply non SGR codes to our output. This is probably what is wanted - but should be reviewed. + #Review - consider if any other types of code make sense to retain in the output in this context. + if {[punk::ansi::codetype::is_sgr $code]} { + append codes_in_effect $code + } + } + + } + if {$pt_found >= 0} { + return $codes_in_effect$char + } else { + return "" + } } + proc _splits_trimleft {sclist} { + set intext 0 + set outlist [list] + foreach {pt ansiblock} $sclist { + if {!$intext} { + if {$pt eq "" || [regexp {^\s+$} $pt]} { + lappend outlist "" $ansiblock + } else { + lappend outlist [string trimleft $pt] $ansiblock + set intext 1 + } + } else { + lappend outlist $pt $ansiblock + } + } + return $outlist + } + proc _splits_trimright {sclist} { + set intext 0 + set outlist [list] + foreach {pt ansiblock} [lreverse $sclist] { + if {!$intext} { + if {$pt eq "" || [regexp {^\s+$} $pt]} { + lappend outlist "" $ansiblock + } else { + lappend outlist [string trimright $pt] $ansiblock + set intext 1 + } + } else { + lappend outlist $pt $ansiblock + } + } + return [lreverse $outlist] + } + proc _splits_trim {sclist} { + return [_splits_trimright [_splits_trimleft $sclist]] + } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}] diff --git a/src/bootsupport/modules/punk/console-0.1.0.tm b/src/bootsupport/modules/punk/console-0.1.0.tm index b6e7e929..701f42af 100644 --- a/src/bootsupport/modules/punk/console-0.1.0.tm +++ b/src/bootsupport/modules/punk/console-0.1.0.tm @@ -441,7 +441,13 @@ namespace eval punk::console { if {!$emit} { puts -nonewline stdout \033\[2K\033\[1G ;#2K erase line 1G cursor at col1 } - lassign [split [punk::console::get_cursor_pos] ";"] _row1 col1 + if {[catch { + lassign [split [punk::console::get_cursor_pos] ";"] _row1 col1 + } errM]} { + puts stderr "Cannot test_char_width - may be no console? Error message from get_cursor_pos: $errM" + return + } + puts -nonewline stdout $char_or_string lassign [split [punk::console::get_cursor_pos] ";"] _row2 col2 if {!$emit} { diff --git a/src/bootsupport/modules/punk/lib-0.1.0.tm b/src/bootsupport/modules/punk/lib-0.1.0.tm index f05e87e9..59fdcde6 100644 --- a/src/bootsupport/modules/punk/lib-0.1.0.tm +++ b/src/bootsupport/modules/punk/lib-0.1.0.tm @@ -514,6 +514,702 @@ namespace eval punk::lib { return $answer } + #e.g linesort -decreasing $data + proc linesort {args} { + #*** !doctools + #[call [fun linesort] [opt {sortoption ?val?...}] [arg textblock]] + #[para]Sort lines in textblock + #[para]Returns another textblock with lines sorted + #[para]options are flags as accepted by lsort ie -ascii -command -decreasing -dictionary -index -indices -integer -nocase -real -stride -unique + if {[llength $args] < 1} { + error "linesort missing lines argument" + } + set lines [lindex $args end] + set opts [lrange $args 0 end-1] + #.= list $lines |@0,sortopts/1> linelist |> .=data>1,sortopts>1* lsort |> list_as_lines <| {*}$opts + list_as_lines [lsort {*}$opts [linelist $lines]] + } + + proc list_as_lines {args} { + #*** !doctools + #[call [fun list_as_lines] [opt {-joinchar char}] [arg linelist]] + #[para]This simply joines the elements of the list with -joinchar + #[para]It is mainly intended for use in pipelines where the primary argument comes at the end - but it can also be used as a general replacement for join $lines + #[para]The sister function lines_as_list takes a block of text and splits it into lines - but with more options related to trimming the block and/or each line. + if {[set eop [lsearch $args --]] == [llength $args]-2} { + #end-of-opts not really necessary - except for consistency with lines_as_list + set args [concat [lrange $args 0 $eop-1] [lrange $args $eop+1 end]] + } + if {[llength $args] == 3 && [lindex $args 0] eq "-joinchar"} { + set joinchar [lindex $args 1] + set lines [lindex $args 2] + } elseif {[llength $args] == 1} { + set joinchar "\n" + set lines [lindex $args 0] + + } else { + error "list_as_lines usage: list_as_lines ?-joinchar ? " + } + return [join $lines $joinchar] + } + proc list_as_lines2 {args} { + #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible + lassign [dict values [punk::lib::opts_values -minvalues 1 -maxvalues 1 { + -joinchar -default \n + } $args]] opts values + return [join [dict get $values 0] [dict get $opts -joinchar]] + } + + proc lines_as_list {args} { + #The underlying function linelist has the validation code which gives nice usage errors. + #we can't use a dict merge here without either duplicating the underlying validation somewhat, or risking a default message from dict merge error + #..because we don't know what to say if there are odd numbers of args + #we can guess that it's ok to insert our default if no -block found in $args - but as a general principle this mightn't always work + #e.g if -block is also a valid value for the textblock itself. Which in this case it is - although unlikely, and our -block {} default is irrelevant in that case anyway + + if {[lsearch $args "--"] == [llength $args]-2} { + set opts [lrange $args 0 end-2] + } else { + set opts [lrange $args 0 end-1] + } + #set opts [dict merge {-block {}} $opts] + set bposn [lsearch $opts -block] + if {$bposn < 0} { + set opts {-block {}} + } + set text [lindex $args end] + tailcall linelist {*}$opts $text + } + #this demonstrates the ease of using an args processor - but as lines_as_list is heavily used in terminal output - we can't afford the extra microseconds + proc lines_as_list2 {args} { + #pass -anyopts 1 so we can let the next function decide what arguments are valid - but still pass our defaults + #-anyopts 1 avoids having to know what to say if odd numbers of options passed etc + #we don't have to decide what is an opt vs a value + #even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block) + lassign [dict values [punk::lib::opts_values -anyopts 1 { + -block -default {} + } $args]] opts valuedict + tailcall linelist {*}$opts {*}[dict values $valuedict] + } + + # important for pipeline & match_assign + # -line trimline|trimleft|trimright -block trimhead|trimtail|triminner|trimall|trimhead1|trimtail1|collateempty -commandprefix {string length} ? + # -block trimming only trims completely empty lines. use -line trimming to remove whitespace e.g -line trimright will clear empty lines without affecting leading whitespace on other lines that aren't pure whitespace + proc linelist {args} { + #puts "---->linelist '$args'" + set usage "linelist ?-line trimline|trimleft|trimright? ?-block trimhead|trimtail|triminner|trimall|trimhead1|trimtail1|collateempty? -commandprefix text" + if {[llength $args] == 0} { + error "linelist missing textchunk argument usage:$usage" + } + set text [lindex $args end] + set arglist [lrange $args 0 end-1] + set defaults [dict create\ + -block {trimhead1 trimtail1}\ + -line {}\ + -commandprefix ""\ + -ansiresets 1\ + ] + dict for {o v} $arglist { + if {$o ni {-block -line -commandprefix -ansiresets}} { + error "linelist: Unrecognized option '$o' usage:$usage" + } + } + set opts [dict merge $defaults $arglist] + # -- --- --- --- --- --- + set opt_block [dict get $opts -block] + set known_blockopts [list trimhead trimtail triminner trimall trimhead1 trimtail1 collateempty] + foreach bo $opt_block { + if {$bo ni $known_blockopts} { + error "linelist: unknown -block option value: $bo known values: $known_blockopts" + } + } + #normalize certain combos + if {[set posn [lsearch $opt_block trimhead1]] >=0 && "trimhead" in $opt_block} { + set opt_block [lreplace $opt_block $posn $posn] + } + if {[set posn [lsearch $opt_block trimtail1]] >=0 && "trimtail" in $opt_block} { + set opt_block [lreplace $opt_block $posn $posn] + } + if {"trimall" in $opt_block} { + #no other block options make sense in combination with this + set opt_block [list "trimall"] + } + + #TODO + if {"triminner" in $opt_block } { + error "linelist -block triminner not implemented - sorry" + } + + # -- --- --- --- --- --- + set opt_line [dict get $opts -line] + set known_lineopts [list trimline trimleft trimright] + foreach lo $opt_line { + if {$lo ni $known_lineopts} { + error "linelist: unknown -line option value: $lo known values: $known_lineopts" + } + } + #normalize trimleft trimright combo + if {"trimleft" in $opt_line && "trimright" in $opt_line} { + set opt_line [list "trimline"] + } + # -- --- --- --- --- --- + set opt_commandprefix [dict get $opts -commandprefix] + # -- --- --- --- --- --- + set linelist [list] + set nlsplit [split $text \n] + if {![llength $opt_line]} { + set linelist $nlsplit + #lappend linelist {*}$nlsplit + } else { + foreach ln $nlsplit { + #already normalized trimleft+trimright to trimline + if {"trimline" in $opt_line} { + lappend linelist [string trim $ln] + } elseif {"trimleft" in $opt_line} { + lappend linelist [string trimleft $ln] + } elseif {"trimright" in $opt_line} { + lappend linelist [string trimright $ln] + } + } + } + + if {"collateempty" in $opt_block} { + set inputlist $linelist[set linelist [list]] + set last "-" + foreach input $inputlist { + if {$input ne ""} { + lappend linelist $input + set last "-" + } else { + if {$last ne ""} { + lappend linelist "" + } + set last "" + } + } + } + + if {"trimall" in $opt_block} { + set linelist [lsearch -all -inline -not -exact $linelist[set linelist {}] ""] + } else { + set start 0 + if {"trimhead" in $opt_block} { + set idx 0 + set lastempty -1 + foreach ln $linelist { + if {[lindex $linelist $idx] ne ""} { + break + } else { + set lastempty $idx + } + incr idx + } + if {$lastempty >=0} { + set start [expr {$lastempty +1}] + } + } + set linelist [lrange $linelist $start end] + + if {"trimtail" in $opt_block} { + set revlinelist [lreverse $linelist][set linelist {}] + set i 0 + foreach ln $revlinelist { + if {$ln ne ""} { + set linelist [lreverse [lrange $revlinelist $i end]] + break + } + incr i + } + } + + # --- --- + set start 0 + set end "end" + if {"trimhead1" in $opt_block} { + if {[lindex $linelist 0] eq ""} { + set start 1 + } + } + if {"trimtail1" in $opt_block} { + if {[lindex $linelist end] eq ""} { + set end "end-1" + } + } + set linelist [lrange $linelist $start $end] + } + + if {[llength $opt_commandprefix]} { + set transformed [list] + foreach ln $linelist { + lappend transformed [{*}$opt_commandprefix $ln] + } + set linelist $transformed + } + + return $linelist + } + + #maintenance - take over from punk::args - or put back in punk::args once fixed to support pipeline argument order + #possible improvements - after the 1st call, replace the callsite in the calling proc with an inline script to process and validate the arguments as specified in optionspecs + #This would require a tcl parser .. and probably lots of other work + #It would also probably only be practical if there are no dynamic entries in the optionspecs. An option for opts_values to indicate the caller wants this optimisation would probably be best. + + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values + #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. + #only supports -flag val pairs, not solo options + #If an option is supplied multiple times - only the last value is used. + proc opts_values {args} { + #*** !doctools + #[call [fun opts_values] [opt {option value...}] [arg optionspecs] [arg rawargs] ] + #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values + #[para]Returns a dict of the form: opts values + #[para]ARGUMENTS: + #[list_begin arguments] + #[arg_def multiline-string optionspecs] + #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced + #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values + #[para]Each optionspec line must be of the form: + #[para]-optionname -key val -key2 val2... + #[para]where the valid keys for each option specification are: -default -type -range -choices -optional + #[arg_def list rawargs] + #[para] This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc + #[list_end] + #[para] + + #consider line-processing example below for we need info complete to determine record boundaries + #punk::lib::opt_values { + # -opt1 -default {} + # -opt2 -default { + # etc + # } -multiple 1 + #} $args + + #-- cannot be used to allow opts_values itself to accept rawargs as separate values - so it doesn't serve much purpose other than as an indicator of intention + #For consistency we support it anyway. + #we have to be careful with end-of-options flag -- + #It may legitimately be the only value in the rawargs list (which is a bit odd - but possible) or it may occur immediately before optionspecs and rawargs + #if there is more than one entry in rawargs - we won't find it anyway - so that's ok + set eopts_posn [lsearch $args --] + if {$eopts_posn == ([llength $args]-1)} { + #sole argument in rawargs - not the one we're looking for + set eopts_posn -1 + } + if {$eopts_posn >= 0} { + set ov_opts [lrange $args 0 $eopts_posn-1] + set ov_vals [lrange $args $eopts_posn+1 end] + } else { + set ov_opts [lrange $args 0 end-2] + set ov_vals [lrange $args end-1 end] + } + if {[llength $ov_vals] < 2 || [llength $ov_opts] %2 != 0} { + error "opts_args wrong # args: should be opts_values ?opt val?... optionspecs rawargs_as_list + } + set optionspecs [lindex $ov_vals 0] + set optionspecs [string map [list \r\n \n] $optionspecs] + + set rawargs [lindex $ov_vals 1] + + set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -ARGTYPE] + set optspec_defaults [dict create\ + -optional 1\ + -allow_ansi 1\ + -validate_without_ansi 0\ + -strip_ansi 0\ + -nocase 0\ + ] + set required_opts [list] + set required_vals [list] + set arg_info [dict create] + set defaults_dict_opts [dict create] + set defaults_dict_values [dict create] + #first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end + set value_names [list] + + set records [list] + set linebuild "" + foreach rawline [split $optionspecs \n] { + set recordsofar [string cat $linebuild $rawline] + if {![info complete $recordsofar]} { + append linebuild [string trimleft $rawline] \n + } else { + lappend records [string cat $linebuild $rawline] + set linebuild "" + } + } + + foreach ln $records { + set trimln [string trim $ln] + if {$trimln eq "" || [string index $trimln 0] eq "#"} { + continue + } + set argname [lindex $trimln 0] + set argspecs [lrange $trimln 1 end] + if {[llength $argspecs] %2 != 0} { + error "punk::lib::opts_values - bad optionspecs line for argument '$argname' Remaining items on line must be in paired option-value format - received '$argspecs'" + } + if {[string match -* $argname]} { + dict set argspecs -ARGTYPE option + set is_opt 1 + } else { + dict set argspecs -ARGTYPE value + lappend value_names $argname + set is_opt 0 + } + dict for {spec specval} $argspecs { + if {$spec ni $known_argspecs} { + error "punk::lib::opts_values - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" + } + } + set argspecs [dict merge $optspec_defaults $argspecs] + dict set arg_info $argname $argspecs + if {![dict get $argspecs -optional]} { + if {$is_opt} { + lappend required_opts $argname + } else { + lappend required_vals $argname + } + } + if {[dict exists $arg_info $argname -default]} { + if {$is_opt} { + dict set defaults_dict_opts $argname [dict get $arg_info $argname -default] + } else { + dict set defaults_dict_values $argname [dict get $arg_info $argname -default] + } + } + } + + #puts "--> [info frame -2] <--" + set cmdinfo [dict get [info frame -2] cmd] + #we can't treat cmdinfo as a list - it may be something like {command {*}$args} in which case lindex $cmdinfo 0 won't work + #hopefully first word is a plain proc name if this function was called in the normal manner - directly from a proc + #we will break at first space and assume the lhs of that will give enough info to be reasonable - (alternatively we could use entire cmdinfo - but it might be big and ugly) + set caller [regexp -inline {\S+} $cmdinfo] + + #if called from commandline or some other contexts such as outside of a proc in a namespace - caller may just be "namespace" + if {$caller eq "namespace"} { + set caller "punk::lib::opts_values called from namespace" + } + + # ------------------------------ + if {$caller ne "punk::lib::opts_values"} { + #1) check our caller's call to us - recursive version - perhaps more elegant to eat our own dogfood - but maybe too much overhead for a script-based args processor which is already quite heavy :/ + #lassign [punk::lib::opts_values "-anyopts -default 0 -type integer\n -minvalues -default 0 -type integer\n -maxvalues -default -1 -type integer" $args] _o ownopts _v ownvalues + #if {[dict size $ownvalues] != 2} { + # error "punk::lib::opts_values expected: a multiline text block of option-specifications, a list of args and at most three option pairs -minvalues , -maxvalues , -anyopts true|false - got extra arguments: '$ownvalues'" + #} + #set opt_minvalues [dict get $ownopts -minvalues] + #set opt_maxvalues [dict get $ownopts -maxvalues] + #set opt_anyopts [dict get $ownopts -anyopts] + + #2) Quick and dirty - but we don't need much validation + set defaults [dict create\ + -minvalues 0\ + -maxvalues -1\ + -anyopts 0\ + ] + dict for {k v} $ov_opts { + if {$k ni {-minvalues -maxvalues -anyopts}} { + error "punk::lib::opts_values unrecognised option $k. Known values [dict keys $defaults]" + } + if {![string is integer -strict $v]} { + error "punk::lib::opts_values argument $k must be of type integer" + } + } + set ov_opts [dict merge $defaults $ov_opts] + set opt_minvalues [dict get $ov_opts -minvalues] + set opt_maxvalues [dict get $ov_opts -maxvalues] + set opt_anyopts [dict get $ov_opts -anyopts] + } else { + #don't recurse ie don't check our own args if we called ourself + set opt_minvalues 2 + set opt_maxvalues 2 + set opt_anyopts 0 + } + # ------------------------------ + + if {[set eopts [lsearch $rawargs "--"]] >= 0} { + set values [lrange $rawargs $eopts+1 end] + set arglist [lrange $rawargs 0 $eopts-1] + } else { + if {[lsearch $rawargs -*] >= 0} { + #to support option values with leading dash e.g -offset -1 , we can't just take the last flagindex + set i 0 + foreach {k v} $rawargs { + if {![string match -* $k]} { + break + } + if {$i+1 >= [llength $rawargs]} { + #no value for last flag + error "bad options for $caller. No value supplied for last option $k" + } + incr i 2 + } + set arglist [lrange $rawargs 0 $i-1] + set values [lrange $rawargs $i end] + } else { + set arglist [list] + set values $rawargs ;#no -flags detected + } + } + #confirm any valnames before last don't have -multiple key + foreach valname [lrange $value_names 0 end-1] { + if {[dict exists $arg_info $valname -multiple ]} { + error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" + } + } + set values_dict [dict create] + set validx 0 + set in_multiple "" + foreach valname $value_names val $values { + if {$validx+1 > [llength $values]} { + break + } + if {$valname ne ""} { + if {[dict exists $arg_info $valname -multiple] && [dict get $arg_info $valname -multiple]} { + dict lappend values_dict $valname $val + set in_multiple $valname + } else { + dict set values_dict $valname $val + } + } else { + if {$in_multiple ne ""} { + dict lappend values_dict $in_multiple $val + } else { + dict set values_dict $validx $val + } + } + incr validx + } + + if {$opt_maxvalues == -1} { + #only check min + if {[llength $values] < $opt_minvalues} { + error "bad number of trailing values for $caller. Got [llength $values] values. Expected at least $opt_minvalues" + } + } else { + if {[llength $values] < $opt_minvalues || [llength $values] > $opt_maxvalues} { + if {$opt_minvalues == $opt_maxvalues} { + error "bad number of trailing values for $caller. Got [llength $values] values. Expected exactly $opt_minvalues" + } else { + error "bad number of trailing values for $caller. Got [llength $values] values. Expected between $opt_minvalues and $opt_maxvalues inclusive" + } + } + } + #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) + #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call + #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW + #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. + #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level + #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true + set argnamespresent [dict keys $arglist] + foreach r $required_opts { + if {$r ni $argspresent} { + error "Required option missing for $caller. '$r' is marked with -optional false - so must be present in its full-length form" + } + } + set valuenamespresent [dict keys $values_dict] + foreach r $required_vals { + if {$r ni $valuenamespresent} { + error "Required value missing for $caller. '$r' is marked with -optional false - so must be present" + } + } + if {!$opt_anyopts} { + set checked_args [dict create] + for {set i 0} {$i < [llength $arglist]} {incr i} { + #allow this to error out with message indicating expected flags + set val [lindex $arglist $i+1] + set fullopt [tcl::prefix match -message "options for $caller. Unexpected option" [dict keys $arg_info] [lindex $arglist $i]] + if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { + dict lappend checked_args $fullopt $val + } else { + dict set checked_args $fullopt $val + } + incr i ;#skip val + } + } else { + #still need to use tcl::prefix match to normalize - but don't raise an error + set checked_args [dict create] + dict for {k v} $arglist { + if {![catch {tcl::prefix::match [dict keys $arg_info] $k} fullopt]} { + if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { + dict lappend checked_args $fullopt $v + } else { + dict set checked_args $fullopt $v + } + } else { + #opt was unspecified + dict set checked_args $k $v + } + } + } + set opts [dict merge $defaults_dict_opts $checked_args] + #assert - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options + + set values [dict merge $defaults_dict_values $values_dict] + + #todo - allow defaults outside of choices/ranges + + #check types,ranges,choices + set opts_and_values [concat $opts $values] + set combined_defaults [concat $defaults_dict_values $defaults_dict_opts] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash + dict for {o v} $opts_and_values { + if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { + set vlist $v + } else { + set vlist [list $v] + } + + if {[dict exists $arg_info $o -validate_without_ansi] && [dict get $arg_info $o -validate_without_ansi]} { + set validate_without_ansi 1 + package require punk::ansi + } else { + set validate_without_ansi 0 + } + if {[dict exists $arg_info $o -allow_ansi] && [dict get $arg_info $o -allow_ansi]} { + set allow_ansi 1 + } else { + #ironically - we need punk::ansi to detect and disallow - but we don't need it if ansi is allowed + package require punk::ansi + set allow_ansi 0 + } + if {!$allow_ansi} { + foreach e $vlist { + if {[punk::ansi::ta::detect $e]} { + error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'" + } + } + } + + set vlist_check [list] + foreach e $vlist { + if {$validate_without_ansi} { + lappend vlist_check [punk::ansi::stripansi $e] + } else { + lappend vlist_check $e + } + } + + set is_default 0 + foreach e $vlist e_check $vlist_check { + if {[dict exists $combined_defaults $o] && ($e_check eq [dict get $combined_defaults $o])} { + incr is_default + } + } + if {$is_default eq [llength $vlist]} { + set is_default true + } + #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value + #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. + if {!$is_default} { + if {[dict exists $arg_info $o -type]} { + set type [dict get $arg_info $o -type] + if {[string tolower $type] in {int integer double}} { + if {[string tolower $type] in {int integer}} { + foreach e $vlist e_check $vlist_check { + if {![string is integer -strict $e_check]} { + error "Option $o for $caller requires type 'integer'. Received: '$e'" + } + } + } elseif {[string tolower $type] in {double}} { + foreach e $vlist e_check $vlist_check { + if {![string is double -strict $e_check]} { + error "Option $o for $caller requires type 'double'. Received: '$e'" + } + } + } + + #todo - small-value double comparisons with error-margin? review + if {[dict exists $arg_info $o -range]} { + lassign [dict get $arg_info $o -range] low high + foreach e $vlist e_check $vlist_check { + if {$e_check < $low || $e_check > $high} { + error "Option $o for $caller must be between $low and $high. Received: '$e'" + } + } + } + } elseif {[string tolower $type] in {bool boolean}} { + foreach e $vlist e_check $vlist_check { + if {![string is boolean -strict $e_check]} { + error "Option $o for $caller requires type 'boolean'. Received: '$e'" + } + } + } elseif {[string tolower $type] in {alnum alpha ascii control digit graph lower print punct space upper wordchar xdigit}} { + foreach e $vlist e_check $vlist_check { + if {![string is [string tolower $type] $e_check]} { + error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e'" + } + } + } elseif {[string tolower $type] in {file directory existingfile existingdirectory}} { + foreach e $vlist e_check $vlist_check { + if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { + error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which doesn't look like it could be a file or directory" + } + } + if {[string tolower $type] in {existingfile}} { + foreach e $vlist e_check $vlist_check { + if {![file exists $e_check]} { + error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing file" + } + } + } elseif {[string tolower $type] in {existingdirectory}} { + foreach e $vlist e_check $vlist_check { + if {![file isdirectory $e_check]} { + error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing directory" + } + } + } + } elseif {[string tolower $type] in {char character}} { + foreach e $vlist e_check $vlist_check { + if {[string length != 1]} { + error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not a single character" + } + } + } + } + if {[dict exists $arg_info $o -choices]} { + set choices [dict get $arg_info $o -choices] + set nocase [dict get $arg_info $o -nocase] + foreach e $vlist e_check $vlist_check { + if {$nocase} { + set casemsg "(case insensitive)" + set choices_test [string tolower $choices] + set v_test [string tolower $e_check] + } else { + set casemsg "(case sensitive)" + set v_test $e_check + set choices_test $choices + } + if {$v_test ni $choices_test} { + error "Option $o for $caller must be one of the listed values $choices $casemsg. Received: '$e'" + } + } + } + } + if {[dict exists $arg_info $o -strip_ansi] && [dict get $arg_info $o -strip_ansi]} { + set stripped_list [list] + foreach e $vlist { + lappend stripped_list [punk::ansi::stripansi $e] + } + if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { + if {[dict get $arg_info $o -ARGTYPE] eq "option"} { + dict set opts $o $stripped_list + } else { + dict set values $o $stripped_list + } + } else { + if {[dict get $arg_info $o -ARGTYPE] eq "option"} { + dict set opts $o [lindex $stripped_list 0] + } else { + dict set values [lindex $stripped_list 0] + } + } + } + } + + #maintain order of opts $opts values $values as caller may use lassign. + return [dict create opts $opts values $values] + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib ---}] } diff --git a/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/bootsupport/modules/punk/ns-0.1.0.tm index c9bbc3d3..54b6a58c 100644 --- a/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -17,6 +17,7 @@ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz +package require punk::lib package require punk::args namespace eval ::punk_dynamic::ns { @@ -972,8 +973,8 @@ namespace eval punk::ns { #nscommands returns exactly one line per entry + a trailing newline. If there is an empty line other than at the end - that is because there is a command named as the empty string. # By default 'linelist' trims 1st and last empty line. Turn off all block trimming with -block {} - #set commands [.= nscommands -raw [nsjoin $ch $glob] |> linelist -block {}] - set commands [linelist -block {} [nscommands -raw [nsjoin $ch $glob]]] + #set commands [.= nscommands -raw [nsjoin $ch $glob] |> punk::lib::linelist -block {}] + set commands [punk::lib::linelist -block {} [nscommands -raw [nsjoin $ch $glob]]] #by convention - returning just \n represents a single result of the empty string whereas no results #after passing through linelist this becomes {} {} which appears as a list of two empty strings. diff --git a/src/modules/shellfilter-0.1.8.tm b/src/modules/shellfilter-0.1.9.tm similarity index 100% rename from src/modules/shellfilter-0.1.8.tm rename to src/modules/shellfilter-0.1.9.tm diff --git a/src/modules/shellrun-0.1.tm b/src/modules/shellrun-0.1.1.tm similarity index 100% rename from src/modules/shellrun-0.1.tm rename to src/modules/shellrun-0.1.1.tm diff --git a/src/modules/shellthread-1.6.tm b/src/modules/shellthread-1.6.1.tm similarity index 100% rename from src/modules/shellthread-1.6.tm rename to src/modules/shellthread-1.6.1.tm