#impolitely cooperative withe punk repl - todo - tone it down.
#impolitely cooperative withe punk repl - todo - tone it down.
@ -727,6 +728,7 @@ namespace eval punk {
set already_assigned 0
set already_assigned 0
set do_bounds_check 0 ;#modified by leading single @ for list operations - doesn't apply to certain items like 'head','tail' which have specifically defined bounds-checks implicit in their normal meaning.
set do_bounds_check 0 ;#modified by leading single @ for list operations - doesn't apply to certain items like 'head','tail' which have specifically defined bounds-checks implicit in their normal meaning.
#thse have anyhead and anytail for explicit allowance to be used on lists with insufficient items to produce values.
#thse have anyhead and anytail for explicit allowance to be used on lists with insufficient items to produce values.
#todo - see if 'string is list' improved in tcl9 vs catch {llength $list}
switch -- $index {
switch -- $index {
# {
# {
set active_key_type "list"
set active_key_type "list"
@ -7024,53 +7026,6 @@ namespace eval punk {
return $lines
return $lines
}
}
proc pdict {d {pattern *}} { ;# analogous to parray (except that it takes the dict as a value)
set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end]
set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end]
set chunkdisplay_block [join $chunkdisplay_tail \n]
set chunkdisplay_block [join $chunkdisplay_tail \n]
#the input chunk lines are often much longer than the output.. resulting in main content being way up the screen. It's often impractical to view more than the tail of the chunkdisplay.
#the input chunk lines are often much longer than the output.. resulting in main content being way up the screen. It's often impractical to view more than the tail of the chunkdisplay.
append out [tcl::string::map $map_special_graphics $inner_plaintext] $inner_codes
lappend out [tcl::string::map $map_special_graphics $inner_plaintext] $inner_codes
#Simplifying assumption: no mapping required on any inner_codes - ST codes, titlesets etc don't require/use g0 content
#Simplifying assumption: no mapping required on any inner_codes - ST codes, titlesets etc don't require/use g0 content
}
}
} else {
} else {
append out $other ;#may be a mix of plaintext and other ansi codes - put it all through.
lappend out $other ;#may be a mix of plaintext and other ansi codes - put it all through.
}
}
#trust our splitting regex has done the work to leave us with only \x1b\(0 or \x1b(B - test last char rather than use punk::ansi::codetype::is_gx_open/is_gx_close
#trust our splitting regex has done the work to leave us with only \x1b\(0 or \x1b(B - test last char rather than use punk::ansi::codetype::is_gx_open/is_gx_close
#note - micro optimisation of inlining <re> gives us *almost* nothing extra.
#note - micro optimisation of inlining <re> gives us *almost* nothing extra.
#left in place for detect as it's a common call that should be made as fast as possible as it's used to avoid more expensive operations such as split_...
#left in place for a few such as detect/detect_g0 as we want them as fast as possible
# in general the technique doesn't seem worthwhile for this set of functions.
# in general the technique doesn't seem particularly worthwhile for this set of functions.
#the performance is dominated by the complexity of the regexp
#the performance is dominated by the complexity of the regexp
#it is faster to split this function out than to inline it into split_at_codes in tcl 8.7 - something to do with the use of the variable vs argument for the regexp
#literal inlining of the re in the main proc-body was slower too - but inlining it into the wrapper seems to work (a tiny bit)
#the difference is not often apparent when comparing timerate results from split_at_codes vs split_at_codes2 -
# - but in aggregate for something like textblock::periodic - we can get a bit over 5% faster (e.g 136ms vs 149ms)
proc Do_split_at_codes {str regexp} {
if {$str eq ""} {
return {}
}
#no infinite loop check on regexp like splitx does because we should have tested re_ansi_split during development
set list {}
set start 0
while {[regexp -start $start -indices -- $regexp $str match submatch]} {
lassign $submatch subStart subEnd
lassign $match matchStart matchEnd
incr matchStart -1
incr matchEnd
lappend list [tcl::string::range $str $start $matchStart]
if {$subStart >= $start} {
lappend list [tcl::string::range $str $subStart $subEnd]
}
set start $matchEnd
}
lappend list [tcl::string::range $str $start end]
return $list
}
proc Do_split_at_codes_join {str regexp} {
if {$str eq ""} {
return {}
}
#no infinite loop check on regexp like splitx does because we should have tested re_ansi_split during development
set list {}
set start 0
while {[regexp -start $start -indices -- $regexp $str match submatch]} {
lassign $submatch subStart subEnd
lassign $match matchStart matchEnd
incr matchStart -1
incr matchEnd
lappend list [tcl::string::range $str $start $matchStart]
if {$subStart >= $start} {
lappend list [tcl::string::range $str $subStart $subEnd]
#[para]Return a string with ansi codes stripped out
#[para]Alternate graphics modes will be stripped rather than converted to unicode - exposing the raw ascii characters as they appear without graphics mode.
#[para]ie instead of a horizontal line you may see: qqqqqq
#add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it.
#Also,we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;)
#generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values
#generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values
#set row [.= val $charblock {*}[lrepeat [expr {$blockwidth -1}] |> piper_blockjoin $charblock]] ;#building a repeated "|> command arg" list to evaluate as a pipeline. (from before textblock::join could take arbitrary num of blocks )
#set row [.= val $charblock {*}[lrepeat [expr {$blockwidth -1}] |> piper_blockjoin $charblock]] ;#building a repeated "|> command arg" list to evaluate as a pipeline. (from before textblock::join could take arbitrary num of blocks )
set row [textblock::join {*}[lrepeat $blockwidth $charblock]]
set row [textblock::join_basic -- {*}[lrepeat $blockwidth $charblock]]
#join without regard to each line length in a block (no padding added to make each block uniform)
proc ::textblock::join_basic {args} {
#*proc -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width.
# Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner
#"
set argd [punk::args::get_dict {
-ansiresets -type any -default auto
blocks -type any -multiple 1
} $args]
set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected)
# -- is a legimate block
#this makes for a somewhat messy api.. -- is required if first block is actually -- (or the very unlikely case the first block is intended to be -ansiresets)
