Browse Source

punk::args add -defaultdisplaytype dict|list; punk::pdf improvements

master
Julian Noble 5 months ago
parent
commit
2dd24a7ba9
  1. 5
      src/bootsupport/modules/flagfilter-0.3.tm
  2. 16
      src/bootsupport/modules/punk-0.1.tm
  3. 237
      src/bootsupport/modules/punk/ansi-0.1.1.tm
  4. 39
      src/bootsupport/modules/punk/args-0.2.tm
  5. 101
      src/bootsupport/modules/punk/char-0.1.0.tm
  6. 1
      src/bootsupport/modules/punk/console-0.1.1.tm
  7. 126
      src/bootsupport/modules/punk/lib-0.1.2.tm
  8. 16
      src/bootsupport/modules/punk/ns-0.1.0.tm
  9. 40
      src/bootsupport/modules/shellfilter-0.2.tm
  10. 28
      src/bootsupport/modules/textblock-0.1.3.tm
  11. 39
      src/modules/punk/args-999999.0a1.0.tm
  12. 799
      src/modules/punk/pdf-999999.0a1.0.tm
  13. 2
      src/project_layouts/custom/_project/punk.basic/src/make.tcl
  14. 5
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/flagfilter-0.3.tm
  15. 16
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm
  16. 237
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
  17. 39
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.tm
  18. 101
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/char-0.1.0.tm
  19. 1
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
  20. 126
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm
  21. 16
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
  22. 40
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.2.tm
  23. 28
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  24. 2
      src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl
  25. 5
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/flagfilter-0.3.tm
  26. 16
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm
  27. 237
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
  28. 39
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.tm
  29. 101
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/char-0.1.0.tm
  30. 1
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
  31. 126
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm
  32. 16
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
  33. 40
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.2.tm
  34. 28
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  35. 2
      src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl
  36. 39
      src/vfs/_vfscommon.vfs/modules/punk/args-0.2.tm
  37. 799
      src/vfs/_vfscommon.vfs/modules/punk/pdf-0.1.0.tm

5
src/bootsupport/modules/flagfilter-0.3.tm

@ -1538,6 +1538,7 @@ namespace eval flagfilter {
} }
} }
#todo - rename 'cprocessor' is misleading
oo::class create cprocessor { oo::class create cprocessor {
variable o_runid variable o_runid
variable o_name variable o_name
@ -1577,7 +1578,9 @@ namespace eval flagfilter {
if {[dict exists $o_pinfo match]} { if {[dict exists $o_pinfo match]} {
set o_matchspec [dict get $o_pinfo match] set o_matchspec [dict get $o_pinfo match]
} else { } else {
set o_matchspec {^[^-^/].*} ;#match anything that isn't flaglike #review - unix paths? conflict with windows style flag such as /w
#must accept empty string
set o_matchspec {^[^-^/].*|^$} ;#match anything that isn't flaglike
} }
set o_found_match 0 set o_found_match 0
set o_matched_argument "" ;#need o_found_match to differentiate match of empty string set o_matched_argument "" ;#need o_found_match to differentiate match of empty string

16
src/bootsupport/modules/punk-0.1.tm

@ -6947,7 +6947,8 @@ namespace eval punk {
set newrow {} set newrow {}
foreach oldrow $list_rows { foreach oldrow $list_rows {
if {$j >= [llength $oldrow]} { if {$j >= [llength $oldrow]} {
continue #continue
lappend newrow ""
} else { } else {
lappend newrow [lindex $oldrow $j] lappend newrow [lindex $oldrow $j]
} }
@ -6956,6 +6957,19 @@ namespace eval punk {
} }
return $res return $res
} }
proc transpose_equal_lists {list_rows} {
set columns [list]
set rowidx -1
foreach l $list_rows {
set colidx -1
incr rowidx
foreach val $l {
incr colidx
lset columns $colidx $rowidx $val
}
}
return $columns
}
proc transpose_strings {list_of_strings} { proc transpose_strings {list_of_strings} {
set charlists [lmap v $list_of_strings {split $v ""}] set charlists [lmap v $list_of_strings {split $v ""}]
set tchars [transpose_lists $charlists] set tchars [transpose_lists $charlists]

237
src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -3785,7 +3785,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set codestack [list] set codestack [list]
if {[punk::ansi::ta::detect $text]} { if {[punk::ansi::ta::detectcode $text]} {
set emit "" set emit ""
#set parts [punk::ansi::ta::split_codes $text] #set parts [punk::ansi::ta::split_codes $text]
set parts [punk::ansi::ta::split_codes_single $text] set parts [punk::ansi::ta::split_codes_single $text]
@ -3892,7 +3892,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set codestack [list] set codestack [list]
if {[punk::ansi::ta::detect $text]} { if {[punk::ansi::ta::detectcode $text]} {
set emit "" set emit ""
#set parts [punk::ansi::ta::split_codes $text] #set parts [punk::ansi::ta::split_codes $text]
set parts [punk::ansi::ta::split_codes_single $text] set parts [punk::ansi::ta::split_codes_single $text]
@ -4158,7 +4158,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# where line and column are ascii codes whose values are +31 # where line and column are ascii codes whose values are +31
# vt52 can be entered/exited via escapes # vt52 can be entered/exited via escapes
# This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type
# (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) # (vt52 supports ESC Z (obs DECID) - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ )
#ESC\[c - is more modern equiv of DECID
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::ansi::vt52move @id -id ::punk::ansi::vt52move
@ -4946,6 +4947,8 @@ to 223 (=255 - 32)
} }
if {[string length $text] < 2} {return $text} if {[string length $text] < 2} {return $text}
set parts [punk::ansi::ta::split_codes $text] set parts [punk::ansi::ta::split_codes $text]
#review - if we have only one element of a paired codeset such as PM,SOS - it will not be found by split_codes
#The output technically then still contains ansi (which may for example be hidden by terminal despite lack of closing ST)
if {[llength $parts] == 1} {return [lindex $parts 0]} if {[llength $parts] == 1} {return [lindex $parts 0]}
set out "" set out ""
#todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] ""
@ -5686,21 +5689,106 @@ tcl::namespace::eval punk::ansi {
#[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}] #[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}]
} }
tcl::namespace::eval sequence_type { tcl::namespace::eval sequence_type {
proc is_Fe {code} { #first byte after ESC identifies code type
#NOTE - we are looking for valid start of a single sequence here
#- not whether it is complete or where it ends, unless it's a fixed number of bytes
#\u0020-\u002F
# ESC <sp>!"#$%&'()*+,-./
#\u0030-\u003F
#ESC 0-9:;<=>?
#\u0040-\u005F
# ESC @A-Z[\]^
#\u0060-\u007E
proc is_Fe7 {code} {
# C1 control codes # C1 control codes
if {[regexp {^\033\[[\u0040-\u005F]}]} { #7bit - typical case
#7bit - typical case # ESC @A-Z[\]^
return 1 return [regexp {^\033[\u0040-\u005F]} $code]
} }
proc is_Fe {code} {
#although Fe7 more common - we'll put the simpler regex for 8 first
return [expr {[is_Fe8 $code] || [is_Fe7 $code]}]
}
proc is_Fe8 {code} {
#8bit #8bit
#review - all C1 escapes ? 0x80-0x90F #review - all C1 escapes ? 0x80-0x9F
#This is possibly problematic as it is affected by encoding. #This is possibly problematic as it is affected by encoding.
#According to https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit #According to https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit
#"However, in character encodings used on modern devices such as UTF-8 or CP-1252, those codes are often used for other purposes, so only the 2-byte sequence is typically used." #"However, in character encodings used on modern devices such as UTF-8 or CP-1252, those codes are often used for other purposes, so only the 2-byte sequence is typically used."
return 0 return [regexp {^[\u0080-\u09F]} $code]
}
#ESC 0-9,:,;,<,=,>,?
proc is_Fp {code} {
#single byte following ESC
return [regexp {^\033[\u0030-\u003F]$} $code]
} }
#https://en.wikipedia.org/wiki/ISO/IEC_2022
#e.g
# ESC a (INT) interrupts the current process
# ESC c (RIS) reset terminal to initial state
#ESC `a-z{|}~
proc is_Fs {code} { proc is_Fs {code} {
puts stderr "is_Fs unimplemented" #single byte following ESC
return [regexp {^\033[\u0060-\u007E]$} $code]
}
proc is_nF {code} {
#2 bytes
#subcategorised by the low two bits of the first byte (n)
#further by whether the final byte is in \u0030-u003f (p) or not (t)
return [regexp {^\033[\u0020-\u002F]+[\u0030-\u007E]$} $code]
}
#review - test
#3Fp - private use
#e.g vt100
# ESC#3 DECDHL double-height letters top half
# ESC#4 DECDHL double-height letters bottom half
# ESC#5 DECSWL single-width line
# ESC#6 DECDWL double-width line
proc is_3Fp {code} {
return [regexp {^\033#[\u0020-\u002F]*[\u0030-\u003F]$} $code] ;#check regexp
}
proc is_code7 {code} {
#Fe | Fs | Fp | nF | Fe
return [regexp {^\033[\u0040-\u005F]|^\033[\u0060-\u007e]$|^\033[\u0030-\u003F]$|^\033[\u0020-\u002F]+[\u0030-\u007E]$} $code]
}
proc is_code8 {code} {
return [regexp {^[\u0080-\u09F]} $code]
}
proc is_code {code} {
return [expr {[is_code8 $code] || [is_code7 $code]}]
}
proc classify {code} {
return [switch -regexp -- $code {
{^\033[\u0030-\u003F]$} {string cat Fp}
{^[\u0080-\u009F]|^\033[\u0040-\u005F]} {string cat Fe}
{^\033[\u0060-\u007E]$} {string cat Fs}
{^\033[\u0020-\u002F]+[\u0030-\u007E]$} {
#nF sequences
set firstbytenum [scan [string index $code 1] %c]
set lastbyte [string index $code end]
set n [expr {$firstbytenum & 3}]
if {[regexp {[\u0030-\u003F]} $lastbyte]} {
set tp p
} else {
set tp t
}
string cat ${n}F$tp
}
{^\033#[\u0020-\u002F]*[\u0030-\u003F]$} {string cat 3Fp}
default {string cat unknown}
}]
} }
} }
# -- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- ---
@ -5718,6 +5806,7 @@ tcl::namespace::eval punk::ansi::ta {
#[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm #[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm
#[list_begin definitions] #[list_begin definitions]
tcl::namespace::path ::punk::ansi tcl::namespace::path ::punk::ansi
namespace export detect detect_in_list detect_sgr extract length split_codes split_at_codes split_codes_single
variable PUNKARGS variable PUNKARGS
@ -5748,20 +5837,27 @@ tcl::namespace::eval punk::ansi::ta {
variable re_osc_open {(?:\x1b\]|\u009d).*} variable re_osc_open {(?:\x1b\]|\u009d).*}
#review - distinguishing standalone codes vs those that are paired with contents considered part of the code
#e.g PM,SOS are 'paired' ended by ST
#variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""]
variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)}
variable re_standalones_vt52 {(?:\x1bZ)} variable re_standalones_vt52 {(?:\x1bZ)}
#ESC Y move, ESC b foreground colour # --
#ESC Y move - \x1bY<byte><byte> ie 2 bytes to close
#ESC b foreground colour - \x1bb<byte> 1 byte to close
variable re_vt52_incomplete {(?:\x1bY(.){0,1}$|\x1bb$)}
#\x1bc vt52 bgcolour conflict ?
#ESC F - gr-on ESC G - gr-off #ESC F - gr-on ESC G - gr-off
variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} # --
#\x1bc vt52 bgcolour conflict ??
#if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess
variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
variable re_g0_open {(?:\x1b\(0)} variable re_g0_open {(?:\x1b\(0)}
variable re_g0_close {(?:\x1b\(B)} variable re_g0_close {(?:\x1b\(B)}
#detect start of ansicode that is closed by ST
# DCS "ESC P" or "0x90" is also terminated by ST # DCS "ESC P" or "0x90" is also terminated by ST
set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)}
#ST terminators [list \007 \033\\ \u009c] #ST terminators [list \007 \033\\ \u009c]
@ -5777,12 +5873,15 @@ tcl::namespace::eval punk::ansi::ta {
variable re_ST {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)} variable re_ST {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)}
#variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
#variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_ST_open}|${re_vt52_incomplete}"
#consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open #consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open
#default for regexes is non-newline-sensitive matching - ie matches can span lines #default for regexes is non-newline-sensitive matching - ie matches can span lines
# -- --- --- --- # -- --- --- ---
variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" #variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}"
# -- --- --- --- # -- --- --- ---
#handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes
#This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone.
@ -5802,20 +5901,24 @@ tcl::namespace::eval punk::ansi::ta {
# plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode)
#regexp expanded syntax = ?x #regexp expanded syntax = ?x
#full detect - checking for closing sequences
variable re_ansi_detect {(?x) variable re_ansi_detect {(?x)
(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) (?:\x1b(?:\[(?:[\x20-\x3f]*[\x40-\x7e])|a|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8))))
|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)
|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] |(?:\u009b)[\x20-\x3f]*[\x40-\x7e]
|(?:\u009d)(?:[^\u009c]*)?\u009c |(?:\u009d)(?:[^\u009c]*)?\u009c
} }
#--- #---
#todo
#variable re_ansi_detectcode $re_ansi_detect
#variable re_ansi_detectcode {\x1b[\u0040-\u005F]|\x1b[\u0060-\u007e]|\x1b[\u0030-\u003F]|\x1b[\u0020-\u002F]+[\u0030-\u007E]}
variable re_ansi_detectcode {(?:\x1b(?:[\u0030-\u007E]|[\u0020-\u002F]+[\u0030-\u007E]))|[\u0090-\u009F]}
# -- --- --- --- # -- --- --- ---
#variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]}
variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
#may be same as detect - kept in case detect needs to diverge #may be same as detect - kept in case detect needs to diverge
#variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}"
@ -5827,20 +5930,6 @@ tcl::namespace::eval punk::ansi::ta {
set re_ansi_split_multi "(?:${re_ansi_split})+" set re_ansi_split_multi "(?:${re_ansi_split})+"
} }
lappend PUNKARGS [list -dynamic 0 {
@id -id ::punk::ansi::ta::detect
@cmd -name punk::ansi::ta::detect -help\
"Return a boolean indicating whether Ansi codes were detected in text.
Important caveat:
When text is a tcl list made from splitting (or lappending) some ansi string
- individual elements may be braced or have certain chars escaped.
(one example is if a list element contains an unbalanced brace)
This can cause square brackets that form part of the ansi to be backslash escaped
- and the function can fail to match it as an Ansi code.
"
@values -min 1
text -type string
} ]
#*** !doctools #*** !doctools
#[call [fun detect] [arg text]] #[call [fun detect] [arg text]]
@ -5851,10 +5940,35 @@ tcl::namespace::eval punk::ansi::ta {
#detect any ansi escapes #detect any ansi escapes
#review - only detect 'complete' codes - or just use the opening escapes for performance? #review - only detect 'complete' codes - or just use the opening escapes for performance?
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect
@cmd -name punk::ansi::ta::detect\
-summary\
"Test if text has completed ANSI codes"\
-help\
"Return a boolean indicating whether *complete* Ansi codes were detected in text.
By complete, it means that paired squences such as PM (privacy message) must be
closed. It also means that a truncated sequence such as \\x1b\\\[ or a lone escape
will not be detected as ANSI.
Use punk::ansi::ta::detectcode as a slightly faster detector for ANSI codes, that does
not require paired sequences to have both starting and end sequences to be detected.
Important caveat:
When text is a tcl list made from splitting (or lappending) some ansi string
- individual elements may be braced or have certain chars escaped.
(one example is if a list element contains an unbalanced brace)
This can cause square brackets that form part of the ansi to be backslash escaped
- and the function can fail to match it as an Ansi code.
"
@values -min 1
text -type string -help\
"Block of text. See caveat above about lists."
} ]
proc detect {text} [string map [list <re> [list $re_ansi_detect]] { proc detect {text} [string map [list <re> [list $re_ansi_detect]] {
regexp <re> $text regexp <re> $text
}] }]
#can be used on dicts - but will check keys too. keys could also contain ansi and have escapes #can be used on dicts - but will check keys too. keys could also contain ansi and have escapes
proc detect_in_list {list} { proc detect_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review) #loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
@ -5865,6 +5979,22 @@ tcl::namespace::eval punk::ansi::ta {
} }
return 0 return 0
} }
#will detect for example lone opening or closing PM
proc detectcode {text} [string map [list <re> [list $re_ansi_detectcode]] {
regexp <re> $text
}]
proc detectcode_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
foreach item $list {
if {[detectcode $item]} {
return 1
}
}
return 0
}
#surprisingly - the ::join operation can be (relatively) slow on lists containing ansi #surprisingly - the ::join operation can be (relatively) slow on lists containing ansi
proc detect_in_list2 {list} { proc detect_in_list2 {list} {
detect [join $list " "] detect [join $list " "]
@ -5915,6 +6045,8 @@ tcl::namespace::eval punk::ansi::ta {
variable re_sgr variable re_sgr
expr {[regexp $re_sgr $text]} expr {[regexp $re_sgr $text]}
} }
#perl: ta_strip
proc strip {text} { proc strip {text} {
#*** !doctools #*** !doctools
#[call [fun strip] [arg text]] #[call [fun strip] [arg text]]
@ -5922,6 +6054,39 @@ tcl::namespace::eval punk::ansi::ta {
#[para]This is a tailcall to punk::ansi::ansistrip #[para]This is a tailcall to punk::ansi::ansistrip
tailcall ansistrip $text tailcall ansistrip $text
} }
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::extract
@cmd -name punk::ansi::ta::extract\
-summary\
"Return only the ANSI codes in text"\
-help\
"This is the opposite of strip,
returning only the ANSI codes in text."
@values -min 1 -max 1
text -type string
} ]
proc extract {text} {
set parts [split_codes $text]
set out ""
foreach {pt code} $parts {
append out $code
}
return $out
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::length
@cmd -name punk::ansi::ta::length\
-summary\
"Calculate length of text (excluding the ANSI codes)"\
-help\
"Calculate length of text (excluding the ANSI codes)
This is not the printing length of the string on screen."
@values -min 1
text -type string
} ]
#perl: ta_length
proc length {text} { proc length {text} {
#*** !doctools #*** !doctools
#[call [fun length] [arg text]] #[call [fun length] [arg text]]
@ -5936,6 +6101,8 @@ tcl::namespace::eval punk::ansi::ta {
# #
#} #}
#perl: ta_trunc
#truncate $text to $width columns while still including all the ANSI colour codes.
proc trunc {text width args} { proc trunc {text width args} {
} }
@ -8504,6 +8671,10 @@ tcl::namespace::eval punk::ansi::internal {
} }
} }
tcl::namespace::eval punk::ansi {
namespace import ::punk::ansi::ta::detect
}
#inserting into global namespace like this should be kept to a minimum.. but this is considered a core aspect of punk::ansi #inserting into global namespace like this should be kept to a minimum.. but this is considered a core aspect of punk::ansi
#todo - document #todo - document
interp alias {} ansistring {} ::punk::ansi::ansistring interp alias {} ansistring {} ::punk::ansi::ansistring

39
src/bootsupport/modules/punk/args-0.2.tm

@ -1364,6 +1364,11 @@ tcl::namespace::eval punk::args {
#} #}
tcl::dict::set tmp_optspec_defaults -type $v tcl::dict::set tmp_optspec_defaults -type $v
} }
-defaultdisplaytype {
#how the -default is displayed
#-default doesn't have to be the same type as -type which validates user input that is not defaulted.
tcl::dict::set tmp_optspec_defaults -defaultdisplaytype $v
}
-parsekey { -parsekey {
tcl::dict::set tmp_optspec_defaults -parsekey $v tcl::dict::set tmp_optspec_defaults -parsekey $v
@ -1441,7 +1446,7 @@ tcl::namespace::eval punk::args {
default { default {
set known { -parsekey -group -grouphelp\ set known { -parsekey -group -grouphelp\
-any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\
-type -range -typeranges -default -typedefaults -type -range -typeranges -default -defaultdisplaytype -typedefaults
-choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\
-nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\
-type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\
@ -2052,6 +2057,9 @@ tcl::namespace::eval punk::args {
tcl::dict::set spec_merged -optional 1 tcl::dict::set spec_merged -optional 1
} }
} }
-defaultdisplaytype {
tcl::dict::set spec_merged -defaultdisplaytype $specval
}
-typedefaults { -typedefaults {
set typecount [llength [tcl::dict::get $spec_merged -type]] set typecount [llength [tcl::dict::get $spec_merged -type]]
if {$typecount != [llength $specval]} { if {$typecount != [llength $specval]} {
@ -2114,7 +2122,7 @@ tcl::namespace::eval punk::args {
-form -type\ -form -type\
-parsekey -group\ -parsekey -group\
-range -typeranges\ -range -typeranges\
-default -typedefaults\ -default -defaultdisplaytype -typedefaults\
-minsize -maxsize -choices -choicegroups\ -minsize -maxsize -choices -choicegroups\
-choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\
-nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\
@ -3784,7 +3792,32 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $arginfo -default]} { if {[dict exists $arginfo -default]} {
set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" #default isn't necessarily of same type as -type required for validation
#Guessing at the type from the data is likely to be unsatisfactory.
set defaultdisplaytype [Dict_getdef $arginfo -defaultdisplaytype string]
switch -- $defaultdisplaytype {
dict {
#single level
set rawdefault [dict get $arginfo -default]
set default "{\n"
dict for {k v} $rawdefault {
append default " \"$k\" \"$v\"\n"
}
append default "}"
}
list {
set default "{\n"
foreach v $rawdefault {
append default " \"$v\"\n"
}
append default "}"
}
default {
#set default "'$A_DEFAULT[dict get $arginfo -default]$RST'"
set default "'[dict get $arginfo -default]'"
}
}
} else { } else {
set default "" set default ""
} }

101
src/bootsupport/modules/punk/char-0.1.0.tm

@ -89,6 +89,107 @@ tcl::namespace::eval punk::char {
variable invalid "???" ;# ideally this would be 0xFFFD - which should display as black diamond/rhombus with question mark. As at 2023 - this tends to display indistinguishably from other missing glyph boxes - so we use a longer sequence we can detect by length and to display obviously variable invalid "???" ;# ideally this would be 0xFFFD - which should display as black diamond/rhombus with question mark. As at 2023 - this tends to display indistinguishably from other missing glyph boxes - so we use a longer sequence we can detect by length and to display obviously
variable invalid_display_char \u25ab; #todo - change to 0xFFFD once diamond glyph more common? variable invalid_display_char \u25ab; #todo - change to 0xFFFD once diamond glyph more common?
#more useful for referring to ANSI documentation would be a proper 7-bit and 8-bit 'Code Table' layout
#as described in ECMA-35 5.2
# where the positions of the table are in one-to-one correspondence with the bit combinations of the code.
#- for 7-bit: 8 columns 16 rows
#- for 8-bit 16 columns 16 rows
proc codetable {which} {
set bits 8
switch -- $which {
ascii8 {
set which default
}
ascii {
set bits 7
}
default {
if {$which ni [encoding names]} {
error "codetable unsupported - use 'ascii' or an entry from the result of the 'encoding names' command."
}
}
}
package require punk::ansi
set hibit_count [expr {$bits-4}]
set bitcolumns [expr {2**$hibit_count}] ;#always 4 bits for the rows - remaining bits for the columns
set columncount [expr {$bitcolumns + 6}]
#set header1 [list "" "b7\nb6\nb5" "0\n0\n0" "0\n0\n1" "0\n1\n0" "0\n1\n1" "1\n0\n0" "1\n0\n1" "1\n1\n0" "1\n1\n1"]
set header1 [list]
set hibits_label ""
set indent ""
for {set hb $bits} {$hb > 4} {incr hb -1} {
append hibits_label ${indent}b$hb\n
append indent " "
}
set hibits_label [string range $hibits_label 0 end-1]
lappend header1 $hibits_label "" "" "" "" ""
for {set colidx 0} {$colidx < $bitcolumns} {incr colidx} {
set binval [format %0${hibit_count}b $colidx]
set binvalbits [split $binval ""]
set indent ""
set display_hibits ""
foreach bb $binvalbits {
append display_hibits $indent$bb\n
append indent " "
}
set display_hibits [string range $display_hibits 0 end-1]
lappend header1 $display_hibits
}
#\u2193 down arrow
#right-down arrows
#\u2ba7
#\u21b4
#\u2b0e
set header2 [list " Bits" b4 b3 b2 b1 "column \u2192\nrow \u2b0e" {*}[punk::lib::range 0 $bitcolumns-1]]
set headers [list $header1 $header2]
#set t [textblock::table -return tableobject -rows $rows]
set t [textblock::table -return tableobject]
#todo - fix textblock::table to allow configure -columncount
for {set c 0} {$c < $columncount} {incr c} {
$t add_column
}
set vheaders [punk::transpose_equal_lists $headers]
set hidx -1
foreach vh $vheaders {
incr hidx
$t configure_column $hidx -headers $vh
}
$t configure_header 0 -colspans [list 6 0 0 0 0 0 {*}[lrepeat $bitcolumns 1]]
$t configure_column 0 -blockalign left
#always 16 rows - remaining bits form the columns
for {set ridx 0} {$ridx <= 15} {incr ridx} {
set charlist [list]
set lowbits [format %04b $ridx]
for {set i 0} {$i < $bitcolumns} {incr i} {
set hibits [format %0${hibit_count}b $i]
set ch [format %c [scan ${hibits}${lowbits} %b]]
#puts "-->${hibits}${lowbits} ch:$ch"
if {$which ne "default"} {
if {[catch {encoding convertfrom $which $ch} ch]} {
set ch [punk::ansi::a red bold]-[punk::ansi::a]
lappend charlist $ch
} else {
lappend charlist [punk::ansi::ansistring VIEW -lf 1 -vt 1 $ch]
}
} else {
lappend charlist [punk::ansi::ansistring VIEW -lf 1 -vt 1 $ch]
}
}
set r [list "" {*}[split $lowbits ""] $ridx {*}$charlist]
$t add_row $r
}
puts stderr $t
$t print
}
#just the 7-bit ascii. use [page ascii] for the 8-bit layout #just the 7-bit ascii. use [page ascii] for the 8-bit layout
proc ascii {} {return { proc ascii {} {return {
00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL 00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL

1
src/bootsupport/modules/punk/console-0.1.1.tm

@ -1336,6 +1336,7 @@ namespace eval punk::console {
#https://vt100.net/docs/vt510-rm/DA1.html #https://vt100.net/docs/vt510-rm/DA1.html
# #
proc get_device_attributes {{inoutchannels {stdin stdout}}} { proc get_device_attributes {{inoutchannels {stdin stdout}}} {
#Note the vt52 rough equivalen \x1bZ - commonly supported but probably best considered obsolete as it collides with ECMA 48 SCI Single Character Introducer
#DA1 #DA1
variable last_da1_result variable last_da1_result
#first element in result is the terminal's architectural class 61,62,63,64.. ? #first element in result is the terminal's architectural class 61,62,63,64.. ?

126
src/bootsupport/modules/punk/lib-0.1.2.tm

@ -2242,6 +2242,121 @@ namespace eval punk::lib {
} }
} }
#review - compare to IMAP4 methods of specifying ranges?
punk::args::define {
@id -id ::punk::lib::indexset_resolve
@cmd -name punk::lib::indexset_resolve\
-summary\
"Resolve an indexset to a list of integers based on supplied list or string length."\
-help\
"Resolve an 'indexset' to a list of actual indices within the range of the provided numitems value.
An indexset consists of a comma delimited list of indexes or index-ranges.
The indexes are 0-based.
Ranges must be specified with .. as the separator.
Whitespace is ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
end means the last page.
end-1 means the second last page.
0.. is the same as 0..end.
examples:
1,3..
output the page index 1 (2nd page) followed by all from index 3 to the end.
0-2,end
output the first 3 pages, and the last page.
end-1..0
output the indexes in reverse order from 2nd last page to first page."
@values -min 2 -max 2
numitems -type integer
indexset -type string
}
proc indexset_resolve {numitems indexset} {
if {![string is integer -strict $numitems] || ![regexp {^[\-\+_end,\.0-9]*$} $indexset]} {
#use parser on unhappy path only
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg]
}
set index_list [list] ;#list of actual indexes within the range
set iparts [split $indexset ,]
set index_list [list]
foreach ipart $iparts {
set ipart [string trim $ipart]
set rposn [string first .. $ipart]
if {$rposn>=0} {
#range
lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn+2] rawa _ rawb
set rawa [string trim $rawa]
set rawb [string trim $rawb]
if {$rawa eq ""} {set rawa 0}
set a [punk::lib::lindex_resolve $numitems $rawa]
if {$a == -3} {
#undershot - leave negative
} elseif {$a == -2 && $rawa ne "-2"} {
#overshot
set a [expr {$numitems}] ;#put it outside the range on the upper side
}
if {$rawb eq ""} {
if {$a > $numitems-1} {
set rawb $a ;#make sure <overshot>.. doesn't return last item - should return nothing
} else {
set rawb end
}
}
set b [punk::lib::lindex_resolve $numitems $rawb]
if {$b == -3} {
#undershot - leave negative
} elseif {$b == -2 && $rawb ne "-2"} {
set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side
}
#e.g make sure <overshot>.. doesn't return last item - should return nothing as both are above the range.
if {$a >= 0 && $a <= $numitems-1 && $b >=0 && $b <= $numitems-1} {
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else {
if {$a >= 0 && $a <= $numitems-1} {
#only a is in the range
if {$b < 0} {
set b 0
} else {
set b [expr {$numitems-1}]
}
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$b >=0 && $b <= $numitems-1} {
#only b is in the range
if {$a < 0} {
set a 0
} else {
set a [expr {$numitems-1}]
}
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else {
#both outside the range
if {$a < 0 && $b > 0} {
#spans the range in forward order
set a 0
set b [expr {$numitems-1}]
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$a > 0 && $b < 0} {
#spans the range in reverse order
set a [expr {$numitems-1}]
set b 0
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
}
#both outside of range on same side
}
}
} else {
set idx [punk::lib::lindex_resolve_basic $numitems $ipart]
if {$idx >= 0} {
lappend index_list $idx
}
}
}
return $index_list
}
# showdict uses lindex_resolve results -2 & -3 to determine whether index is out of bounds on upper vs lower side # showdict uses lindex_resolve results -2 & -3 to determine whether index is out of bounds on upper vs lower side
#REVIEW: This shouldn't really need the list itself - just the length would suffice #REVIEW: This shouldn't really need the list itself - just the length would suffice
punk::args::define { punk::args::define {
@ -2305,7 +2420,8 @@ namespace eval punk::lib {
#<0 ? #<0 ?
error "lindex_resolve len must be an integer" error "lindex_resolve len must be an integer"
} }
set index [tcl::string::map {_ {}} $index] ;#forward compatibility with integers such as 1_000 set index [tcl::string::map {_ {}} $index] ;#basic forward compatibility with integers such as 1_000 for 8.6
#todo - be stricter about malformations such as 1000_
if {[string is integer -strict $index]} { if {[string is integer -strict $index]} {
#can match +i -i #can match +i -i
if {$index < 0} { if {$index < 0} {
@ -3345,8 +3461,12 @@ namespace eval punk::lib {
#NOTE: running ta::detect on a list (or dict) as a whole can be problematic if items in the list have backslash escapes due to Tcl list quoting and escaping behaviour. #NOTE: running ta::detect on a list (or dict) as a whole can be problematic if items in the list have backslash escapes due to Tcl list quoting and escaping behaviour.
#This commonly happens if there is an unbalanced brace (which is a normal occurrence and needs to be handled) #This commonly happens if there is an unbalanced brace (which is a normal occurrence and needs to be handled)
#ta::detect on a list of ansi-containing string may appear to work for some simple inputs but is not reliable #ta::detect on a list of ansi-containing string may appear to work for some simple inputs but is not reliable
#detect_in_list will check at first level. (not intended for detecting ansi in deeper structures) #detect_in_list/detectcode_in_list will check at first level. (not intended for detecting ansi in deeper structures)
if {![punk::ansi::ta::detect_in_list $linelist]} {
#we use detectcode_in_list instead of detect_in_list
#detectcode_in_list will detect unclosed (or unopened) paired sequences such as PM (privacy message)
# - but the main reason is it is slightly faster.
if {![punk::ansi::ta::detectcode_in_list $linelist]} {
if {$opt_ansiresets} { if {$opt_ansiresets} {
foreach ln $linelist { foreach ln $linelist {
lappend transformed $RST$ln$RST lappend transformed $RST$ln$RST

16
src/bootsupport/modules/punk/ns-0.1.0.tm

@ -13,6 +13,9 @@
# @@ Meta End # @@ Meta End
#BUGS
# 2025-08
# n// and n/// won't output info about 'namespace path' if there are no commands in the namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements ## Requirements
@ -1235,7 +1238,7 @@ tcl::namespace::eval punk::ns {
if {[dict size [dict get $nsdict namespacepath]]} { if {[dict size [dict get $nsdict namespacepath]]} {
set path_text "" set path_text ""
if {!$opt_nspathcommands} { if {!$opt_nspathcommands} {
append path_text \n " Also resolving cmds in namespace paths: [dict keys [dict get $nsdict namespacepath]]" append path_text \n " Also resolving cmds in namespace paths: [dict keys [dict get $nsdict namespacepath]] (use n/// to display)"
} else { } else {
append path_text \n " Also resolving cmds in namespace paths:" append path_text \n " Also resolving cmds in namespace paths:"
set nspathdict [dict get $nsdict namespacepath] set nspathdict [dict get $nsdict namespacepath]
@ -1247,8 +1250,17 @@ tcl::namespace::eval punk::ns {
} }
} else { } else {
#todo - change to display in column order to be same as main command listing #todo - change to display in column order to be same as main command listing
set parentcommands [dict get $nsdict commands]
dict for {k v} $nspathdict { dict for {k v} $nspathdict {
set pathcommands [dict get $v commands] set rawpathcommands [dict get $v commands]
set pathcommands [list]
foreach c $rawpathcommands {
if {$c in $parentcommands} {
lappend pathcommands [punk::ansi::a strike]$c[a]
} else {
lappend pathcommands $c
}
}
set columns 6 set columns 6
if {[llength $pathcommands] < 6} { if {[llength $pathcommands] < 6} {
set columns [llength $v] set columns [llength $v]

40
src/bootsupport/modules/shellfilter-0.2.tm

@ -579,13 +579,15 @@ namespace eval shellfilter::chan {
#punk::ansi::ansistrip converts at least some of the box drawing G0 chars to unicode - todo - more complete conversion #punk::ansi::ansistrip converts at least some of the box drawing G0 chars to unicode - todo - more complete conversion
#assumes line-buffering. a more advanced filter required if ansicodes can arrive split across separate read or write operations! #assumes line-buffering. a more advanced filter required if ansicodes can arrive split across separate read or write operations!
oo::class create ansistrip { oo::class create ansistrip {
variable o_trecord variable o_trecord
variable o_enc variable o_enc
variable o_encbuf
variable o_is_junction variable o_is_junction
constructor {tf} { constructor {tf} {
package require punk::ansi package require punk::ansi
set o_trecord $tf set o_trecord $tf
set o_enc [dict get $tf -encoding] set o_enc [dict get $tf -encoding]
set o_encbuf ""
if {[dict exists $tf -junction]} { if {[dict exists $tf -junction]} {
set o_is_junction [dict get $tf -junction] set o_is_junction [dict get $tf -junction]
} else { } else {
@ -614,10 +616,36 @@ namespace eval shellfilter::chan {
method flush {transform_handle} { method flush {transform_handle} {
return "" return ""
} }
#method write {transform_handle bytes} {
# #broken due to occasional unexpected byte sequence
# set instring [encoding convertfrom $o_enc $bytes]
# set outstring [punk::ansi::ansistrip $instring]
# return [encoding convertto $o_enc $outstring]
#}
method write {transform_handle bytes} { method write {transform_handle bytes} {
set instring [encoding convertfrom $o_enc $bytes] #set instring [tcl::encoding::convertfrom $o_enc $bytes] ;naive approach will break due to unexpected byte sequence - occasionally
set outstring [punk::ansi::ansistrip $instring] #bytes can break at arbitrary points making encoding conversions invalid.
return [encoding convertto $o_enc $outstring]
set inputbytes $o_encbuf$bytes
set o_encbuf ""
set tail_offset 0
while {$tail_offset < [string length $inputbytes] && [catch {tcl::encoding::convertfrom $o_enc [string range $inputbytes 0 end-$tail_offset]} stringdata]} {
incr tail_offset
}
if {$tail_offset > 0} {
if {$tail_offset < [string length $inputbytes]} {
#stringdata from catch statement must be a valid result
set t [expr {$tail_offset - 1}]
set o_encbuf [string range $inputbytes end-$t end]
} else {
set stringdata ""
set o_encbuf $inputbytes
return ""
}
}
set outstring [punk::ansi::ansistrip $stringdata]
return [tcl::encoding::convertto $o_enc $outstring]
} }
method meta_is_redirection {} { method meta_is_redirection {} {
return $o_is_junction return $o_is_junction
@ -724,6 +752,8 @@ namespace eval shellfilter::chan {
set emit "" set emit ""
if {[string last \x1b $buf] >= 0} { if {[string last \x1b $buf] >= 0} {
#detect will detect ansi SGR and gron groff and other codes #detect will detect ansi SGR and gron groff and other codes
#REVIEW - ta::detect won't detect SOS without paired ST for things like PM
# ta::detectcode will - but then split_codes_single will treat unpaired SOS as text?
if {[punk::ansi::ta::detect $buf]} { if {[punk::ansi::ta::detect $buf]} {
#split_codes_single regex faster than split_codes - but more resulting parts #split_codes_single regex faster than split_codes - but more resulting parts
#'single' refers to number of escapes - but can still contain e.g multiple SGR codes (or mode set operations etc) #'single' refers to number of escapes - but can still contain e.g multiple SGR codes (or mode set operations etc)
@ -1035,7 +1065,7 @@ namespace eval shellfilter::chan {
} }
#todo - something #todo - something
oo::class create rebuffer { oo::class create rebuffer {
variable o_trecord variable o_trecord
variable o_enc variable o_enc
constructor {tf} { constructor {tf} {
set o_trecord $tf set o_trecord $tf

28
src/bootsupport/modules/textblock-0.1.3.tm

@ -2528,7 +2528,7 @@ tcl::namespace::eval textblock {
set ansiborder_final $ansiborder_body_col_row set ansiborder_final $ansiborder_body_col_row
#$c will always have ansi resets due to overtype behaviour ? #$c will always have ansi resets due to overtype behaviour ?
#todo - review overtype #todo - review overtype
if {[punk::ansi::ta::detect $c]} { if {[punk::ansi::ta::detectcode $c]} {
#use only the last ansi sequence in the cell value #use only the last ansi sequence in the cell value
#Filter out foreground and use background for ansiborder override #Filter out foreground and use background for ansiborder override
set parts [punk::ansi::ta::split_codes_single $c] set parts [punk::ansi::ta::split_codes_single $c]
@ -4377,6 +4377,7 @@ tcl::namespace::eval textblock {
if {![punk::ansi::ta::detect $block]} { if {![punk::ansi::ta::detect $block]} {
return $block return $block
} }
#could be newine in SOS/PM? review - terminal should theoretically ignore all chars til close of string
foreach ln [split $block \n] { foreach ln [split $block \n] {
set parts [punk::ansi::ta::split_codes $ln] set parts [punk::ansi::ta::split_codes $ln]
if {[lindex $parts 0] eq ""} { if {[lindex $parts 0] eq ""} {
@ -4894,7 +4895,9 @@ tcl::namespace::eval textblock {
} }
set textblock [textutil::tabify::untabify2 $textblock $tw] set textblock [textutil::tabify::untabify2 $textblock $tw]
} }
if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #review detectcode vs detect. detectcode won't look for completness of all codes to give a positive result
#ansistripraw splits on complete codes..
if {[string length $textblock] > 1 && [punk::ansi::ta::detectcode $textblock]} {
#ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions)
set textblock [punk::ansi::ansistripraw $textblock] set textblock [punk::ansi::ansistripraw $textblock]
} }
@ -4917,7 +4920,9 @@ tcl::namespace::eval textblock {
} else { } else {
set tl $textblock set tl $textblock
} }
if {[punk::ansi::ta::detect $tl]} { #review detectcode vs detect. detectcode won't look for completness of all codes to give a positive result
#ansistripraw splits on complete codes..
if {[punk::ansi::ta::detectcode $tl]} {
set tl [punk::ansi::ansistripraw $tl] set tl [punk::ansi::ansistripraw $tl]
} }
return [punk::char::ansifreestring_width $tl] return [punk::char::ansifreestring_width $tl]
@ -4964,7 +4969,7 @@ tcl::namespace::eval textblock {
set textblock [textutil::tabify::untabify2 $textblock $tw] set textblock [textutil::tabify::untabify2 $textblock $tw]
} }
#ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests
if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { if {[string length $textblock] > 1 && [punk::ansi::ta::detectcode $textblock]} {
set textblock [punk::ansi::ansistripraw $textblock] set textblock [punk::ansi::ansistripraw $textblock]
} }
if {[tcl::string::last \n $textblock] >= 0} { if {[tcl::string::last \n $textblock] >= 0} {
@ -5211,7 +5216,7 @@ tcl::namespace::eval textblock {
set known_hasansi [tcl::dict::get $opts -known_hasansi] set known_hasansi [tcl::dict::get $opts -known_hasansi]
if {$known_hasansi eq ""} { if {$known_hasansi eq ""} {
set block_has_ansi [punk::ansi::ta::detect $block] set block_has_ansi [punk::ansi::ta::detectcode $block]
} else { } else {
set block_has_ansi $known_hasansi set block_has_ansi $known_hasansi
} }
@ -5648,7 +5653,7 @@ tcl::namespace::eval textblock {
set rowcount 0 set rowcount 0
set blocklists [list] set blocklists [list]
foreach b $blocks { foreach b $blocks {
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
#-ansireplays 1 quite expensive e.g 7ms in 2024 #-ansireplays 1 quite expensive e.g 7ms in 2024
set bl [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] set bl [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b]
} else { } else {
@ -5676,7 +5681,7 @@ tcl::namespace::eval textblock {
set i -1 set i -1
foreach b $args { foreach b $args {
incr i incr i
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
#-ansireplays 1 quite expensive e.g 7ms in 2024 #-ansireplays 1 quite expensive e.g 7ms in 2024
set blines [punk::lib::lines_as_list -ansireplays 1 -ansiresets auto -- $b] set blines [punk::lib::lines_as_list -ansireplays 1 -ansiresets auto -- $b]
} else { } else {
@ -5799,7 +5804,7 @@ tcl::namespace::eval textblock {
#testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway. #testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway.
#blocks passed to join can be ragged - so we can't pass -known_samewidth to pad #blocks passed to join can be ragged - so we can't pass -known_samewidth to pad
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
# - we need to join to use pad - even though we then need to immediately resplit REVIEW (make line list version of pad?) # - we need to join to use pad - even though we then need to immediately resplit REVIEW (make line list version of pad?)
set replay_block [::join [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] \n] set replay_block [::join [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] \n]
#set blines [split [textblock::pad $replay_block -known_hasansi 1 -known_samewidth $is_samewidth -known_blockwidth $bwidth -width $bwidth -which right -padchar " "] \n] #set blines [split [textblock::pad $replay_block -known_hasansi 1 -known_samewidth $is_samewidth -known_blockwidth $bwidth -width $bwidth -which right -padchar " "] \n]
@ -8650,7 +8655,7 @@ tcl::namespace::eval textblock {
set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $underlay $cache_contentpattern] set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $underlay $cache_contentpattern]
#puts "frame--->ansiwrap -rawansi [ansistring VIEW $opt_ansibase] $cache_inner" #puts "frame--->ansiwrap -rawansi [ansistring VIEW $opt_ansibase] $cache_inner"
if {$opt_ansibase ne ""} { if {$opt_ansibase ne ""} {
if {[punk::ansi::ta::detect $cache_inner]} { if {[punk::ansi::ta::detectcode $cache_inner]} {
#set cache_inner [punk::ansi::ansiwrap -rawansi $opt_ansibase $cache_inner] #set cache_inner [punk::ansi::ansiwrap -rawansi $opt_ansibase $cache_inner]
#set cache_inner [punk::ansi::ansiwrap_raw $opt_ansibase "" "" $cache_inner] #set cache_inner [punk::ansi::ansiwrap_raw $opt_ansibase "" "" $cache_inner]
#jjj ??? review #jjj ??? review
@ -8745,7 +8750,7 @@ tcl::namespace::eval textblock {
#set cwidth [textblock::width $contents] #set cwidth [textblock::width $contents]
#JJJ #JJJ
set contents_has_ansi [punk::ansi::ta::detect $contents] set contents_has_ansi [punk::ansi::ta::detectcode $contents]
if {$opt_ansibase ne ""} { if {$opt_ansibase ne ""} {
if {$contents_has_ansi} { if {$contents_has_ansi} {
#set contents [punk::ansi::ansiwrap -rawansi $opt_ansibase $contents] #set contents [punk::ansi::ansiwrap -rawansi $opt_ansibase $contents]
@ -8799,8 +8804,9 @@ tcl::namespace::eval textblock {
if {$subposn >= 0} { if {$subposn >= 0} {
set content_line [lindex $clines $contentindex] set content_line [lindex $clines $contentindex]
#review - different forms of reset e.g \x1b\[m ?? #review - different forms of reset e.g \x1b\[m ??
if {[string range $content_line 0 3] eq "\x1b\[0m"} { if {[tcl::string::range $content_line 0 3] eq "\x1b\[0m"} {
set content_line [tcl::string::range $content_line 4 end] set content_line [tcl::string::range $content_line 4 end]
#::tcl::string::replace content_line 0 3
} }
append content_line $opt_ansibase append content_line $opt_ansibase
append fs [tcl::string::replace $tline $subposn $subposn+$pattern_offset $content_line] \n append fs [tcl::string::replace $tline $subposn $subposn+$pattern_offset $content_line] \n

39
src/modules/punk/args-999999.0a1.0.tm

@ -1364,6 +1364,11 @@ tcl::namespace::eval punk::args {
#} #}
tcl::dict::set tmp_optspec_defaults -type $v tcl::dict::set tmp_optspec_defaults -type $v
} }
-defaultdisplaytype {
#how the -default is displayed
#-default doesn't have to be the same type as -type which validates user input that is not defaulted.
tcl::dict::set tmp_optspec_defaults -defaultdisplaytype $v
}
-parsekey { -parsekey {
tcl::dict::set tmp_optspec_defaults -parsekey $v tcl::dict::set tmp_optspec_defaults -parsekey $v
@ -1441,7 +1446,7 @@ tcl::namespace::eval punk::args {
default { default {
set known { -parsekey -group -grouphelp\ set known { -parsekey -group -grouphelp\
-any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\
-type -range -typeranges -default -typedefaults -type -range -typeranges -default -defaultdisplaytype -typedefaults
-choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\
-nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\
-type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\
@ -2052,6 +2057,9 @@ tcl::namespace::eval punk::args {
tcl::dict::set spec_merged -optional 1 tcl::dict::set spec_merged -optional 1
} }
} }
-defaultdisplaytype {
tcl::dict::set spec_merged -defaultdisplaytype $specval
}
-typedefaults { -typedefaults {
set typecount [llength [tcl::dict::get $spec_merged -type]] set typecount [llength [tcl::dict::get $spec_merged -type]]
if {$typecount != [llength $specval]} { if {$typecount != [llength $specval]} {
@ -2114,7 +2122,7 @@ tcl::namespace::eval punk::args {
-form -type\ -form -type\
-parsekey -group\ -parsekey -group\
-range -typeranges\ -range -typeranges\
-default -typedefaults\ -default -defaultdisplaytype -typedefaults\
-minsize -maxsize -choices -choicegroups\ -minsize -maxsize -choices -choicegroups\
-choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\
-nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\
@ -3784,7 +3792,32 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $arginfo -default]} { if {[dict exists $arginfo -default]} {
set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" #default isn't necessarily of same type as -type required for validation
#Guessing at the type from the data is likely to be unsatisfactory.
set defaultdisplaytype [Dict_getdef $arginfo -defaultdisplaytype string]
switch -- $defaultdisplaytype {
dict {
#single level
set rawdefault [dict get $arginfo -default]
set default "{\n"
dict for {k v} $rawdefault {
append default " \"$k\" \"$v\"\n"
}
append default "}"
}
list {
set default "{\n"
foreach v $rawdefault {
append default " \"$v\"\n"
}
append default "}"
}
default {
#set default "'$A_DEFAULT[dict get $arginfo -default]$RST'"
set default "'[dict get $arginfo -default]'"
}
}
} else { } else {
set default "" set default ""
} }

799
src/modules/punk/pdf-999999.0a1.0.tm

File diff suppressed because it is too large Load Diff

2
src/project_layouts/custom/_project/punk.basic/src/make.tcl

@ -3075,7 +3075,7 @@ foreach vfstail $vfs_tails {
#copy the version that is mounted in this runtime to vfsname.new #copy the version that is mounted in this runtime to vfsname.new
if {[catch { if {[catch {
file copy -force $building_runtime $buildfolder/$vfsname.new file copy -force $building_runtime $buildfolder/$vfsname.new
catch {exec chmod +x $buildfolder/$vfsname.new} catch {exec chmod +w $buildfolder/$vfsname.new}
} errM]} { } errM]} {
puts stderr "$kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM" puts stderr "$kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM"
error $errM error $errM

5
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/flagfilter-0.3.tm

@ -1538,6 +1538,7 @@ namespace eval flagfilter {
} }
} }
#todo - rename 'cprocessor' is misleading
oo::class create cprocessor { oo::class create cprocessor {
variable o_runid variable o_runid
variable o_name variable o_name
@ -1577,7 +1578,9 @@ namespace eval flagfilter {
if {[dict exists $o_pinfo match]} { if {[dict exists $o_pinfo match]} {
set o_matchspec [dict get $o_pinfo match] set o_matchspec [dict get $o_pinfo match]
} else { } else {
set o_matchspec {^[^-^/].*} ;#match anything that isn't flaglike #review - unix paths? conflict with windows style flag such as /w
#must accept empty string
set o_matchspec {^[^-^/].*|^$} ;#match anything that isn't flaglike
} }
set o_found_match 0 set o_found_match 0
set o_matched_argument "" ;#need o_found_match to differentiate match of empty string set o_matched_argument "" ;#need o_found_match to differentiate match of empty string

16
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm

@ -6947,7 +6947,8 @@ namespace eval punk {
set newrow {} set newrow {}
foreach oldrow $list_rows { foreach oldrow $list_rows {
if {$j >= [llength $oldrow]} { if {$j >= [llength $oldrow]} {
continue #continue
lappend newrow ""
} else { } else {
lappend newrow [lindex $oldrow $j] lappend newrow [lindex $oldrow $j]
} }
@ -6956,6 +6957,19 @@ namespace eval punk {
} }
return $res return $res
} }
proc transpose_equal_lists {list_rows} {
set columns [list]
set rowidx -1
foreach l $list_rows {
set colidx -1
incr rowidx
foreach val $l {
incr colidx
lset columns $colidx $rowidx $val
}
}
return $columns
}
proc transpose_strings {list_of_strings} { proc transpose_strings {list_of_strings} {
set charlists [lmap v $list_of_strings {split $v ""}] set charlists [lmap v $list_of_strings {split $v ""}]
set tchars [transpose_lists $charlists] set tchars [transpose_lists $charlists]

237
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -3785,7 +3785,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set codestack [list] set codestack [list]
if {[punk::ansi::ta::detect $text]} { if {[punk::ansi::ta::detectcode $text]} {
set emit "" set emit ""
#set parts [punk::ansi::ta::split_codes $text] #set parts [punk::ansi::ta::split_codes $text]
set parts [punk::ansi::ta::split_codes_single $text] set parts [punk::ansi::ta::split_codes_single $text]
@ -3892,7 +3892,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set codestack [list] set codestack [list]
if {[punk::ansi::ta::detect $text]} { if {[punk::ansi::ta::detectcode $text]} {
set emit "" set emit ""
#set parts [punk::ansi::ta::split_codes $text] #set parts [punk::ansi::ta::split_codes $text]
set parts [punk::ansi::ta::split_codes_single $text] set parts [punk::ansi::ta::split_codes_single $text]
@ -4158,7 +4158,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# where line and column are ascii codes whose values are +31 # where line and column are ascii codes whose values are +31
# vt52 can be entered/exited via escapes # vt52 can be entered/exited via escapes
# This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type
# (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) # (vt52 supports ESC Z (obs DECID) - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ )
#ESC\[c - is more modern equiv of DECID
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::ansi::vt52move @id -id ::punk::ansi::vt52move
@ -4946,6 +4947,8 @@ to 223 (=255 - 32)
} }
if {[string length $text] < 2} {return $text} if {[string length $text] < 2} {return $text}
set parts [punk::ansi::ta::split_codes $text] set parts [punk::ansi::ta::split_codes $text]
#review - if we have only one element of a paired codeset such as PM,SOS - it will not be found by split_codes
#The output technically then still contains ansi (which may for example be hidden by terminal despite lack of closing ST)
if {[llength $parts] == 1} {return [lindex $parts 0]} if {[llength $parts] == 1} {return [lindex $parts 0]}
set out "" set out ""
#todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] ""
@ -5686,21 +5689,106 @@ tcl::namespace::eval punk::ansi {
#[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}] #[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}]
} }
tcl::namespace::eval sequence_type { tcl::namespace::eval sequence_type {
proc is_Fe {code} { #first byte after ESC identifies code type
#NOTE - we are looking for valid start of a single sequence here
#- not whether it is complete or where it ends, unless it's a fixed number of bytes
#\u0020-\u002F
# ESC <sp>!"#$%&'()*+,-./
#\u0030-\u003F
#ESC 0-9:;<=>?
#\u0040-\u005F
# ESC @A-Z[\]^
#\u0060-\u007E
proc is_Fe7 {code} {
# C1 control codes # C1 control codes
if {[regexp {^\033\[[\u0040-\u005F]}]} { #7bit - typical case
#7bit - typical case # ESC @A-Z[\]^
return 1 return [regexp {^\033[\u0040-\u005F]} $code]
} }
proc is_Fe {code} {
#although Fe7 more common - we'll put the simpler regex for 8 first
return [expr {[is_Fe8 $code] || [is_Fe7 $code]}]
}
proc is_Fe8 {code} {
#8bit #8bit
#review - all C1 escapes ? 0x80-0x90F #review - all C1 escapes ? 0x80-0x9F
#This is possibly problematic as it is affected by encoding. #This is possibly problematic as it is affected by encoding.
#According to https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit #According to https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit
#"However, in character encodings used on modern devices such as UTF-8 or CP-1252, those codes are often used for other purposes, so only the 2-byte sequence is typically used." #"However, in character encodings used on modern devices such as UTF-8 or CP-1252, those codes are often used for other purposes, so only the 2-byte sequence is typically used."
return 0 return [regexp {^[\u0080-\u09F]} $code]
}
#ESC 0-9,:,;,<,=,>,?
proc is_Fp {code} {
#single byte following ESC
return [regexp {^\033[\u0030-\u003F]$} $code]
} }
#https://en.wikipedia.org/wiki/ISO/IEC_2022
#e.g
# ESC a (INT) interrupts the current process
# ESC c (RIS) reset terminal to initial state
#ESC `a-z{|}~
proc is_Fs {code} { proc is_Fs {code} {
puts stderr "is_Fs unimplemented" #single byte following ESC
return [regexp {^\033[\u0060-\u007E]$} $code]
}
proc is_nF {code} {
#2 bytes
#subcategorised by the low two bits of the first byte (n)
#further by whether the final byte is in \u0030-u003f (p) or not (t)
return [regexp {^\033[\u0020-\u002F]+[\u0030-\u007E]$} $code]
}
#review - test
#3Fp - private use
#e.g vt100
# ESC#3 DECDHL double-height letters top half
# ESC#4 DECDHL double-height letters bottom half
# ESC#5 DECSWL single-width line
# ESC#6 DECDWL double-width line
proc is_3Fp {code} {
return [regexp {^\033#[\u0020-\u002F]*[\u0030-\u003F]$} $code] ;#check regexp
}
proc is_code7 {code} {
#Fe | Fs | Fp | nF | Fe
return [regexp {^\033[\u0040-\u005F]|^\033[\u0060-\u007e]$|^\033[\u0030-\u003F]$|^\033[\u0020-\u002F]+[\u0030-\u007E]$} $code]
}
proc is_code8 {code} {
return [regexp {^[\u0080-\u09F]} $code]
}
proc is_code {code} {
return [expr {[is_code8 $code] || [is_code7 $code]}]
}
proc classify {code} {
return [switch -regexp -- $code {
{^\033[\u0030-\u003F]$} {string cat Fp}
{^[\u0080-\u009F]|^\033[\u0040-\u005F]} {string cat Fe}
{^\033[\u0060-\u007E]$} {string cat Fs}
{^\033[\u0020-\u002F]+[\u0030-\u007E]$} {
#nF sequences
set firstbytenum [scan [string index $code 1] %c]
set lastbyte [string index $code end]
set n [expr {$firstbytenum & 3}]
if {[regexp {[\u0030-\u003F]} $lastbyte]} {
set tp p
} else {
set tp t
}
string cat ${n}F$tp
}
{^\033#[\u0020-\u002F]*[\u0030-\u003F]$} {string cat 3Fp}
default {string cat unknown}
}]
} }
} }
# -- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- ---
@ -5718,6 +5806,7 @@ tcl::namespace::eval punk::ansi::ta {
#[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm #[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm
#[list_begin definitions] #[list_begin definitions]
tcl::namespace::path ::punk::ansi tcl::namespace::path ::punk::ansi
namespace export detect detect_in_list detect_sgr extract length split_codes split_at_codes split_codes_single
variable PUNKARGS variable PUNKARGS
@ -5748,20 +5837,27 @@ tcl::namespace::eval punk::ansi::ta {
variable re_osc_open {(?:\x1b\]|\u009d).*} variable re_osc_open {(?:\x1b\]|\u009d).*}
#review - distinguishing standalone codes vs those that are paired with contents considered part of the code
#e.g PM,SOS are 'paired' ended by ST
#variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""]
variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)}
variable re_standalones_vt52 {(?:\x1bZ)} variable re_standalones_vt52 {(?:\x1bZ)}
#ESC Y move, ESC b foreground colour # --
#ESC Y move - \x1bY<byte><byte> ie 2 bytes to close
#ESC b foreground colour - \x1bb<byte> 1 byte to close
variable re_vt52_incomplete {(?:\x1bY(.){0,1}$|\x1bb$)}
#\x1bc vt52 bgcolour conflict ?
#ESC F - gr-on ESC G - gr-off #ESC F - gr-on ESC G - gr-off
variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} # --
#\x1bc vt52 bgcolour conflict ??
#if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess
variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
variable re_g0_open {(?:\x1b\(0)} variable re_g0_open {(?:\x1b\(0)}
variable re_g0_close {(?:\x1b\(B)} variable re_g0_close {(?:\x1b\(B)}
#detect start of ansicode that is closed by ST
# DCS "ESC P" or "0x90" is also terminated by ST # DCS "ESC P" or "0x90" is also terminated by ST
set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)}
#ST terminators [list \007 \033\\ \u009c] #ST terminators [list \007 \033\\ \u009c]
@ -5777,12 +5873,15 @@ tcl::namespace::eval punk::ansi::ta {
variable re_ST {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)} variable re_ST {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)}
#variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
#variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_ST_open}|${re_vt52_incomplete}"
#consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open #consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open
#default for regexes is non-newline-sensitive matching - ie matches can span lines #default for regexes is non-newline-sensitive matching - ie matches can span lines
# -- --- --- --- # -- --- --- ---
variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" #variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}"
# -- --- --- --- # -- --- --- ---
#handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes
#This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone.
@ -5802,20 +5901,24 @@ tcl::namespace::eval punk::ansi::ta {
# plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode)
#regexp expanded syntax = ?x #regexp expanded syntax = ?x
#full detect - checking for closing sequences
variable re_ansi_detect {(?x) variable re_ansi_detect {(?x)
(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) (?:\x1b(?:\[(?:[\x20-\x3f]*[\x40-\x7e])|a|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8))))
|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)
|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] |(?:\u009b)[\x20-\x3f]*[\x40-\x7e]
|(?:\u009d)(?:[^\u009c]*)?\u009c |(?:\u009d)(?:[^\u009c]*)?\u009c
} }
#--- #---
#todo
#variable re_ansi_detectcode $re_ansi_detect
#variable re_ansi_detectcode {\x1b[\u0040-\u005F]|\x1b[\u0060-\u007e]|\x1b[\u0030-\u003F]|\x1b[\u0020-\u002F]+[\u0030-\u007E]}
variable re_ansi_detectcode {(?:\x1b(?:[\u0030-\u007E]|[\u0020-\u002F]+[\u0030-\u007E]))|[\u0090-\u009F]}
# -- --- --- --- # -- --- --- ---
#variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]}
variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
#may be same as detect - kept in case detect needs to diverge #may be same as detect - kept in case detect needs to diverge
#variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}"
@ -5827,20 +5930,6 @@ tcl::namespace::eval punk::ansi::ta {
set re_ansi_split_multi "(?:${re_ansi_split})+" set re_ansi_split_multi "(?:${re_ansi_split})+"
} }
lappend PUNKARGS [list -dynamic 0 {
@id -id ::punk::ansi::ta::detect
@cmd -name punk::ansi::ta::detect -help\
"Return a boolean indicating whether Ansi codes were detected in text.
Important caveat:
When text is a tcl list made from splitting (or lappending) some ansi string
- individual elements may be braced or have certain chars escaped.
(one example is if a list element contains an unbalanced brace)
This can cause square brackets that form part of the ansi to be backslash escaped
- and the function can fail to match it as an Ansi code.
"
@values -min 1
text -type string
} ]
#*** !doctools #*** !doctools
#[call [fun detect] [arg text]] #[call [fun detect] [arg text]]
@ -5851,10 +5940,35 @@ tcl::namespace::eval punk::ansi::ta {
#detect any ansi escapes #detect any ansi escapes
#review - only detect 'complete' codes - or just use the opening escapes for performance? #review - only detect 'complete' codes - or just use the opening escapes for performance?
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect
@cmd -name punk::ansi::ta::detect\
-summary\
"Test if text has completed ANSI codes"\
-help\
"Return a boolean indicating whether *complete* Ansi codes were detected in text.
By complete, it means that paired squences such as PM (privacy message) must be
closed. It also means that a truncated sequence such as \\x1b\\\[ or a lone escape
will not be detected as ANSI.
Use punk::ansi::ta::detectcode as a slightly faster detector for ANSI codes, that does
not require paired sequences to have both starting and end sequences to be detected.
Important caveat:
When text is a tcl list made from splitting (or lappending) some ansi string
- individual elements may be braced or have certain chars escaped.
(one example is if a list element contains an unbalanced brace)
This can cause square brackets that form part of the ansi to be backslash escaped
- and the function can fail to match it as an Ansi code.
"
@values -min 1
text -type string -help\
"Block of text. See caveat above about lists."
} ]
proc detect {text} [string map [list <re> [list $re_ansi_detect]] { proc detect {text} [string map [list <re> [list $re_ansi_detect]] {
regexp <re> $text regexp <re> $text
}] }]
#can be used on dicts - but will check keys too. keys could also contain ansi and have escapes #can be used on dicts - but will check keys too. keys could also contain ansi and have escapes
proc detect_in_list {list} { proc detect_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review) #loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
@ -5865,6 +5979,22 @@ tcl::namespace::eval punk::ansi::ta {
} }
return 0 return 0
} }
#will detect for example lone opening or closing PM
proc detectcode {text} [string map [list <re> [list $re_ansi_detectcode]] {
regexp <re> $text
}]
proc detectcode_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
foreach item $list {
if {[detectcode $item]} {
return 1
}
}
return 0
}
#surprisingly - the ::join operation can be (relatively) slow on lists containing ansi #surprisingly - the ::join operation can be (relatively) slow on lists containing ansi
proc detect_in_list2 {list} { proc detect_in_list2 {list} {
detect [join $list " "] detect [join $list " "]
@ -5915,6 +6045,8 @@ tcl::namespace::eval punk::ansi::ta {
variable re_sgr variable re_sgr
expr {[regexp $re_sgr $text]} expr {[regexp $re_sgr $text]}
} }
#perl: ta_strip
proc strip {text} { proc strip {text} {
#*** !doctools #*** !doctools
#[call [fun strip] [arg text]] #[call [fun strip] [arg text]]
@ -5922,6 +6054,39 @@ tcl::namespace::eval punk::ansi::ta {
#[para]This is a tailcall to punk::ansi::ansistrip #[para]This is a tailcall to punk::ansi::ansistrip
tailcall ansistrip $text tailcall ansistrip $text
} }
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::extract
@cmd -name punk::ansi::ta::extract\
-summary\
"Return only the ANSI codes in text"\
-help\
"This is the opposite of strip,
returning only the ANSI codes in text."
@values -min 1 -max 1
text -type string
} ]
proc extract {text} {
set parts [split_codes $text]
set out ""
foreach {pt code} $parts {
append out $code
}
return $out
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::length
@cmd -name punk::ansi::ta::length\
-summary\
"Calculate length of text (excluding the ANSI codes)"\
-help\
"Calculate length of text (excluding the ANSI codes)
This is not the printing length of the string on screen."
@values -min 1
text -type string
} ]
#perl: ta_length
proc length {text} { proc length {text} {
#*** !doctools #*** !doctools
#[call [fun length] [arg text]] #[call [fun length] [arg text]]
@ -5936,6 +6101,8 @@ tcl::namespace::eval punk::ansi::ta {
# #
#} #}
#perl: ta_trunc
#truncate $text to $width columns while still including all the ANSI colour codes.
proc trunc {text width args} { proc trunc {text width args} {
} }
@ -8504,6 +8671,10 @@ tcl::namespace::eval punk::ansi::internal {
} }
} }
tcl::namespace::eval punk::ansi {
namespace import ::punk::ansi::ta::detect
}
#inserting into global namespace like this should be kept to a minimum.. but this is considered a core aspect of punk::ansi #inserting into global namespace like this should be kept to a minimum.. but this is considered a core aspect of punk::ansi
#todo - document #todo - document
interp alias {} ansistring {} ::punk::ansi::ansistring interp alias {} ansistring {} ::punk::ansi::ansistring

39
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.tm

@ -1364,6 +1364,11 @@ tcl::namespace::eval punk::args {
#} #}
tcl::dict::set tmp_optspec_defaults -type $v tcl::dict::set tmp_optspec_defaults -type $v
} }
-defaultdisplaytype {
#how the -default is displayed
#-default doesn't have to be the same type as -type which validates user input that is not defaulted.
tcl::dict::set tmp_optspec_defaults -defaultdisplaytype $v
}
-parsekey { -parsekey {
tcl::dict::set tmp_optspec_defaults -parsekey $v tcl::dict::set tmp_optspec_defaults -parsekey $v
@ -1441,7 +1446,7 @@ tcl::namespace::eval punk::args {
default { default {
set known { -parsekey -group -grouphelp\ set known { -parsekey -group -grouphelp\
-any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\
-type -range -typeranges -default -typedefaults -type -range -typeranges -default -defaultdisplaytype -typedefaults
-choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\
-nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\
-type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\
@ -2052,6 +2057,9 @@ tcl::namespace::eval punk::args {
tcl::dict::set spec_merged -optional 1 tcl::dict::set spec_merged -optional 1
} }
} }
-defaultdisplaytype {
tcl::dict::set spec_merged -defaultdisplaytype $specval
}
-typedefaults { -typedefaults {
set typecount [llength [tcl::dict::get $spec_merged -type]] set typecount [llength [tcl::dict::get $spec_merged -type]]
if {$typecount != [llength $specval]} { if {$typecount != [llength $specval]} {
@ -2114,7 +2122,7 @@ tcl::namespace::eval punk::args {
-form -type\ -form -type\
-parsekey -group\ -parsekey -group\
-range -typeranges\ -range -typeranges\
-default -typedefaults\ -default -defaultdisplaytype -typedefaults\
-minsize -maxsize -choices -choicegroups\ -minsize -maxsize -choices -choicegroups\
-choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\
-nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\
@ -3784,7 +3792,32 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $arginfo -default]} { if {[dict exists $arginfo -default]} {
set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" #default isn't necessarily of same type as -type required for validation
#Guessing at the type from the data is likely to be unsatisfactory.
set defaultdisplaytype [Dict_getdef $arginfo -defaultdisplaytype string]
switch -- $defaultdisplaytype {
dict {
#single level
set rawdefault [dict get $arginfo -default]
set default "{\n"
dict for {k v} $rawdefault {
append default " \"$k\" \"$v\"\n"
}
append default "}"
}
list {
set default "{\n"
foreach v $rawdefault {
append default " \"$v\"\n"
}
append default "}"
}
default {
#set default "'$A_DEFAULT[dict get $arginfo -default]$RST'"
set default "'[dict get $arginfo -default]'"
}
}
} else { } else {
set default "" set default ""
} }

101
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/char-0.1.0.tm

@ -89,6 +89,107 @@ tcl::namespace::eval punk::char {
variable invalid "???" ;# ideally this would be 0xFFFD - which should display as black diamond/rhombus with question mark. As at 2023 - this tends to display indistinguishably from other missing glyph boxes - so we use a longer sequence we can detect by length and to display obviously variable invalid "???" ;# ideally this would be 0xFFFD - which should display as black diamond/rhombus with question mark. As at 2023 - this tends to display indistinguishably from other missing glyph boxes - so we use a longer sequence we can detect by length and to display obviously
variable invalid_display_char \u25ab; #todo - change to 0xFFFD once diamond glyph more common? variable invalid_display_char \u25ab; #todo - change to 0xFFFD once diamond glyph more common?
#more useful for referring to ANSI documentation would be a proper 7-bit and 8-bit 'Code Table' layout
#as described in ECMA-35 5.2
# where the positions of the table are in one-to-one correspondence with the bit combinations of the code.
#- for 7-bit: 8 columns 16 rows
#- for 8-bit 16 columns 16 rows
proc codetable {which} {
set bits 8
switch -- $which {
ascii8 {
set which default
}
ascii {
set bits 7
}
default {
if {$which ni [encoding names]} {
error "codetable unsupported - use 'ascii' or an entry from the result of the 'encoding names' command."
}
}
}
package require punk::ansi
set hibit_count [expr {$bits-4}]
set bitcolumns [expr {2**$hibit_count}] ;#always 4 bits for the rows - remaining bits for the columns
set columncount [expr {$bitcolumns + 6}]
#set header1 [list "" "b7\nb6\nb5" "0\n0\n0" "0\n0\n1" "0\n1\n0" "0\n1\n1" "1\n0\n0" "1\n0\n1" "1\n1\n0" "1\n1\n1"]
set header1 [list]
set hibits_label ""
set indent ""
for {set hb $bits} {$hb > 4} {incr hb -1} {
append hibits_label ${indent}b$hb\n
append indent " "
}
set hibits_label [string range $hibits_label 0 end-1]
lappend header1 $hibits_label "" "" "" "" ""
for {set colidx 0} {$colidx < $bitcolumns} {incr colidx} {
set binval [format %0${hibit_count}b $colidx]
set binvalbits [split $binval ""]
set indent ""
set display_hibits ""
foreach bb $binvalbits {
append display_hibits $indent$bb\n
append indent " "
}
set display_hibits [string range $display_hibits 0 end-1]
lappend header1 $display_hibits
}
#\u2193 down arrow
#right-down arrows
#\u2ba7
#\u21b4
#\u2b0e
set header2 [list " Bits" b4 b3 b2 b1 "column \u2192\nrow \u2b0e" {*}[punk::lib::range 0 $bitcolumns-1]]
set headers [list $header1 $header2]
#set t [textblock::table -return tableobject -rows $rows]
set t [textblock::table -return tableobject]
#todo - fix textblock::table to allow configure -columncount
for {set c 0} {$c < $columncount} {incr c} {
$t add_column
}
set vheaders [punk::transpose_equal_lists $headers]
set hidx -1
foreach vh $vheaders {
incr hidx
$t configure_column $hidx -headers $vh
}
$t configure_header 0 -colspans [list 6 0 0 0 0 0 {*}[lrepeat $bitcolumns 1]]
$t configure_column 0 -blockalign left
#always 16 rows - remaining bits form the columns
for {set ridx 0} {$ridx <= 15} {incr ridx} {
set charlist [list]
set lowbits [format %04b $ridx]
for {set i 0} {$i < $bitcolumns} {incr i} {
set hibits [format %0${hibit_count}b $i]
set ch [format %c [scan ${hibits}${lowbits} %b]]
#puts "-->${hibits}${lowbits} ch:$ch"
if {$which ne "default"} {
if {[catch {encoding convertfrom $which $ch} ch]} {
set ch [punk::ansi::a red bold]-[punk::ansi::a]
lappend charlist $ch
} else {
lappend charlist [punk::ansi::ansistring VIEW -lf 1 -vt 1 $ch]
}
} else {
lappend charlist [punk::ansi::ansistring VIEW -lf 1 -vt 1 $ch]
}
}
set r [list "" {*}[split $lowbits ""] $ridx {*}$charlist]
$t add_row $r
}
puts stderr $t
$t print
}
#just the 7-bit ascii. use [page ascii] for the 8-bit layout #just the 7-bit ascii. use [page ascii] for the 8-bit layout
proc ascii {} {return { proc ascii {} {return {
00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL 00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL

1
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm

@ -1336,6 +1336,7 @@ namespace eval punk::console {
#https://vt100.net/docs/vt510-rm/DA1.html #https://vt100.net/docs/vt510-rm/DA1.html
# #
proc get_device_attributes {{inoutchannels {stdin stdout}}} { proc get_device_attributes {{inoutchannels {stdin stdout}}} {
#Note the vt52 rough equivalen \x1bZ - commonly supported but probably best considered obsolete as it collides with ECMA 48 SCI Single Character Introducer
#DA1 #DA1
variable last_da1_result variable last_da1_result
#first element in result is the terminal's architectural class 61,62,63,64.. ? #first element in result is the terminal's architectural class 61,62,63,64.. ?

126
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm

@ -2242,6 +2242,121 @@ namespace eval punk::lib {
} }
} }
#review - compare to IMAP4 methods of specifying ranges?
punk::args::define {
@id -id ::punk::lib::indexset_resolve
@cmd -name punk::lib::indexset_resolve\
-summary\
"Resolve an indexset to a list of integers based on supplied list or string length."\
-help\
"Resolve an 'indexset' to a list of actual indices within the range of the provided numitems value.
An indexset consists of a comma delimited list of indexes or index-ranges.
The indexes are 0-based.
Ranges must be specified with .. as the separator.
Whitespace is ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
end means the last page.
end-1 means the second last page.
0.. is the same as 0..end.
examples:
1,3..
output the page index 1 (2nd page) followed by all from index 3 to the end.
0-2,end
output the first 3 pages, and the last page.
end-1..0
output the indexes in reverse order from 2nd last page to first page."
@values -min 2 -max 2
numitems -type integer
indexset -type string
}
proc indexset_resolve {numitems indexset} {
if {![string is integer -strict $numitems] || ![regexp {^[\-\+_end,\.0-9]*$} $indexset]} {
#use parser on unhappy path only
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg]
}
set index_list [list] ;#list of actual indexes within the range
set iparts [split $indexset ,]
set index_list [list]
foreach ipart $iparts {
set ipart [string trim $ipart]
set rposn [string first .. $ipart]
if {$rposn>=0} {
#range
lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn+2] rawa _ rawb
set rawa [string trim $rawa]
set rawb [string trim $rawb]
if {$rawa eq ""} {set rawa 0}
set a [punk::lib::lindex_resolve $numitems $rawa]
if {$a == -3} {
#undershot - leave negative
} elseif {$a == -2 && $rawa ne "-2"} {
#overshot
set a [expr {$numitems}] ;#put it outside the range on the upper side
}
if {$rawb eq ""} {
if {$a > $numitems-1} {
set rawb $a ;#make sure <overshot>.. doesn't return last item - should return nothing
} else {
set rawb end
}
}
set b [punk::lib::lindex_resolve $numitems $rawb]
if {$b == -3} {
#undershot - leave negative
} elseif {$b == -2 && $rawb ne "-2"} {
set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side
}
#e.g make sure <overshot>.. doesn't return last item - should return nothing as both are above the range.
if {$a >= 0 && $a <= $numitems-1 && $b >=0 && $b <= $numitems-1} {
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else {
if {$a >= 0 && $a <= $numitems-1} {
#only a is in the range
if {$b < 0} {
set b 0
} else {
set b [expr {$numitems-1}]
}
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$b >=0 && $b <= $numitems-1} {
#only b is in the range
if {$a < 0} {
set a 0
} else {
set a [expr {$numitems-1}]
}
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else {
#both outside the range
if {$a < 0 && $b > 0} {
#spans the range in forward order
set a 0
set b [expr {$numitems-1}]
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$a > 0 && $b < 0} {
#spans the range in reverse order
set a [expr {$numitems-1}]
set b 0
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
}
#both outside of range on same side
}
}
} else {
set idx [punk::lib::lindex_resolve_basic $numitems $ipart]
if {$idx >= 0} {
lappend index_list $idx
}
}
}
return $index_list
}
# showdict uses lindex_resolve results -2 & -3 to determine whether index is out of bounds on upper vs lower side # showdict uses lindex_resolve results -2 & -3 to determine whether index is out of bounds on upper vs lower side
#REVIEW: This shouldn't really need the list itself - just the length would suffice #REVIEW: This shouldn't really need the list itself - just the length would suffice
punk::args::define { punk::args::define {
@ -2305,7 +2420,8 @@ namespace eval punk::lib {
#<0 ? #<0 ?
error "lindex_resolve len must be an integer" error "lindex_resolve len must be an integer"
} }
set index [tcl::string::map {_ {}} $index] ;#forward compatibility with integers such as 1_000 set index [tcl::string::map {_ {}} $index] ;#basic forward compatibility with integers such as 1_000 for 8.6
#todo - be stricter about malformations such as 1000_
if {[string is integer -strict $index]} { if {[string is integer -strict $index]} {
#can match +i -i #can match +i -i
if {$index < 0} { if {$index < 0} {
@ -3345,8 +3461,12 @@ namespace eval punk::lib {
#NOTE: running ta::detect on a list (or dict) as a whole can be problematic if items in the list have backslash escapes due to Tcl list quoting and escaping behaviour. #NOTE: running ta::detect on a list (or dict) as a whole can be problematic if items in the list have backslash escapes due to Tcl list quoting and escaping behaviour.
#This commonly happens if there is an unbalanced brace (which is a normal occurrence and needs to be handled) #This commonly happens if there is an unbalanced brace (which is a normal occurrence and needs to be handled)
#ta::detect on a list of ansi-containing string may appear to work for some simple inputs but is not reliable #ta::detect on a list of ansi-containing string may appear to work for some simple inputs but is not reliable
#detect_in_list will check at first level. (not intended for detecting ansi in deeper structures) #detect_in_list/detectcode_in_list will check at first level. (not intended for detecting ansi in deeper structures)
if {![punk::ansi::ta::detect_in_list $linelist]} {
#we use detectcode_in_list instead of detect_in_list
#detectcode_in_list will detect unclosed (or unopened) paired sequences such as PM (privacy message)
# - but the main reason is it is slightly faster.
if {![punk::ansi::ta::detectcode_in_list $linelist]} {
if {$opt_ansiresets} { if {$opt_ansiresets} {
foreach ln $linelist { foreach ln $linelist {
lappend transformed $RST$ln$RST lappend transformed $RST$ln$RST

16
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm

@ -13,6 +13,9 @@
# @@ Meta End # @@ Meta End
#BUGS
# 2025-08
# n// and n/// won't output info about 'namespace path' if there are no commands in the namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements ## Requirements
@ -1235,7 +1238,7 @@ tcl::namespace::eval punk::ns {
if {[dict size [dict get $nsdict namespacepath]]} { if {[dict size [dict get $nsdict namespacepath]]} {
set path_text "" set path_text ""
if {!$opt_nspathcommands} { if {!$opt_nspathcommands} {
append path_text \n " Also resolving cmds in namespace paths: [dict keys [dict get $nsdict namespacepath]]" append path_text \n " Also resolving cmds in namespace paths: [dict keys [dict get $nsdict namespacepath]] (use n/// to display)"
} else { } else {
append path_text \n " Also resolving cmds in namespace paths:" append path_text \n " Also resolving cmds in namespace paths:"
set nspathdict [dict get $nsdict namespacepath] set nspathdict [dict get $nsdict namespacepath]
@ -1247,8 +1250,17 @@ tcl::namespace::eval punk::ns {
} }
} else { } else {
#todo - change to display in column order to be same as main command listing #todo - change to display in column order to be same as main command listing
set parentcommands [dict get $nsdict commands]
dict for {k v} $nspathdict { dict for {k v} $nspathdict {
set pathcommands [dict get $v commands] set rawpathcommands [dict get $v commands]
set pathcommands [list]
foreach c $rawpathcommands {
if {$c in $parentcommands} {
lappend pathcommands [punk::ansi::a strike]$c[a]
} else {
lappend pathcommands $c
}
}
set columns 6 set columns 6
if {[llength $pathcommands] < 6} { if {[llength $pathcommands] < 6} {
set columns [llength $v] set columns [llength $v]

40
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.2.tm

@ -579,13 +579,15 @@ namespace eval shellfilter::chan {
#punk::ansi::ansistrip converts at least some of the box drawing G0 chars to unicode - todo - more complete conversion #punk::ansi::ansistrip converts at least some of the box drawing G0 chars to unicode - todo - more complete conversion
#assumes line-buffering. a more advanced filter required if ansicodes can arrive split across separate read or write operations! #assumes line-buffering. a more advanced filter required if ansicodes can arrive split across separate read or write operations!
oo::class create ansistrip { oo::class create ansistrip {
variable o_trecord variable o_trecord
variable o_enc variable o_enc
variable o_encbuf
variable o_is_junction variable o_is_junction
constructor {tf} { constructor {tf} {
package require punk::ansi package require punk::ansi
set o_trecord $tf set o_trecord $tf
set o_enc [dict get $tf -encoding] set o_enc [dict get $tf -encoding]
set o_encbuf ""
if {[dict exists $tf -junction]} { if {[dict exists $tf -junction]} {
set o_is_junction [dict get $tf -junction] set o_is_junction [dict get $tf -junction]
} else { } else {
@ -614,10 +616,36 @@ namespace eval shellfilter::chan {
method flush {transform_handle} { method flush {transform_handle} {
return "" return ""
} }
#method write {transform_handle bytes} {
# #broken due to occasional unexpected byte sequence
# set instring [encoding convertfrom $o_enc $bytes]
# set outstring [punk::ansi::ansistrip $instring]
# return [encoding convertto $o_enc $outstring]
#}
method write {transform_handle bytes} { method write {transform_handle bytes} {
set instring [encoding convertfrom $o_enc $bytes] #set instring [tcl::encoding::convertfrom $o_enc $bytes] ;naive approach will break due to unexpected byte sequence - occasionally
set outstring [punk::ansi::ansistrip $instring] #bytes can break at arbitrary points making encoding conversions invalid.
return [encoding convertto $o_enc $outstring]
set inputbytes $o_encbuf$bytes
set o_encbuf ""
set tail_offset 0
while {$tail_offset < [string length $inputbytes] && [catch {tcl::encoding::convertfrom $o_enc [string range $inputbytes 0 end-$tail_offset]} stringdata]} {
incr tail_offset
}
if {$tail_offset > 0} {
if {$tail_offset < [string length $inputbytes]} {
#stringdata from catch statement must be a valid result
set t [expr {$tail_offset - 1}]
set o_encbuf [string range $inputbytes end-$t end]
} else {
set stringdata ""
set o_encbuf $inputbytes
return ""
}
}
set outstring [punk::ansi::ansistrip $stringdata]
return [tcl::encoding::convertto $o_enc $outstring]
} }
method meta_is_redirection {} { method meta_is_redirection {} {
return $o_is_junction return $o_is_junction
@ -724,6 +752,8 @@ namespace eval shellfilter::chan {
set emit "" set emit ""
if {[string last \x1b $buf] >= 0} { if {[string last \x1b $buf] >= 0} {
#detect will detect ansi SGR and gron groff and other codes #detect will detect ansi SGR and gron groff and other codes
#REVIEW - ta::detect won't detect SOS without paired ST for things like PM
# ta::detectcode will - but then split_codes_single will treat unpaired SOS as text?
if {[punk::ansi::ta::detect $buf]} { if {[punk::ansi::ta::detect $buf]} {
#split_codes_single regex faster than split_codes - but more resulting parts #split_codes_single regex faster than split_codes - but more resulting parts
#'single' refers to number of escapes - but can still contain e.g multiple SGR codes (or mode set operations etc) #'single' refers to number of escapes - but can still contain e.g multiple SGR codes (or mode set operations etc)
@ -1035,7 +1065,7 @@ namespace eval shellfilter::chan {
} }
#todo - something #todo - something
oo::class create rebuffer { oo::class create rebuffer {
variable o_trecord variable o_trecord
variable o_enc variable o_enc
constructor {tf} { constructor {tf} {
set o_trecord $tf set o_trecord $tf

28
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm

@ -2528,7 +2528,7 @@ tcl::namespace::eval textblock {
set ansiborder_final $ansiborder_body_col_row set ansiborder_final $ansiborder_body_col_row
#$c will always have ansi resets due to overtype behaviour ? #$c will always have ansi resets due to overtype behaviour ?
#todo - review overtype #todo - review overtype
if {[punk::ansi::ta::detect $c]} { if {[punk::ansi::ta::detectcode $c]} {
#use only the last ansi sequence in the cell value #use only the last ansi sequence in the cell value
#Filter out foreground and use background for ansiborder override #Filter out foreground and use background for ansiborder override
set parts [punk::ansi::ta::split_codes_single $c] set parts [punk::ansi::ta::split_codes_single $c]
@ -4377,6 +4377,7 @@ tcl::namespace::eval textblock {
if {![punk::ansi::ta::detect $block]} { if {![punk::ansi::ta::detect $block]} {
return $block return $block
} }
#could be newine in SOS/PM? review - terminal should theoretically ignore all chars til close of string
foreach ln [split $block \n] { foreach ln [split $block \n] {
set parts [punk::ansi::ta::split_codes $ln] set parts [punk::ansi::ta::split_codes $ln]
if {[lindex $parts 0] eq ""} { if {[lindex $parts 0] eq ""} {
@ -4894,7 +4895,9 @@ tcl::namespace::eval textblock {
} }
set textblock [textutil::tabify::untabify2 $textblock $tw] set textblock [textutil::tabify::untabify2 $textblock $tw]
} }
if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #review detectcode vs detect. detectcode won't look for completness of all codes to give a positive result
#ansistripraw splits on complete codes..
if {[string length $textblock] > 1 && [punk::ansi::ta::detectcode $textblock]} {
#ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions)
set textblock [punk::ansi::ansistripraw $textblock] set textblock [punk::ansi::ansistripraw $textblock]
} }
@ -4917,7 +4920,9 @@ tcl::namespace::eval textblock {
} else { } else {
set tl $textblock set tl $textblock
} }
if {[punk::ansi::ta::detect $tl]} { #review detectcode vs detect. detectcode won't look for completness of all codes to give a positive result
#ansistripraw splits on complete codes..
if {[punk::ansi::ta::detectcode $tl]} {
set tl [punk::ansi::ansistripraw $tl] set tl [punk::ansi::ansistripraw $tl]
} }
return [punk::char::ansifreestring_width $tl] return [punk::char::ansifreestring_width $tl]
@ -4964,7 +4969,7 @@ tcl::namespace::eval textblock {
set textblock [textutil::tabify::untabify2 $textblock $tw] set textblock [textutil::tabify::untabify2 $textblock $tw]
} }
#ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests
if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { if {[string length $textblock] > 1 && [punk::ansi::ta::detectcode $textblock]} {
set textblock [punk::ansi::ansistripraw $textblock] set textblock [punk::ansi::ansistripraw $textblock]
} }
if {[tcl::string::last \n $textblock] >= 0} { if {[tcl::string::last \n $textblock] >= 0} {
@ -5211,7 +5216,7 @@ tcl::namespace::eval textblock {
set known_hasansi [tcl::dict::get $opts -known_hasansi] set known_hasansi [tcl::dict::get $opts -known_hasansi]
if {$known_hasansi eq ""} { if {$known_hasansi eq ""} {
set block_has_ansi [punk::ansi::ta::detect $block] set block_has_ansi [punk::ansi::ta::detectcode $block]
} else { } else {
set block_has_ansi $known_hasansi set block_has_ansi $known_hasansi
} }
@ -5648,7 +5653,7 @@ tcl::namespace::eval textblock {
set rowcount 0 set rowcount 0
set blocklists [list] set blocklists [list]
foreach b $blocks { foreach b $blocks {
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
#-ansireplays 1 quite expensive e.g 7ms in 2024 #-ansireplays 1 quite expensive e.g 7ms in 2024
set bl [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] set bl [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b]
} else { } else {
@ -5676,7 +5681,7 @@ tcl::namespace::eval textblock {
set i -1 set i -1
foreach b $args { foreach b $args {
incr i incr i
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
#-ansireplays 1 quite expensive e.g 7ms in 2024 #-ansireplays 1 quite expensive e.g 7ms in 2024
set blines [punk::lib::lines_as_list -ansireplays 1 -ansiresets auto -- $b] set blines [punk::lib::lines_as_list -ansireplays 1 -ansiresets auto -- $b]
} else { } else {
@ -5799,7 +5804,7 @@ tcl::namespace::eval textblock {
#testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway. #testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway.
#blocks passed to join can be ragged - so we can't pass -known_samewidth to pad #blocks passed to join can be ragged - so we can't pass -known_samewidth to pad
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
# - we need to join to use pad - even though we then need to immediately resplit REVIEW (make line list version of pad?) # - we need to join to use pad - even though we then need to immediately resplit REVIEW (make line list version of pad?)
set replay_block [::join [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] \n] set replay_block [::join [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] \n]
#set blines [split [textblock::pad $replay_block -known_hasansi 1 -known_samewidth $is_samewidth -known_blockwidth $bwidth -width $bwidth -which right -padchar " "] \n] #set blines [split [textblock::pad $replay_block -known_hasansi 1 -known_samewidth $is_samewidth -known_blockwidth $bwidth -width $bwidth -which right -padchar " "] \n]
@ -8650,7 +8655,7 @@ tcl::namespace::eval textblock {
set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $underlay $cache_contentpattern] set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $underlay $cache_contentpattern]
#puts "frame--->ansiwrap -rawansi [ansistring VIEW $opt_ansibase] $cache_inner" #puts "frame--->ansiwrap -rawansi [ansistring VIEW $opt_ansibase] $cache_inner"
if {$opt_ansibase ne ""} { if {$opt_ansibase ne ""} {
if {[punk::ansi::ta::detect $cache_inner]} { if {[punk::ansi::ta::detectcode $cache_inner]} {
#set cache_inner [punk::ansi::ansiwrap -rawansi $opt_ansibase $cache_inner] #set cache_inner [punk::ansi::ansiwrap -rawansi $opt_ansibase $cache_inner]
#set cache_inner [punk::ansi::ansiwrap_raw $opt_ansibase "" "" $cache_inner] #set cache_inner [punk::ansi::ansiwrap_raw $opt_ansibase "" "" $cache_inner]
#jjj ??? review #jjj ??? review
@ -8745,7 +8750,7 @@ tcl::namespace::eval textblock {
#set cwidth [textblock::width $contents] #set cwidth [textblock::width $contents]
#JJJ #JJJ
set contents_has_ansi [punk::ansi::ta::detect $contents] set contents_has_ansi [punk::ansi::ta::detectcode $contents]
if {$opt_ansibase ne ""} { if {$opt_ansibase ne ""} {
if {$contents_has_ansi} { if {$contents_has_ansi} {
#set contents [punk::ansi::ansiwrap -rawansi $opt_ansibase $contents] #set contents [punk::ansi::ansiwrap -rawansi $opt_ansibase $contents]
@ -8799,8 +8804,9 @@ tcl::namespace::eval textblock {
if {$subposn >= 0} { if {$subposn >= 0} {
set content_line [lindex $clines $contentindex] set content_line [lindex $clines $contentindex]
#review - different forms of reset e.g \x1b\[m ?? #review - different forms of reset e.g \x1b\[m ??
if {[string range $content_line 0 3] eq "\x1b\[0m"} { if {[tcl::string::range $content_line 0 3] eq "\x1b\[0m"} {
set content_line [tcl::string::range $content_line 4 end] set content_line [tcl::string::range $content_line 4 end]
#::tcl::string::replace content_line 0 3
} }
append content_line $opt_ansibase append content_line $opt_ansibase
append fs [tcl::string::replace $tline $subposn $subposn+$pattern_offset $content_line] \n append fs [tcl::string::replace $tline $subposn $subposn+$pattern_offset $content_line] \n

2
src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl

@ -3075,7 +3075,7 @@ foreach vfstail $vfs_tails {
#copy the version that is mounted in this runtime to vfsname.new #copy the version that is mounted in this runtime to vfsname.new
if {[catch { if {[catch {
file copy -force $building_runtime $buildfolder/$vfsname.new file copy -force $building_runtime $buildfolder/$vfsname.new
catch {exec chmod +x $buildfolder/$vfsname.new} catch {exec chmod +w $buildfolder/$vfsname.new}
} errM]} { } errM]} {
puts stderr "$kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM" puts stderr "$kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM"
error $errM error $errM

5
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/flagfilter-0.3.tm

@ -1538,6 +1538,7 @@ namespace eval flagfilter {
} }
} }
#todo - rename 'cprocessor' is misleading
oo::class create cprocessor { oo::class create cprocessor {
variable o_runid variable o_runid
variable o_name variable o_name
@ -1577,7 +1578,9 @@ namespace eval flagfilter {
if {[dict exists $o_pinfo match]} { if {[dict exists $o_pinfo match]} {
set o_matchspec [dict get $o_pinfo match] set o_matchspec [dict get $o_pinfo match]
} else { } else {
set o_matchspec {^[^-^/].*} ;#match anything that isn't flaglike #review - unix paths? conflict with windows style flag such as /w
#must accept empty string
set o_matchspec {^[^-^/].*|^$} ;#match anything that isn't flaglike
} }
set o_found_match 0 set o_found_match 0
set o_matched_argument "" ;#need o_found_match to differentiate match of empty string set o_matched_argument "" ;#need o_found_match to differentiate match of empty string

16
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm

@ -6947,7 +6947,8 @@ namespace eval punk {
set newrow {} set newrow {}
foreach oldrow $list_rows { foreach oldrow $list_rows {
if {$j >= [llength $oldrow]} { if {$j >= [llength $oldrow]} {
continue #continue
lappend newrow ""
} else { } else {
lappend newrow [lindex $oldrow $j] lappend newrow [lindex $oldrow $j]
} }
@ -6956,6 +6957,19 @@ namespace eval punk {
} }
return $res return $res
} }
proc transpose_equal_lists {list_rows} {
set columns [list]
set rowidx -1
foreach l $list_rows {
set colidx -1
incr rowidx
foreach val $l {
incr colidx
lset columns $colidx $rowidx $val
}
}
return $columns
}
proc transpose_strings {list_of_strings} { proc transpose_strings {list_of_strings} {
set charlists [lmap v $list_of_strings {split $v ""}] set charlists [lmap v $list_of_strings {split $v ""}]
set tchars [transpose_lists $charlists] set tchars [transpose_lists $charlists]

237
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -3785,7 +3785,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set codestack [list] set codestack [list]
if {[punk::ansi::ta::detect $text]} { if {[punk::ansi::ta::detectcode $text]} {
set emit "" set emit ""
#set parts [punk::ansi::ta::split_codes $text] #set parts [punk::ansi::ta::split_codes $text]
set parts [punk::ansi::ta::split_codes_single $text] set parts [punk::ansi::ta::split_codes_single $text]
@ -3892,7 +3892,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set codestack [list] set codestack [list]
if {[punk::ansi::ta::detect $text]} { if {[punk::ansi::ta::detectcode $text]} {
set emit "" set emit ""
#set parts [punk::ansi::ta::split_codes $text] #set parts [punk::ansi::ta::split_codes $text]
set parts [punk::ansi::ta::split_codes_single $text] set parts [punk::ansi::ta::split_codes_single $text]
@ -4158,7 +4158,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# where line and column are ascii codes whose values are +31 # where line and column are ascii codes whose values are +31
# vt52 can be entered/exited via escapes # vt52 can be entered/exited via escapes
# This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type
# (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) # (vt52 supports ESC Z (obs DECID) - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ )
#ESC\[c - is more modern equiv of DECID
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::ansi::vt52move @id -id ::punk::ansi::vt52move
@ -4946,6 +4947,8 @@ to 223 (=255 - 32)
} }
if {[string length $text] < 2} {return $text} if {[string length $text] < 2} {return $text}
set parts [punk::ansi::ta::split_codes $text] set parts [punk::ansi::ta::split_codes $text]
#review - if we have only one element of a paired codeset such as PM,SOS - it will not be found by split_codes
#The output technically then still contains ansi (which may for example be hidden by terminal despite lack of closing ST)
if {[llength $parts] == 1} {return [lindex $parts 0]} if {[llength $parts] == 1} {return [lindex $parts 0]}
set out "" set out ""
#todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] ""
@ -5686,21 +5689,106 @@ tcl::namespace::eval punk::ansi {
#[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}] #[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}]
} }
tcl::namespace::eval sequence_type { tcl::namespace::eval sequence_type {
proc is_Fe {code} { #first byte after ESC identifies code type
#NOTE - we are looking for valid start of a single sequence here
#- not whether it is complete or where it ends, unless it's a fixed number of bytes
#\u0020-\u002F
# ESC <sp>!"#$%&'()*+,-./
#\u0030-\u003F
#ESC 0-9:;<=>?
#\u0040-\u005F
# ESC @A-Z[\]^
#\u0060-\u007E
proc is_Fe7 {code} {
# C1 control codes # C1 control codes
if {[regexp {^\033\[[\u0040-\u005F]}]} { #7bit - typical case
#7bit - typical case # ESC @A-Z[\]^
return 1 return [regexp {^\033[\u0040-\u005F]} $code]
} }
proc is_Fe {code} {
#although Fe7 more common - we'll put the simpler regex for 8 first
return [expr {[is_Fe8 $code] || [is_Fe7 $code]}]
}
proc is_Fe8 {code} {
#8bit #8bit
#review - all C1 escapes ? 0x80-0x90F #review - all C1 escapes ? 0x80-0x9F
#This is possibly problematic as it is affected by encoding. #This is possibly problematic as it is affected by encoding.
#According to https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit #According to https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit
#"However, in character encodings used on modern devices such as UTF-8 or CP-1252, those codes are often used for other purposes, so only the 2-byte sequence is typically used." #"However, in character encodings used on modern devices such as UTF-8 or CP-1252, those codes are often used for other purposes, so only the 2-byte sequence is typically used."
return 0 return [regexp {^[\u0080-\u09F]} $code]
}
#ESC 0-9,:,;,<,=,>,?
proc is_Fp {code} {
#single byte following ESC
return [regexp {^\033[\u0030-\u003F]$} $code]
} }
#https://en.wikipedia.org/wiki/ISO/IEC_2022
#e.g
# ESC a (INT) interrupts the current process
# ESC c (RIS) reset terminal to initial state
#ESC `a-z{|}~
proc is_Fs {code} { proc is_Fs {code} {
puts stderr "is_Fs unimplemented" #single byte following ESC
return [regexp {^\033[\u0060-\u007E]$} $code]
}
proc is_nF {code} {
#2 bytes
#subcategorised by the low two bits of the first byte (n)
#further by whether the final byte is in \u0030-u003f (p) or not (t)
return [regexp {^\033[\u0020-\u002F]+[\u0030-\u007E]$} $code]
}
#review - test
#3Fp - private use
#e.g vt100
# ESC#3 DECDHL double-height letters top half
# ESC#4 DECDHL double-height letters bottom half
# ESC#5 DECSWL single-width line
# ESC#6 DECDWL double-width line
proc is_3Fp {code} {
return [regexp {^\033#[\u0020-\u002F]*[\u0030-\u003F]$} $code] ;#check regexp
}
proc is_code7 {code} {
#Fe | Fs | Fp | nF | Fe
return [regexp {^\033[\u0040-\u005F]|^\033[\u0060-\u007e]$|^\033[\u0030-\u003F]$|^\033[\u0020-\u002F]+[\u0030-\u007E]$} $code]
}
proc is_code8 {code} {
return [regexp {^[\u0080-\u09F]} $code]
}
proc is_code {code} {
return [expr {[is_code8 $code] || [is_code7 $code]}]
}
proc classify {code} {
return [switch -regexp -- $code {
{^\033[\u0030-\u003F]$} {string cat Fp}
{^[\u0080-\u009F]|^\033[\u0040-\u005F]} {string cat Fe}
{^\033[\u0060-\u007E]$} {string cat Fs}
{^\033[\u0020-\u002F]+[\u0030-\u007E]$} {
#nF sequences
set firstbytenum [scan [string index $code 1] %c]
set lastbyte [string index $code end]
set n [expr {$firstbytenum & 3}]
if {[regexp {[\u0030-\u003F]} $lastbyte]} {
set tp p
} else {
set tp t
}
string cat ${n}F$tp
}
{^\033#[\u0020-\u002F]*[\u0030-\u003F]$} {string cat 3Fp}
default {string cat unknown}
}]
} }
} }
# -- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- ---
@ -5718,6 +5806,7 @@ tcl::namespace::eval punk::ansi::ta {
#[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm #[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm
#[list_begin definitions] #[list_begin definitions]
tcl::namespace::path ::punk::ansi tcl::namespace::path ::punk::ansi
namespace export detect detect_in_list detect_sgr extract length split_codes split_at_codes split_codes_single
variable PUNKARGS variable PUNKARGS
@ -5748,20 +5837,27 @@ tcl::namespace::eval punk::ansi::ta {
variable re_osc_open {(?:\x1b\]|\u009d).*} variable re_osc_open {(?:\x1b\]|\u009d).*}
#review - distinguishing standalone codes vs those that are paired with contents considered part of the code
#e.g PM,SOS are 'paired' ended by ST
#variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""]
variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)}
variable re_standalones_vt52 {(?:\x1bZ)} variable re_standalones_vt52 {(?:\x1bZ)}
#ESC Y move, ESC b foreground colour # --
#ESC Y move - \x1bY<byte><byte> ie 2 bytes to close
#ESC b foreground colour - \x1bb<byte> 1 byte to close
variable re_vt52_incomplete {(?:\x1bY(.){0,1}$|\x1bb$)}
#\x1bc vt52 bgcolour conflict ?
#ESC F - gr-on ESC G - gr-off #ESC F - gr-on ESC G - gr-off
variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} # --
#\x1bc vt52 bgcolour conflict ??
#if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess
variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
variable re_g0_open {(?:\x1b\(0)} variable re_g0_open {(?:\x1b\(0)}
variable re_g0_close {(?:\x1b\(B)} variable re_g0_close {(?:\x1b\(B)}
#detect start of ansicode that is closed by ST
# DCS "ESC P" or "0x90" is also terminated by ST # DCS "ESC P" or "0x90" is also terminated by ST
set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)}
#ST terminators [list \007 \033\\ \u009c] #ST terminators [list \007 \033\\ \u009c]
@ -5777,12 +5873,15 @@ tcl::namespace::eval punk::ansi::ta {
variable re_ST {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)} variable re_ST {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)}
#variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
#variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_ST_open}|${re_vt52_incomplete}"
#consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open #consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open
#default for regexes is non-newline-sensitive matching - ie matches can span lines #default for regexes is non-newline-sensitive matching - ie matches can span lines
# -- --- --- --- # -- --- --- ---
variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" #variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}"
# -- --- --- --- # -- --- --- ---
#handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes
#This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone.
@ -5802,20 +5901,24 @@ tcl::namespace::eval punk::ansi::ta {
# plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode)
#regexp expanded syntax = ?x #regexp expanded syntax = ?x
#full detect - checking for closing sequences
variable re_ansi_detect {(?x) variable re_ansi_detect {(?x)
(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) (?:\x1b(?:\[(?:[\x20-\x3f]*[\x40-\x7e])|a|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8))))
|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)
|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] |(?:\u009b)[\x20-\x3f]*[\x40-\x7e]
|(?:\u009d)(?:[^\u009c]*)?\u009c |(?:\u009d)(?:[^\u009c]*)?\u009c
} }
#--- #---
#todo
#variable re_ansi_detectcode $re_ansi_detect
#variable re_ansi_detectcode {\x1b[\u0040-\u005F]|\x1b[\u0060-\u007e]|\x1b[\u0030-\u003F]|\x1b[\u0020-\u002F]+[\u0030-\u007E]}
variable re_ansi_detectcode {(?:\x1b(?:[\u0030-\u007E]|[\u0020-\u002F]+[\u0030-\u007E]))|[\u0090-\u009F]}
# -- --- --- --- # -- --- --- ---
#variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]}
variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}"
#may be same as detect - kept in case detect needs to diverge #may be same as detect - kept in case detect needs to diverge
#variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}"
@ -5827,20 +5930,6 @@ tcl::namespace::eval punk::ansi::ta {
set re_ansi_split_multi "(?:${re_ansi_split})+" set re_ansi_split_multi "(?:${re_ansi_split})+"
} }
lappend PUNKARGS [list -dynamic 0 {
@id -id ::punk::ansi::ta::detect
@cmd -name punk::ansi::ta::detect -help\
"Return a boolean indicating whether Ansi codes were detected in text.
Important caveat:
When text is a tcl list made from splitting (or lappending) some ansi string
- individual elements may be braced or have certain chars escaped.
(one example is if a list element contains an unbalanced brace)
This can cause square brackets that form part of the ansi to be backslash escaped
- and the function can fail to match it as an Ansi code.
"
@values -min 1
text -type string
} ]
#*** !doctools #*** !doctools
#[call [fun detect] [arg text]] #[call [fun detect] [arg text]]
@ -5851,10 +5940,35 @@ tcl::namespace::eval punk::ansi::ta {
#detect any ansi escapes #detect any ansi escapes
#review - only detect 'complete' codes - or just use the opening escapes for performance? #review - only detect 'complete' codes - or just use the opening escapes for performance?
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect
@cmd -name punk::ansi::ta::detect\
-summary\
"Test if text has completed ANSI codes"\
-help\
"Return a boolean indicating whether *complete* Ansi codes were detected in text.
By complete, it means that paired squences such as PM (privacy message) must be
closed. It also means that a truncated sequence such as \\x1b\\\[ or a lone escape
will not be detected as ANSI.
Use punk::ansi::ta::detectcode as a slightly faster detector for ANSI codes, that does
not require paired sequences to have both starting and end sequences to be detected.
Important caveat:
When text is a tcl list made from splitting (or lappending) some ansi string
- individual elements may be braced or have certain chars escaped.
(one example is if a list element contains an unbalanced brace)
This can cause square brackets that form part of the ansi to be backslash escaped
- and the function can fail to match it as an Ansi code.
"
@values -min 1
text -type string -help\
"Block of text. See caveat above about lists."
} ]
proc detect {text} [string map [list <re> [list $re_ansi_detect]] { proc detect {text} [string map [list <re> [list $re_ansi_detect]] {
regexp <re> $text regexp <re> $text
}] }]
#can be used on dicts - but will check keys too. keys could also contain ansi and have escapes #can be used on dicts - but will check keys too. keys could also contain ansi and have escapes
proc detect_in_list {list} { proc detect_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review) #loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
@ -5865,6 +5979,22 @@ tcl::namespace::eval punk::ansi::ta {
} }
return 0 return 0
} }
#will detect for example lone opening or closing PM
proc detectcode {text} [string map [list <re> [list $re_ansi_detectcode]] {
regexp <re> $text
}]
proc detectcode_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
foreach item $list {
if {[detectcode $item]} {
return 1
}
}
return 0
}
#surprisingly - the ::join operation can be (relatively) slow on lists containing ansi #surprisingly - the ::join operation can be (relatively) slow on lists containing ansi
proc detect_in_list2 {list} { proc detect_in_list2 {list} {
detect [join $list " "] detect [join $list " "]
@ -5915,6 +6045,8 @@ tcl::namespace::eval punk::ansi::ta {
variable re_sgr variable re_sgr
expr {[regexp $re_sgr $text]} expr {[regexp $re_sgr $text]}
} }
#perl: ta_strip
proc strip {text} { proc strip {text} {
#*** !doctools #*** !doctools
#[call [fun strip] [arg text]] #[call [fun strip] [arg text]]
@ -5922,6 +6054,39 @@ tcl::namespace::eval punk::ansi::ta {
#[para]This is a tailcall to punk::ansi::ansistrip #[para]This is a tailcall to punk::ansi::ansistrip
tailcall ansistrip $text tailcall ansistrip $text
} }
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::extract
@cmd -name punk::ansi::ta::extract\
-summary\
"Return only the ANSI codes in text"\
-help\
"This is the opposite of strip,
returning only the ANSI codes in text."
@values -min 1 -max 1
text -type string
} ]
proc extract {text} {
set parts [split_codes $text]
set out ""
foreach {pt code} $parts {
append out $code
}
return $out
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::length
@cmd -name punk::ansi::ta::length\
-summary\
"Calculate length of text (excluding the ANSI codes)"\
-help\
"Calculate length of text (excluding the ANSI codes)
This is not the printing length of the string on screen."
@values -min 1
text -type string
} ]
#perl: ta_length
proc length {text} { proc length {text} {
#*** !doctools #*** !doctools
#[call [fun length] [arg text]] #[call [fun length] [arg text]]
@ -5936,6 +6101,8 @@ tcl::namespace::eval punk::ansi::ta {
# #
#} #}
#perl: ta_trunc
#truncate $text to $width columns while still including all the ANSI colour codes.
proc trunc {text width args} { proc trunc {text width args} {
} }
@ -8504,6 +8671,10 @@ tcl::namespace::eval punk::ansi::internal {
} }
} }
tcl::namespace::eval punk::ansi {
namespace import ::punk::ansi::ta::detect
}
#inserting into global namespace like this should be kept to a minimum.. but this is considered a core aspect of punk::ansi #inserting into global namespace like this should be kept to a minimum.. but this is considered a core aspect of punk::ansi
#todo - document #todo - document
interp alias {} ansistring {} ::punk::ansi::ansistring interp alias {} ansistring {} ::punk::ansi::ansistring

39
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.tm

@ -1364,6 +1364,11 @@ tcl::namespace::eval punk::args {
#} #}
tcl::dict::set tmp_optspec_defaults -type $v tcl::dict::set tmp_optspec_defaults -type $v
} }
-defaultdisplaytype {
#how the -default is displayed
#-default doesn't have to be the same type as -type which validates user input that is not defaulted.
tcl::dict::set tmp_optspec_defaults -defaultdisplaytype $v
}
-parsekey { -parsekey {
tcl::dict::set tmp_optspec_defaults -parsekey $v tcl::dict::set tmp_optspec_defaults -parsekey $v
@ -1441,7 +1446,7 @@ tcl::namespace::eval punk::args {
default { default {
set known { -parsekey -group -grouphelp\ set known { -parsekey -group -grouphelp\
-any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\
-type -range -typeranges -default -typedefaults -type -range -typeranges -default -defaultdisplaytype -typedefaults
-choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\
-nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\
-type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\
@ -2052,6 +2057,9 @@ tcl::namespace::eval punk::args {
tcl::dict::set spec_merged -optional 1 tcl::dict::set spec_merged -optional 1
} }
} }
-defaultdisplaytype {
tcl::dict::set spec_merged -defaultdisplaytype $specval
}
-typedefaults { -typedefaults {
set typecount [llength [tcl::dict::get $spec_merged -type]] set typecount [llength [tcl::dict::get $spec_merged -type]]
if {$typecount != [llength $specval]} { if {$typecount != [llength $specval]} {
@ -2114,7 +2122,7 @@ tcl::namespace::eval punk::args {
-form -type\ -form -type\
-parsekey -group\ -parsekey -group\
-range -typeranges\ -range -typeranges\
-default -typedefaults\ -default -defaultdisplaytype -typedefaults\
-minsize -maxsize -choices -choicegroups\ -minsize -maxsize -choices -choicegroups\
-choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\
-nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\
@ -3784,7 +3792,32 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $arginfo -default]} { if {[dict exists $arginfo -default]} {
set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" #default isn't necessarily of same type as -type required for validation
#Guessing at the type from the data is likely to be unsatisfactory.
set defaultdisplaytype [Dict_getdef $arginfo -defaultdisplaytype string]
switch -- $defaultdisplaytype {
dict {
#single level
set rawdefault [dict get $arginfo -default]
set default "{\n"
dict for {k v} $rawdefault {
append default " \"$k\" \"$v\"\n"
}
append default "}"
}
list {
set default "{\n"
foreach v $rawdefault {
append default " \"$v\"\n"
}
append default "}"
}
default {
#set default "'$A_DEFAULT[dict get $arginfo -default]$RST'"
set default "'[dict get $arginfo -default]'"
}
}
} else { } else {
set default "" set default ""
} }

101
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/char-0.1.0.tm

@ -89,6 +89,107 @@ tcl::namespace::eval punk::char {
variable invalid "???" ;# ideally this would be 0xFFFD - which should display as black diamond/rhombus with question mark. As at 2023 - this tends to display indistinguishably from other missing glyph boxes - so we use a longer sequence we can detect by length and to display obviously variable invalid "???" ;# ideally this would be 0xFFFD - which should display as black diamond/rhombus with question mark. As at 2023 - this tends to display indistinguishably from other missing glyph boxes - so we use a longer sequence we can detect by length and to display obviously
variable invalid_display_char \u25ab; #todo - change to 0xFFFD once diamond glyph more common? variable invalid_display_char \u25ab; #todo - change to 0xFFFD once diamond glyph more common?
#more useful for referring to ANSI documentation would be a proper 7-bit and 8-bit 'Code Table' layout
#as described in ECMA-35 5.2
# where the positions of the table are in one-to-one correspondence with the bit combinations of the code.
#- for 7-bit: 8 columns 16 rows
#- for 8-bit 16 columns 16 rows
proc codetable {which} {
set bits 8
switch -- $which {
ascii8 {
set which default
}
ascii {
set bits 7
}
default {
if {$which ni [encoding names]} {
error "codetable unsupported - use 'ascii' or an entry from the result of the 'encoding names' command."
}
}
}
package require punk::ansi
set hibit_count [expr {$bits-4}]
set bitcolumns [expr {2**$hibit_count}] ;#always 4 bits for the rows - remaining bits for the columns
set columncount [expr {$bitcolumns + 6}]
#set header1 [list "" "b7\nb6\nb5" "0\n0\n0" "0\n0\n1" "0\n1\n0" "0\n1\n1" "1\n0\n0" "1\n0\n1" "1\n1\n0" "1\n1\n1"]
set header1 [list]
set hibits_label ""
set indent ""
for {set hb $bits} {$hb > 4} {incr hb -1} {
append hibits_label ${indent}b$hb\n
append indent " "
}
set hibits_label [string range $hibits_label 0 end-1]
lappend header1 $hibits_label "" "" "" "" ""
for {set colidx 0} {$colidx < $bitcolumns} {incr colidx} {
set binval [format %0${hibit_count}b $colidx]
set binvalbits [split $binval ""]
set indent ""
set display_hibits ""
foreach bb $binvalbits {
append display_hibits $indent$bb\n
append indent " "
}
set display_hibits [string range $display_hibits 0 end-1]
lappend header1 $display_hibits
}
#\u2193 down arrow
#right-down arrows
#\u2ba7
#\u21b4
#\u2b0e
set header2 [list " Bits" b4 b3 b2 b1 "column \u2192\nrow \u2b0e" {*}[punk::lib::range 0 $bitcolumns-1]]
set headers [list $header1 $header2]
#set t [textblock::table -return tableobject -rows $rows]
set t [textblock::table -return tableobject]
#todo - fix textblock::table to allow configure -columncount
for {set c 0} {$c < $columncount} {incr c} {
$t add_column
}
set vheaders [punk::transpose_equal_lists $headers]
set hidx -1
foreach vh $vheaders {
incr hidx
$t configure_column $hidx -headers $vh
}
$t configure_header 0 -colspans [list 6 0 0 0 0 0 {*}[lrepeat $bitcolumns 1]]
$t configure_column 0 -blockalign left
#always 16 rows - remaining bits form the columns
for {set ridx 0} {$ridx <= 15} {incr ridx} {
set charlist [list]
set lowbits [format %04b $ridx]
for {set i 0} {$i < $bitcolumns} {incr i} {
set hibits [format %0${hibit_count}b $i]
set ch [format %c [scan ${hibits}${lowbits} %b]]
#puts "-->${hibits}${lowbits} ch:$ch"
if {$which ne "default"} {
if {[catch {encoding convertfrom $which $ch} ch]} {
set ch [punk::ansi::a red bold]-[punk::ansi::a]
lappend charlist $ch
} else {
lappend charlist [punk::ansi::ansistring VIEW -lf 1 -vt 1 $ch]
}
} else {
lappend charlist [punk::ansi::ansistring VIEW -lf 1 -vt 1 $ch]
}
}
set r [list "" {*}[split $lowbits ""] $ridx {*}$charlist]
$t add_row $r
}
puts stderr $t
$t print
}
#just the 7-bit ascii. use [page ascii] for the 8-bit layout #just the 7-bit ascii. use [page ascii] for the 8-bit layout
proc ascii {} {return { proc ascii {} {return {
00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL 00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL

1
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm

@ -1336,6 +1336,7 @@ namespace eval punk::console {
#https://vt100.net/docs/vt510-rm/DA1.html #https://vt100.net/docs/vt510-rm/DA1.html
# #
proc get_device_attributes {{inoutchannels {stdin stdout}}} { proc get_device_attributes {{inoutchannels {stdin stdout}}} {
#Note the vt52 rough equivalen \x1bZ - commonly supported but probably best considered obsolete as it collides with ECMA 48 SCI Single Character Introducer
#DA1 #DA1
variable last_da1_result variable last_da1_result
#first element in result is the terminal's architectural class 61,62,63,64.. ? #first element in result is the terminal's architectural class 61,62,63,64.. ?

126
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm

@ -2242,6 +2242,121 @@ namespace eval punk::lib {
} }
} }
#review - compare to IMAP4 methods of specifying ranges?
punk::args::define {
@id -id ::punk::lib::indexset_resolve
@cmd -name punk::lib::indexset_resolve\
-summary\
"Resolve an indexset to a list of integers based on supplied list or string length."\
-help\
"Resolve an 'indexset' to a list of actual indices within the range of the provided numitems value.
An indexset consists of a comma delimited list of indexes or index-ranges.
The indexes are 0-based.
Ranges must be specified with .. as the separator.
Whitespace is ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
end means the last page.
end-1 means the second last page.
0.. is the same as 0..end.
examples:
1,3..
output the page index 1 (2nd page) followed by all from index 3 to the end.
0-2,end
output the first 3 pages, and the last page.
end-1..0
output the indexes in reverse order from 2nd last page to first page."
@values -min 2 -max 2
numitems -type integer
indexset -type string
}
proc indexset_resolve {numitems indexset} {
if {![string is integer -strict $numitems] || ![regexp {^[\-\+_end,\.0-9]*$} $indexset]} {
#use parser on unhappy path only
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg]
}
set index_list [list] ;#list of actual indexes within the range
set iparts [split $indexset ,]
set index_list [list]
foreach ipart $iparts {
set ipart [string trim $ipart]
set rposn [string first .. $ipart]
if {$rposn>=0} {
#range
lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn+2] rawa _ rawb
set rawa [string trim $rawa]
set rawb [string trim $rawb]
if {$rawa eq ""} {set rawa 0}
set a [punk::lib::lindex_resolve $numitems $rawa]
if {$a == -3} {
#undershot - leave negative
} elseif {$a == -2 && $rawa ne "-2"} {
#overshot
set a [expr {$numitems}] ;#put it outside the range on the upper side
}
if {$rawb eq ""} {
if {$a > $numitems-1} {
set rawb $a ;#make sure <overshot>.. doesn't return last item - should return nothing
} else {
set rawb end
}
}
set b [punk::lib::lindex_resolve $numitems $rawb]
if {$b == -3} {
#undershot - leave negative
} elseif {$b == -2 && $rawb ne "-2"} {
set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side
}
#e.g make sure <overshot>.. doesn't return last item - should return nothing as both are above the range.
if {$a >= 0 && $a <= $numitems-1 && $b >=0 && $b <= $numitems-1} {
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else {
if {$a >= 0 && $a <= $numitems-1} {
#only a is in the range
if {$b < 0} {
set b 0
} else {
set b [expr {$numitems-1}]
}
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$b >=0 && $b <= $numitems-1} {
#only b is in the range
if {$a < 0} {
set a 0
} else {
set a [expr {$numitems-1}]
}
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else {
#both outside the range
if {$a < 0 && $b > 0} {
#spans the range in forward order
set a 0
set b [expr {$numitems-1}]
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$a > 0 && $b < 0} {
#spans the range in reverse order
set a [expr {$numitems-1}]
set b 0
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally.
}
#both outside of range on same side
}
}
} else {
set idx [punk::lib::lindex_resolve_basic $numitems $ipart]
if {$idx >= 0} {
lappend index_list $idx
}
}
}
return $index_list
}
# showdict uses lindex_resolve results -2 & -3 to determine whether index is out of bounds on upper vs lower side # showdict uses lindex_resolve results -2 & -3 to determine whether index is out of bounds on upper vs lower side
#REVIEW: This shouldn't really need the list itself - just the length would suffice #REVIEW: This shouldn't really need the list itself - just the length would suffice
punk::args::define { punk::args::define {
@ -2305,7 +2420,8 @@ namespace eval punk::lib {
#<0 ? #<0 ?
error "lindex_resolve len must be an integer" error "lindex_resolve len must be an integer"
} }
set index [tcl::string::map {_ {}} $index] ;#forward compatibility with integers such as 1_000 set index [tcl::string::map {_ {}} $index] ;#basic forward compatibility with integers such as 1_000 for 8.6
#todo - be stricter about malformations such as 1000_
if {[string is integer -strict $index]} { if {[string is integer -strict $index]} {
#can match +i -i #can match +i -i
if {$index < 0} { if {$index < 0} {
@ -3345,8 +3461,12 @@ namespace eval punk::lib {
#NOTE: running ta::detect on a list (or dict) as a whole can be problematic if items in the list have backslash escapes due to Tcl list quoting and escaping behaviour. #NOTE: running ta::detect on a list (or dict) as a whole can be problematic if items in the list have backslash escapes due to Tcl list quoting and escaping behaviour.
#This commonly happens if there is an unbalanced brace (which is a normal occurrence and needs to be handled) #This commonly happens if there is an unbalanced brace (which is a normal occurrence and needs to be handled)
#ta::detect on a list of ansi-containing string may appear to work for some simple inputs but is not reliable #ta::detect on a list of ansi-containing string may appear to work for some simple inputs but is not reliable
#detect_in_list will check at first level. (not intended for detecting ansi in deeper structures) #detect_in_list/detectcode_in_list will check at first level. (not intended for detecting ansi in deeper structures)
if {![punk::ansi::ta::detect_in_list $linelist]} {
#we use detectcode_in_list instead of detect_in_list
#detectcode_in_list will detect unclosed (or unopened) paired sequences such as PM (privacy message)
# - but the main reason is it is slightly faster.
if {![punk::ansi::ta::detectcode_in_list $linelist]} {
if {$opt_ansiresets} { if {$opt_ansiresets} {
foreach ln $linelist { foreach ln $linelist {
lappend transformed $RST$ln$RST lappend transformed $RST$ln$RST

16
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm

@ -13,6 +13,9 @@
# @@ Meta End # @@ Meta End
#BUGS
# 2025-08
# n// and n/// won't output info about 'namespace path' if there are no commands in the namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements ## Requirements
@ -1235,7 +1238,7 @@ tcl::namespace::eval punk::ns {
if {[dict size [dict get $nsdict namespacepath]]} { if {[dict size [dict get $nsdict namespacepath]]} {
set path_text "" set path_text ""
if {!$opt_nspathcommands} { if {!$opt_nspathcommands} {
append path_text \n " Also resolving cmds in namespace paths: [dict keys [dict get $nsdict namespacepath]]" append path_text \n " Also resolving cmds in namespace paths: [dict keys [dict get $nsdict namespacepath]] (use n/// to display)"
} else { } else {
append path_text \n " Also resolving cmds in namespace paths:" append path_text \n " Also resolving cmds in namespace paths:"
set nspathdict [dict get $nsdict namespacepath] set nspathdict [dict get $nsdict namespacepath]
@ -1247,8 +1250,17 @@ tcl::namespace::eval punk::ns {
} }
} else { } else {
#todo - change to display in column order to be same as main command listing #todo - change to display in column order to be same as main command listing
set parentcommands [dict get $nsdict commands]
dict for {k v} $nspathdict { dict for {k v} $nspathdict {
set pathcommands [dict get $v commands] set rawpathcommands [dict get $v commands]
set pathcommands [list]
foreach c $rawpathcommands {
if {$c in $parentcommands} {
lappend pathcommands [punk::ansi::a strike]$c[a]
} else {
lappend pathcommands $c
}
}
set columns 6 set columns 6
if {[llength $pathcommands] < 6} { if {[llength $pathcommands] < 6} {
set columns [llength $v] set columns [llength $v]

40
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.2.tm

@ -579,13 +579,15 @@ namespace eval shellfilter::chan {
#punk::ansi::ansistrip converts at least some of the box drawing G0 chars to unicode - todo - more complete conversion #punk::ansi::ansistrip converts at least some of the box drawing G0 chars to unicode - todo - more complete conversion
#assumes line-buffering. a more advanced filter required if ansicodes can arrive split across separate read or write operations! #assumes line-buffering. a more advanced filter required if ansicodes can arrive split across separate read or write operations!
oo::class create ansistrip { oo::class create ansistrip {
variable o_trecord variable o_trecord
variable o_enc variable o_enc
variable o_encbuf
variable o_is_junction variable o_is_junction
constructor {tf} { constructor {tf} {
package require punk::ansi package require punk::ansi
set o_trecord $tf set o_trecord $tf
set o_enc [dict get $tf -encoding] set o_enc [dict get $tf -encoding]
set o_encbuf ""
if {[dict exists $tf -junction]} { if {[dict exists $tf -junction]} {
set o_is_junction [dict get $tf -junction] set o_is_junction [dict get $tf -junction]
} else { } else {
@ -614,10 +616,36 @@ namespace eval shellfilter::chan {
method flush {transform_handle} { method flush {transform_handle} {
return "" return ""
} }
#method write {transform_handle bytes} {
# #broken due to occasional unexpected byte sequence
# set instring [encoding convertfrom $o_enc $bytes]
# set outstring [punk::ansi::ansistrip $instring]
# return [encoding convertto $o_enc $outstring]
#}
method write {transform_handle bytes} { method write {transform_handle bytes} {
set instring [encoding convertfrom $o_enc $bytes] #set instring [tcl::encoding::convertfrom $o_enc $bytes] ;naive approach will break due to unexpected byte sequence - occasionally
set outstring [punk::ansi::ansistrip $instring] #bytes can break at arbitrary points making encoding conversions invalid.
return [encoding convertto $o_enc $outstring]
set inputbytes $o_encbuf$bytes
set o_encbuf ""
set tail_offset 0
while {$tail_offset < [string length $inputbytes] && [catch {tcl::encoding::convertfrom $o_enc [string range $inputbytes 0 end-$tail_offset]} stringdata]} {
incr tail_offset
}
if {$tail_offset > 0} {
if {$tail_offset < [string length $inputbytes]} {
#stringdata from catch statement must be a valid result
set t [expr {$tail_offset - 1}]
set o_encbuf [string range $inputbytes end-$t end]
} else {
set stringdata ""
set o_encbuf $inputbytes
return ""
}
}
set outstring [punk::ansi::ansistrip $stringdata]
return [tcl::encoding::convertto $o_enc $outstring]
} }
method meta_is_redirection {} { method meta_is_redirection {} {
return $o_is_junction return $o_is_junction
@ -724,6 +752,8 @@ namespace eval shellfilter::chan {
set emit "" set emit ""
if {[string last \x1b $buf] >= 0} { if {[string last \x1b $buf] >= 0} {
#detect will detect ansi SGR and gron groff and other codes #detect will detect ansi SGR and gron groff and other codes
#REVIEW - ta::detect won't detect SOS without paired ST for things like PM
# ta::detectcode will - but then split_codes_single will treat unpaired SOS as text?
if {[punk::ansi::ta::detect $buf]} { if {[punk::ansi::ta::detect $buf]} {
#split_codes_single regex faster than split_codes - but more resulting parts #split_codes_single regex faster than split_codes - but more resulting parts
#'single' refers to number of escapes - but can still contain e.g multiple SGR codes (or mode set operations etc) #'single' refers to number of escapes - but can still contain e.g multiple SGR codes (or mode set operations etc)
@ -1035,7 +1065,7 @@ namespace eval shellfilter::chan {
} }
#todo - something #todo - something
oo::class create rebuffer { oo::class create rebuffer {
variable o_trecord variable o_trecord
variable o_enc variable o_enc
constructor {tf} { constructor {tf} {
set o_trecord $tf set o_trecord $tf

28
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm

@ -2528,7 +2528,7 @@ tcl::namespace::eval textblock {
set ansiborder_final $ansiborder_body_col_row set ansiborder_final $ansiborder_body_col_row
#$c will always have ansi resets due to overtype behaviour ? #$c will always have ansi resets due to overtype behaviour ?
#todo - review overtype #todo - review overtype
if {[punk::ansi::ta::detect $c]} { if {[punk::ansi::ta::detectcode $c]} {
#use only the last ansi sequence in the cell value #use only the last ansi sequence in the cell value
#Filter out foreground and use background for ansiborder override #Filter out foreground and use background for ansiborder override
set parts [punk::ansi::ta::split_codes_single $c] set parts [punk::ansi::ta::split_codes_single $c]
@ -4377,6 +4377,7 @@ tcl::namespace::eval textblock {
if {![punk::ansi::ta::detect $block]} { if {![punk::ansi::ta::detect $block]} {
return $block return $block
} }
#could be newine in SOS/PM? review - terminal should theoretically ignore all chars til close of string
foreach ln [split $block \n] { foreach ln [split $block \n] {
set parts [punk::ansi::ta::split_codes $ln] set parts [punk::ansi::ta::split_codes $ln]
if {[lindex $parts 0] eq ""} { if {[lindex $parts 0] eq ""} {
@ -4894,7 +4895,9 @@ tcl::namespace::eval textblock {
} }
set textblock [textutil::tabify::untabify2 $textblock $tw] set textblock [textutil::tabify::untabify2 $textblock $tw]
} }
if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #review detectcode vs detect. detectcode won't look for completness of all codes to give a positive result
#ansistripraw splits on complete codes..
if {[string length $textblock] > 1 && [punk::ansi::ta::detectcode $textblock]} {
#ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions)
set textblock [punk::ansi::ansistripraw $textblock] set textblock [punk::ansi::ansistripraw $textblock]
} }
@ -4917,7 +4920,9 @@ tcl::namespace::eval textblock {
} else { } else {
set tl $textblock set tl $textblock
} }
if {[punk::ansi::ta::detect $tl]} { #review detectcode vs detect. detectcode won't look for completness of all codes to give a positive result
#ansistripraw splits on complete codes..
if {[punk::ansi::ta::detectcode $tl]} {
set tl [punk::ansi::ansistripraw $tl] set tl [punk::ansi::ansistripraw $tl]
} }
return [punk::char::ansifreestring_width $tl] return [punk::char::ansifreestring_width $tl]
@ -4964,7 +4969,7 @@ tcl::namespace::eval textblock {
set textblock [textutil::tabify::untabify2 $textblock $tw] set textblock [textutil::tabify::untabify2 $textblock $tw]
} }
#ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests
if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { if {[string length $textblock] > 1 && [punk::ansi::ta::detectcode $textblock]} {
set textblock [punk::ansi::ansistripraw $textblock] set textblock [punk::ansi::ansistripraw $textblock]
} }
if {[tcl::string::last \n $textblock] >= 0} { if {[tcl::string::last \n $textblock] >= 0} {
@ -5211,7 +5216,7 @@ tcl::namespace::eval textblock {
set known_hasansi [tcl::dict::get $opts -known_hasansi] set known_hasansi [tcl::dict::get $opts -known_hasansi]
if {$known_hasansi eq ""} { if {$known_hasansi eq ""} {
set block_has_ansi [punk::ansi::ta::detect $block] set block_has_ansi [punk::ansi::ta::detectcode $block]
} else { } else {
set block_has_ansi $known_hasansi set block_has_ansi $known_hasansi
} }
@ -5648,7 +5653,7 @@ tcl::namespace::eval textblock {
set rowcount 0 set rowcount 0
set blocklists [list] set blocklists [list]
foreach b $blocks { foreach b $blocks {
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
#-ansireplays 1 quite expensive e.g 7ms in 2024 #-ansireplays 1 quite expensive e.g 7ms in 2024
set bl [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] set bl [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b]
} else { } else {
@ -5676,7 +5681,7 @@ tcl::namespace::eval textblock {
set i -1 set i -1
foreach b $args { foreach b $args {
incr i incr i
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
#-ansireplays 1 quite expensive e.g 7ms in 2024 #-ansireplays 1 quite expensive e.g 7ms in 2024
set blines [punk::lib::lines_as_list -ansireplays 1 -ansiresets auto -- $b] set blines [punk::lib::lines_as_list -ansireplays 1 -ansiresets auto -- $b]
} else { } else {
@ -5799,7 +5804,7 @@ tcl::namespace::eval textblock {
#testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway. #testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway.
#blocks passed to join can be ragged - so we can't pass -known_samewidth to pad #blocks passed to join can be ragged - so we can't pass -known_samewidth to pad
if {[punk::ansi::ta::detect $b]} { if {[punk::ansi::ta::detectcode $b]} {
# - we need to join to use pad - even though we then need to immediately resplit REVIEW (make line list version of pad?) # - we need to join to use pad - even though we then need to immediately resplit REVIEW (make line list version of pad?)
set replay_block [::join [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] \n] set replay_block [::join [punk::lib::lines_as_list -ansireplays 1 -ansiresets $ansiresets -- $b] \n]
#set blines [split [textblock::pad $replay_block -known_hasansi 1 -known_samewidth $is_samewidth -known_blockwidth $bwidth -width $bwidth -which right -padchar " "] \n] #set blines [split [textblock::pad $replay_block -known_hasansi 1 -known_samewidth $is_samewidth -known_blockwidth $bwidth -width $bwidth -which right -padchar " "] \n]
@ -8650,7 +8655,7 @@ tcl::namespace::eval textblock {
set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $underlay $cache_contentpattern] set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $underlay $cache_contentpattern]
#puts "frame--->ansiwrap -rawansi [ansistring VIEW $opt_ansibase] $cache_inner" #puts "frame--->ansiwrap -rawansi [ansistring VIEW $opt_ansibase] $cache_inner"
if {$opt_ansibase ne ""} { if {$opt_ansibase ne ""} {
if {[punk::ansi::ta::detect $cache_inner]} { if {[punk::ansi::ta::detectcode $cache_inner]} {
#set cache_inner [punk::ansi::ansiwrap -rawansi $opt_ansibase $cache_inner] #set cache_inner [punk::ansi::ansiwrap -rawansi $opt_ansibase $cache_inner]
#set cache_inner [punk::ansi::ansiwrap_raw $opt_ansibase "" "" $cache_inner] #set cache_inner [punk::ansi::ansiwrap_raw $opt_ansibase "" "" $cache_inner]
#jjj ??? review #jjj ??? review
@ -8745,7 +8750,7 @@ tcl::namespace::eval textblock {
#set cwidth [textblock::width $contents] #set cwidth [textblock::width $contents]
#JJJ #JJJ
set contents_has_ansi [punk::ansi::ta::detect $contents] set contents_has_ansi [punk::ansi::ta::detectcode $contents]
if {$opt_ansibase ne ""} { if {$opt_ansibase ne ""} {
if {$contents_has_ansi} { if {$contents_has_ansi} {
#set contents [punk::ansi::ansiwrap -rawansi $opt_ansibase $contents] #set contents [punk::ansi::ansiwrap -rawansi $opt_ansibase $contents]
@ -8799,8 +8804,9 @@ tcl::namespace::eval textblock {
if {$subposn >= 0} { if {$subposn >= 0} {
set content_line [lindex $clines $contentindex] set content_line [lindex $clines $contentindex]
#review - different forms of reset e.g \x1b\[m ?? #review - different forms of reset e.g \x1b\[m ??
if {[string range $content_line 0 3] eq "\x1b\[0m"} { if {[tcl::string::range $content_line 0 3] eq "\x1b\[0m"} {
set content_line [tcl::string::range $content_line 4 end] set content_line [tcl::string::range $content_line 4 end]
#::tcl::string::replace content_line 0 3
} }
append content_line $opt_ansibase append content_line $opt_ansibase
append fs [tcl::string::replace $tline $subposn $subposn+$pattern_offset $content_line] \n append fs [tcl::string::replace $tline $subposn $subposn+$pattern_offset $content_line] \n

2
src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl

@ -3075,7 +3075,7 @@ foreach vfstail $vfs_tails {
#copy the version that is mounted in this runtime to vfsname.new #copy the version that is mounted in this runtime to vfsname.new
if {[catch { if {[catch {
file copy -force $building_runtime $buildfolder/$vfsname.new file copy -force $building_runtime $buildfolder/$vfsname.new
catch {exec chmod +x $buildfolder/$vfsname.new} catch {exec chmod +w $buildfolder/$vfsname.new}
} errM]} { } errM]} {
puts stderr "$kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM" puts stderr "$kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM"
error $errM error $errM

39
src/vfs/_vfscommon.vfs/modules/punk/args-0.2.tm

@ -1364,6 +1364,11 @@ tcl::namespace::eval punk::args {
#} #}
tcl::dict::set tmp_optspec_defaults -type $v tcl::dict::set tmp_optspec_defaults -type $v
} }
-defaultdisplaytype {
#how the -default is displayed
#-default doesn't have to be the same type as -type which validates user input that is not defaulted.
tcl::dict::set tmp_optspec_defaults -defaultdisplaytype $v
}
-parsekey { -parsekey {
tcl::dict::set tmp_optspec_defaults -parsekey $v tcl::dict::set tmp_optspec_defaults -parsekey $v
@ -1441,7 +1446,7 @@ tcl::namespace::eval punk::args {
default { default {
set known { -parsekey -group -grouphelp\ set known { -parsekey -group -grouphelp\
-any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\ -any -anyopts -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo\
-type -range -typeranges -default -typedefaults -type -range -typeranges -default -defaultdisplaytype -typedefaults
-choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\ -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase\
-nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\
-type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple -prefix\
@ -2052,6 +2057,9 @@ tcl::namespace::eval punk::args {
tcl::dict::set spec_merged -optional 1 tcl::dict::set spec_merged -optional 1
} }
} }
-defaultdisplaytype {
tcl::dict::set spec_merged -defaultdisplaytype $specval
}
-typedefaults { -typedefaults {
set typecount [llength [tcl::dict::get $spec_merged -type]] set typecount [llength [tcl::dict::get $spec_merged -type]]
if {$typecount != [llength $specval]} { if {$typecount != [llength $specval]} {
@ -2114,7 +2122,7 @@ tcl::namespace::eval punk::args {
-form -type\ -form -type\
-parsekey -group\ -parsekey -group\
-range -typeranges\ -range -typeranges\
-default -typedefaults\ -default -defaultdisplaytype -typedefaults\
-minsize -maxsize -choices -choicegroups\ -minsize -maxsize -choices -choicegroups\
-choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\ -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted\
-nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\
@ -3784,7 +3792,32 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $arginfo -default]} { if {[dict exists $arginfo -default]} {
set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" #default isn't necessarily of same type as -type required for validation
#Guessing at the type from the data is likely to be unsatisfactory.
set defaultdisplaytype [Dict_getdef $arginfo -defaultdisplaytype string]
switch -- $defaultdisplaytype {
dict {
#single level
set rawdefault [dict get $arginfo -default]
set default "{\n"
dict for {k v} $rawdefault {
append default " \"$k\" \"$v\"\n"
}
append default "}"
}
list {
set default "{\n"
foreach v $rawdefault {
append default " \"$v\"\n"
}
append default "}"
}
default {
#set default "'$A_DEFAULT[dict get $arginfo -default]$RST'"
set default "'[dict get $arginfo -default]'"
}
}
} else { } else {
set default "" set default ""
} }

799
src/vfs/_vfscommon.vfs/modules/punk/pdf-0.1.0.tm

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save