Browse Source

ansi work

master
Julian Noble 9 months ago
parent
commit
2e739339b2
  1. 17
      src/doc/punk/_module_ansi-0.1.0.tm.man
  2. 14
      src/modules/patternpunk-1.1.tm
  3. 374
      src/modules/punk-0.1.tm
  4. 55
      src/modules/punk/ansi-999999.0a1.0.tm
  5. 8
      src/modules/punk/console-999999.0a1.0.tm
  6. 696
      src/modules/punk/lib-999999.0a1.0.tm
  7. 5
      src/modules/punk/ns-999999.0a1.0.tm
  8. 19
      src/modules/punk/repl-0.1.tm
  9. 72
      src/modules/textblock-999999.0a1.0.tm

17
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-+<int> 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]

14
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 @

374
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 <cmdlist> 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 <cmdlist> 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

55
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
#<excerpt>
#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)
#</excerpt>
#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

8
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} {

696
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 <le>
#[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 <char>? <linelist>"
}
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 <cmdlist> 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 <options_dict> values <values_dict>
#[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 <int>, -maxvalues <int>, -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 ---}]
}

5
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.

19
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]"}

72
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 <data>]] 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 -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> list_as_lines -- <input/0,colsize/1|
pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
proc ::textblock::pad {block args} {
set defaults [dict set\
-padchar " "\
@ -142,20 +166,20 @@ namespace eval textblock {
pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
/2,col1/1,col2/3
>} 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 -- <lhs/0,w1/1,rhs/2,w2/3|
>} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3
>} .=> 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 -- <lhs/0,rhs/1|
>} punk::lib::list_as_lines -- <lhs/0,rhs/1|
proc ::textblock::join {args} {
lassign [punk::args::opts_values {
@ -167,7 +191,7 @@ namespace eval textblock {
set fordata [list]
foreach b $blocks {
set c($idx) [string repeat " " [width $b]]
lappend fordata "v($idx)" [lines_as_list -- $b]
lappend fordata "v($idx)" [punk::lib::lines_as_list -- $b]
incr idx
}
set outlines [list]
@ -178,7 +202,7 @@ namespace eval textblock {
}
lappend outlines $row
}
return [list_as_lines -- $outlines]
return [punk::lib::list_as_lines -- $outlines]
}
proc ::textblock::trim {block} {
@ -187,25 +211,25 @@ namespace eval textblock {
pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3
>} .=> 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 <lhs/0,rhs/1|
>} punk::lib::list_as_lines <lhs/0,rhs/1|
proc example {{text "test\netc\nmore text"}} {
package require patternpunk
.= textblock::join [punk::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::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} {

Loading…
Cancel
Save