From 2e739339b2711d2146c790f0b5010c60c2d5685e Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 2 Feb 2024 14:26:44 +1100 Subject: [PATCH] ansi work --- src/doc/punk/_module_ansi-0.1.0.tm.man | 17 + src/modules/patternpunk-1.1.tm | 14 +- src/modules/punk-0.1.tm | 374 ++---------- src/modules/punk/ansi-999999.0a1.0.tm | 55 +- src/modules/punk/console-999999.0a1.0.tm | 8 +- src/modules/punk/lib-999999.0a1.0.tm | 696 +++++++++++++++++++++++ src/modules/punk/ns-999999.0a1.0.tm | 5 +- src/modules/punk/repl-0.1.tm | 19 +- src/modules/textblock-999999.0a1.0.tm | 72 ++- 9 files changed, 886 insertions(+), 374 deletions(-) diff --git a/src/doc/punk/_module_ansi-0.1.0.tm.man b/src/doc/punk/_module_ansi-0.1.0.tm.man index 49951ec3..5576f902 100644 --- a/src/doc/punk/_module_ansi-0.1.0.tm.man +++ b/src/doc/punk/_module_ansi-0.1.0.tm.man @@ -123,5 +123,22 @@ [subsection {Namespace punk::ansi::ansistring}] [para]punk::ansi::string ensemble [list_begin definitions] +[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]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 [list_end] [comment {--- end definitions namespace punk::ansi::ta ---}] [manpage_end] diff --git a/src/modules/patternpunk-1.1.tm b/src/modules/patternpunk-1.1.tm index a265858a..b07872ff 100644 --- a/src/modules/patternpunk-1.1.tm +++ b/src/modules/patternpunk-1.1.tm @@ -61,9 +61,19 @@ set ::punk::bannerTemplate [string trim { >punk .. Property logo [>punk . banner] ->punk .. Property versionLogo [>punk . banner -left " Ver" -right "$::punk::version "] ->punk .. Property version $::punk::version +>punk .. Method versionLogo {} { + set this @this@ + >punk . banner -left " Ver" -right "[$this . version] " +} +>punk .. Method version {} { + if {[package provide punk] ne ""} { + set version $::punk::version + } else { + set version "N/A" + } + return $version +} >punk .. Property front [string trim { _|_ @ v @ diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 9ae10ec9..09a03e1f 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -75,8 +75,10 @@ set punk_testd [dict create \ namespace eval ::repl { variable running 0 } +package require punk::lib package require punk::config package require punk::ansi +namespace import punk::ansi::ansistring package require punk::console package require punk::ns package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems @@ -6155,15 +6157,16 @@ namespace eval punk { } return $result } - proc list_as_lines {args} { - set defaults [dict create\ - -joinchar "\n"\ - ] - lassign [dict values [get_leading_opts_and_values $defaults $args -minvalues 1 -maxvalues 1]] opts values - set opt_joinchar [dict get $opts -joinchar] - set list [lindex $values 0] - join $list $opt_joinchar - } + + #proc list_as_lines {args} { + # set defaults [dict create\ + # -joinchar "\n"\ + # ] + # lassign [dict values [get_leading_opts_and_values $defaults $args -minvalues 1 -maxvalues 1]] opts values + # set opt_joinchar [dict get $opts -joinchar] + # set list [lindex $values 0] + # join $list $opt_joinchar + #} #-------------------------------------------------- #some haskell-like operations @@ -6476,170 +6479,7 @@ namespace eval punk { return $linelist } - # 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} { - 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\ - ] - foreach {o v} $arglist { - if {$o ni [dict keys $defaults]} { - 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 - } - proc lines_as_list {args} { - set defaults [dict create\ - -block {}\ - ] - #pass -anyopts 1 so we can let the next function decide what arguments are valid - but still pass our defaults - lassign [dict values [get_leading_opts_and_values $defaults $args -anyopts 1]] opts values ;#implicit merge of opts over defaults - tailcall linelist {*}$opts {*}$values - } #An implementation of a notoriously controversial metric. proc LOC {args} { set defaults [dict create\ @@ -6710,142 +6550,7 @@ namespace eval punk { return [list loc $loc filecount [llength $filepaths] dupfiles $dupfilecount dupfileloc $dupfileloc extensions $extensions] } - # 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 linelistXXX {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 ""\ - ] - foreach {o v} $arglist { - if {$o ni [dict keys $defaults]} { - 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 {"collateempty" in $opt_block || "triminner" in $opt_block || "trimall" in $opt_block || "trimtail" in $opt_block} { - error "linelist -block collateempty, triminner, trimall, trimtail 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] - if {[string first \n $text] < 0} { - return $text - } - 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] - } - } - } - set start 0 - set end "end" - if {"trimhead1" in $opt_block} { - if {[lindex $linelist 0] eq ""} { - set start 1 - } - } - 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}] - } - } - if {"trimtail1" in $opt_block} { - if {[lindex $linelist end] eq ""} { - set end "end-1" - } - } - - set block_trimmed_list [lrange $linelist $start $end] - - set resultlist $block_trimmed_list - if {[llength $opt_commandprefix]} { - set transformed [list] - foreach ln $block_trimmed_list { - lappend transformed [{*}$opt_commandprefix $ln] - } - set resultlist $transformed - } - - return $resultlist - } - - #e.g linesort -decreasing $data - proc linesort {args} { - if {[llength $args] < 1} { - error "linesort missing lines argument" - } - set lines [lindex $args end] - set opts [lrange $args 0 end-1] - if {[llength $opts] % 2 != 0} { - error "linesort options must come in pairs" - } - .= list $lines |@0,sortopts/1> linelist |> .=data>1,sortopts>1* lsort |> list_as_lines <| {*}$opts - } #!!!todo fix - linedict is unfinished and non-functioning #linedict based on indents @@ -7147,35 +6852,37 @@ namespace eval punk { append text " [overtype::left $col1 $c][overtype::left $col2 $d]" \n } + set warningblock "" - if 0 { - set indent " " - set sep " " - if {[catch { - package require textblock - set introblock [textblock::join\ - [textblock::join\ - [textblock::join\ - $indent\ - $mascotblock\ - ]\ - $sep\ - ]\ - $text\ - ] - }] } { - set introblock $text - } + if {[catch {package require textblock} errM]} { + set introblock $mascotblock + append introblock \n $text + append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" + + } else { + set introblock [textblock::join " " $mascotblock " " $text] } - package require textblock - set introblock [textblock::join " " $mascotblock " " $text] #set introblock $text - if {[punkrepl::has_script_var_bug]} { - append introblock \n "minor warning: punkrepl::has_script_var_bug returned true! (string rep for list variable in script generated when script changed)" + if {[punk::repl::has_script_var_bug]} { + append warningblock \n "minor warning: punk::repl::has_script_var_bug returned true! (string rep for list variable in script generated when script changed)" + } + + set hidden_width_pm [punk::console::test_char_width [punk::ansi::controlstring_PM "hidden"]] + if {$hidden_width_pm != 0} { + append warningblock \n "WARNING: terminal doesn't hide PM 'privacy message' (ESC ^) control strings" + } + set hidden_width_sos [punk::console::test_char_width [punk::ansi::controlstring_SOS "hidden"]] + if {$hidden_width_sos != 0} { + append warningblock \n "WARNING: terminal doesn't hide SOS 'start of string' (ESC X) control strings" + } + set hidden_width_apc [punk::console::test_char_width [punk::ansi::controlstring_APC "hidden"]] + if {$hidden_width_apc != 0} { + append warningblock \n "WARNING: terminal doesn't hide APC 'application program command' (ESC _) control strings" } lappend chunks [list stdout $introblock] + lappend chunks [list stderr $warningblock] return $chunks } @@ -7190,7 +6897,7 @@ namespace eval punk { #NOTE: an alias may match in a namespace - but not have a corresponding command that matches that name (alias renamed) proc aliases {{glob *}} { - set ns [uplevel 1 {::namespace current}] ;#must use :: - we can find ourselves in a namespace with a differen 'namespace' command + set ns [uplevel 1 {::namespace current}] ;#must use :: - we can find ourselves in a namespace with a different 'namespace' command set ns_mapped [string map [list :: \uFFFF] $ns] #puts stderr "aliases ns: $ns_mapped" set segments [split $ns_mapped \uFFFF] ;#include empty string before leading :: @@ -7368,14 +7075,15 @@ namespace eval punk { #---------------------------------------------- interp alias {} linelistraw {} punk::linelistraw interp alias {} linelist {} punk::linelist ;#critical for = assignment features - interp alias {} linesort {} punk::linesort + interp alias {} linesort {} punk::lib::linesort # 'path' collides with kettle path in kettle::doc function - todo - patch kettle? interp alias {} PATH {} punk::path interp alias {} path_list {} punk::path_list - interp alias {} list_as_lines {} punk::list_as_lines - interp alias {} lines_as_list {} punk::lines_as_list + #interp alias {} list_as_lines {} punk::list_as_lines + interp alias {} list_as_lines {} punk::lib::list_as_lines + interp alias {} lines_as_list {} punk::lib::lines_as_list interp alias {} list_filter_cond {} punk::list_filter_cond interp alias {} is_list_all_in_list {} punk::is_list_all_in_list interp alias {} is_list_all_ni_list {} punk::is_list_all_ni_list diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index aec4ee4f..507b2830 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.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_*\ @@ -123,11 +124,41 @@ 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_SOS {text} { + return "\x1bX${text}\033\\" + } + proc controlstring_APC {text} { + return "\x1b_${text}\033\\" + } + #candidate for zig/c implementation? proc stripansi {text} { #*** !doctools @@ -705,7 +736,7 @@ 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 @@ -727,6 +758,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} { @@ -958,18 +992,31 @@ 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 trim trimleft trimright index + 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 + proc VIEW {string} { + return [string map [list \033 \uFFFD] $string] + } + proc length {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 diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 8a6377cc..91da0e00 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.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/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index a747e7fb..1779f161 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.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/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index eaca7511..b03e5d92 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.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/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index fcccbc97..842390a0 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -71,7 +71,7 @@ namespace eval repl { variable signal_control_c 0 } -namespace eval punkrepl { +namespace eval punk::repl { variable debug_repl 0 proc has_script_var_bug {} { @@ -248,6 +248,9 @@ interp alias {} rmcup {} ::repl::term::screen_pop_alt # args - A list whose elements are the words of the original # command, including the command name. +#review - we shouldn't really be doing this +#We need to work out if we can live with the real default unknown and just inject some special cases at the beginning before falling-back to the normal one + proc ::unknown args { #puts stderr "unk>$args" variable ::tcl::UnknownPending @@ -1032,13 +1035,13 @@ proc repl::repl_handler {inputchan prompt_config} { lassign $wordparts cmd_firstword cmd_secondword if {$cmd_firstword eq "debugrepl"} { if {[string is integer -strict $cmd_secondword]} { - incr ::punkrepl::debug_repl $cmd_secondword + incr ::punk::repl::debug_repl $cmd_secondword } else { - incr ::punkrepl::debug_repl + incr ::punk::repl::debug_repl } - set commandstr "set ::punkrepl::debug_repl" + set commandstr "set ::punk::repl::debug_repl" } - if {$::punkrepl::debug_repl > 0} { + if {$::punk::repl::debug_repl > 0} { proc debug_repl_emit {msg} [string map [list %p% [list $debugprompt]] { set p %p% #don't auto-append \n even if missing. @@ -1141,7 +1144,7 @@ proc repl::repl_handler {inputchan prompt_config} { #----------------------------------------- #list/string-rep bug workaround part 2 - #todo - set flag based on punkrepl::has_script_var_bug + #todo - set flag based on punk::repl::has_script_var_bug lappend run_command_cache $run_command_string #puts stderr "run_command_string rep: [rep $run_command_string]" if {[llength $run_command_cache] > 2000} { @@ -1354,8 +1357,8 @@ proc repl::repl_handler {inputchan prompt_config} { } #catch {puts stderr "zz1--->[rep $::arglej]"} #puts stderr "??? $commandstr" - if {$::punkrepl::debug_repl > 0} { - incr ::punkrepl::debug_repl -1 + if {$::punk::repl::debug_repl > 0} { + incr ::punk::repl::debug_repl -1 } set commandstr "" #catch {puts stderr "zz2---->[rep $::arglej]"} diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 19eec9e5..6adb152b 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -17,9 +17,10 @@ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz -package require punk +#package require punk package require punk::args package require punk::char +package require punk::lib package require patternpunk package require overtype package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? @@ -69,17 +70,40 @@ namespace eval textblock { } } - proc width {block} { - if {$block eq ""} { + proc width {textblock} { + if {$textblock eq ""} { return 0 } - set block [textutil::tabify::untabify2 $block] - if {[string first \n $block] >= 0} { - return [tcl::mathfunc::max {*}[lmap v [lines_as_list -- $block] {::punk::char::string_width [stripansi $v]}]] + set textblock [textutil::tabify::untabify2 $textblock] + if {[string first \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width [stripansi $v]}]] } - return [punk::char::string_width [stripansi $block]] + return [punk::char::string_width [stripansi $textblock]] + } + proc height {textblock} { + #empty string still has height 1 (at least for left-right/right-left languages) + set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list + return [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le } + #MAINTENANCE - same as overtype::blocksize? + proc size {textblock} { + if {$textblock eq ""} { + return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings + } + set textblock [textutil::tabify::untabify2 $textblock] + #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests + set textblock [punk::ansi::stripansi $textblock] + if {[string first \n $textblock] >= 0} { + set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]] + } else { + set width [punk::char::string_width $textblock] + } + set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list + #our concept of block-height is likely to be different to other line-counting mechanisms + set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le + return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize ]] width height + } #must be able to handle block as string with or without newlines #if no newlines - attempt to treat as a list #must handle whitespace-only string,list elements, and/or lines. @@ -90,7 +114,7 @@ namespace eval textblock { } set block [textutil::tabify::untabify2 $block] if {[string first \n $block] >= 0} { - return [tcl::mathfunc::max {*}[lmap v [lines_as_list -- $block] {::punk::char::string_width [stripansi $v]}]] + return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $block] {::punk::char::string_width [stripansi $v]}]] } if {[catch {llength $block}]} { return [::punk::char::string_width [stripansi $block]] @@ -101,8 +125,8 @@ namespace eval textblock { } return [tcl::mathfunc::max {*}[lmap v $block {::punk::char::string_width [stripansi $v]}]] } - pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> list_as_lines -- lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> list_as_lines -- punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- } lines_as_list -- {| + >} punk::lib::lines_as_list -- {| data2 - >} .=lhs> lines_as_list -- {| + >} .=lhs> punk::lib::lines_as_list -- {| >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {| - >} list_as_lines -- } punk::lib::list_as_lines -- } .=> lines_as_list -- {| + >} .=> punk::lib::lines_as_list -- {| data2 - >} .=lhs> lines_as_list -- {| + >} .=lhs> punk::lib::lines_as_list -- {| >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {| - >} list_as_lines -- } punk::lib::list_as_lines -- } .=> lines_as_list -- {| + >} .=> punk::lib::lines_as_list -- {| data2 - >} .=lhs> lines_as_list -- {| + >} .=lhs> punk::lib::lines_as_list -- {| >} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {| - >} list_as_lines } punk::lib::list_as_lines punk . lhs] |> .=>1 textblock::join " " |> .=>1 textblock::join $text |> .=>1 textblock::join [>punk . rhs] |> .=>1 textblock::join [punk::list_as_lines -- [lrepeat 7 " | "]] + .= textblock::join [punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7]] [>punk . lhs] |> .=>1 textblock::join " " |> .=>1 textblock::join $text |> .=>1 textblock::join [>punk . rhs] |> .=>1 textblock::join [punk::lib::list_as_lines -- [lrepeat 7 " | "]] } proc example2 {{text "test\netc\nmore text"}} { package require patternpunk .= textblock::join\ - [punk::list_as_lines -- [list 1 2 3 4 5 6 7 8]]\ + [punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7 8]]\ [>punk . lhs]\ " "\ $text\ [>punk . rhs]\ - [punk::list_as_lines -- [lrepeat 8 " | "]] + [punk::lib::list_as_lines -- [lrepeat 8 " | "]] } proc frame {args} {