Browse Source

punk::ansi 0.1.2: PUNKARGS argdoc coverage for codetype/sequence_type/ta/ansistring + characterization tests

- 34 documentation-only PUNKARGS blocks added: punk::ansi::codetype (is_sgr_reset,
  has_sgr_leadingreset, is_cursor_move_in_line, has_all_effective,
  get_effective_types, is_gx/is_gx_open/is_gx_close, sgr_merge),
  punk::ansi::sequence_type (is_Fe7/is_Fe/is_Fe8, is_Fp, is_Fs, is_nF, is_3Fp,
  is_code7/is_code8/is_code, classify), punk::ansi::ta (detect_in_list, detectcode,
  detectcode_in_list, detect_g0, detect_open, detect_st_open, detect_csi,
  detect_sgr, split_at_codes, split_codes, split_codes_single, get_codes_single)
  and punk::ansi::ansistring (VIEW, COUNT, length, trimleft/trimright/trim, INDEX,
  INDEXCHAR, RANGE, INSERT, INDEXABSOLUTE, INDEXCOLUMNS, COLUMNINDEX).
- ::punk::ansi::sequence_type added to the punk::args::register NAMESPACES list -
  the escape-form classifiers live there (a separate namespace from codetype) and
  were previously undiscoverable by the doc system.
- New characterization suites: ta.test (12 tests - detect vs detectcode lone-CSI
  distinction, split_codes/split_codes_single/split_at_codes shapes and join
  round-trip, length/extract), codetype.test (11 tests - reset/leading-reset
  semantics, effective-state queries incl. bold-via-intensity, sgr_merge,
  sequence_type classify taxonomy); ansistring.test extended 1 -> 12 tests
  (INDEX/INDEXCODE/INDEXCHAR/RANGE/INSERT grapheme indexing with merged SGR-prefix
  tracking incl. end+1 state-after-string, INDEXCOLUMNS/COLUMNINDEX double-wide
  column mapping via a CJK fixture, INDEXABSOLUTE resolution, styled-whitespace
  trim, VIEW control-picture substitution).
- Tests use literal escape strings (not a+) so results are independent of the
  punk::console colour state. Origin notes added to the usage-marking suites'
  local SGR helpers pointing at these canonical mechanisms and their coverage.
- src/tests/modules/AGENTS.md child DOX index: entries added for the punk/ansi,
  punk/args and punk/ns suites (GAP-pin/goal mapping documented).
- Verified: 44/44 ansi suite and the full ansi+args+ns sweep (232 passed, 1
  pre-existing skip) on Tcl 9.0.3 and 8.7; make.tcl modules clean.

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 1 week ago
parent
commit
fe85dfadd0
  1. 690
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 3
      src/modules/punk/ansi-buildversion.txt
  3. 3
      src/tests/modules/AGENTS.md
  4. 209
      src/tests/modules/punk/ansi/testsuites/ansi/ansistring.test
  5. 163
      src/tests/modules/punk/ansi/testsuites/ansi/codetype.test
  6. 185
      src/tests/modules/punk/ansi/testsuites/ansi/ta.test

690
src/modules/punk/ansi-999999.0a1.0.tm

@ -7315,6 +7315,22 @@ tcl::namespace::eval punk::ansi {
}
#review - has_cursor_move_in_line? Are we wanting to allow strings/sequences and detect that there are no moves that *aren't* within line?
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::is_cursor_move_in_line
@cmd -name punk::ansi::codetype::is_cursor_move_in_line\
-summary\
"Test if code is a cursor move staying within the current line."\
-help\
"Test whether the string ends in a cursor-movement code that stays
within the current line (CSI n C cursor forward, CSI n D cursor back,
CSI n G column absolute).
If knownline is supplied as an integer, an absolute move (CSI row : col H)
targeting that same row is also accepted."
@values -min 1 -max 2
code -type string
knownline -type string -default "" -optional 1 -help\
"Current line number, if known."
} ]
proc is_cursor_move_in_line {code {knownline ""}} {
if {[regexp {\033\[[0-9]*(:?C|D|G)$} $code]} {
return 1
@ -7330,6 +7346,22 @@ tcl::namespace::eval punk::ansi {
}
#pure SGR reset with no other functions
#ie will not detect a redundant code such as \x1b\[31;0m - but it will detect \x1b\[0m or \x1b\[0\;...m]
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::is_sgr_reset
@cmd -name punk::ansi::codetype::is_sgr_reset\
-summary\
"Test if string ends in a pure SGR reset."\
-help\
{Return a boolean indicating whether the string has a trailing pure SGR
reset - e.g \x1b\[0m or \x1b\[m (7 or 8 bit CSI, any number of zeros).
A reset that is not the very last item in the string is not detected,
and a code with a reset amongst other parameters (e.g \x1b\[31;0m) is
not a *pure* reset.
Primarily intended for testing a single ANSI code sequence, but code
can be any string where the trailing SGR code is to be tested.}
@values -min 1 -max 1
code -type string
} ]
proc is_sgr_reset {code} {
#*** !doctools
#[call [fun is_sgr_reset] [arg code]]
@ -7351,6 +7383,21 @@ tcl::namespace::eval punk::ansi {
#We only look at the initial parameter within the trailing SGR code as this is the well-formed normal case.
#Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg colour twice in same code
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::has_sgr_leadingreset
@cmd -name punk::ansi::codetype::has_sgr_leadingreset\
-summary\
"Test if code begins with an SGR whose first parameter is a reset."\
-help\
{Return a boolean indicating whether code begins with an SGR code whose
first parameter is a reset (zero or empty) - e.g \x1b\[m, \x1b\[0;31m.
The reset must be the very first item in code to be detected.
Trailing strings/codes are ignored.
An SGR containing a leading reset makes any prior SGR state redundant
- e.g there is no need to carry forward earlier codes when merging.}
@values -min 1 -max 1
code -type string
} ]
proc has_sgr_leadingreset {code} {
#*** !doctools
#[call [fun has_sgr_leadingreset] [arg code]]
@ -7440,6 +7487,27 @@ tcl::namespace::eval punk::ansi {
}
return 0
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::has_all_effective
@cmd -name punk::ansi::codetype::has_all_effective\
-summary\
"Test if string has all the given effective SGR states by the end."\
-help\
{Test if the string has ALL of the given SGR states in effect by the end
of the string, after all of its codes have been processed.
(companion to has_any_effective, which tests whether ANY of the given
states remains in effect)
e.g has_all_effective $str fg bg
returns true only if both a foreground and a background colour are in
effect at the end of str.
bold and dim match specific values of the intensity state.}
@values -min 2
str -type string
state -type string -multiple 1\
-choiceprefix 0\
-choices {sgr unmergeable othercodes intensity bold dim italic underline underextended blink reverse hide strike font gothic doubleunderline proportional frame_or_circle ideogram_underline ideogram_doubleunderline ideogram_clear overline underlinecolour superscript subscript nosupersub fg bg}\
} ]
proc has_all_effective {str args} {
set singlecodes [punk::ansi::ta::get_codes_single $str]
set mergeinfo [punk::ansi::codetype::sgr_merge_singles $singlecodes -info]
@ -7475,6 +7543,21 @@ tcl::namespace::eval punk::ansi {
return 1
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::get_effective_types
@cmd -name punk::ansi::codetype::get_effective_types\
-summary\
"List the SGR states in effect by the end of a string."\
-help\
"Return a list of the state names still in effect after all codes in
str have been processed.
The names are those accepted by has_any_effective/has_all_effective
(sgr, unmergeable, othercodes and the individual codestate names such
as fg, bg, intensity, underline ...), with bold or dim appended when
the intensity state has the corresponding value."
@values -min 1 -max 1
str -type string
} ]
proc get_effective_types {str} {
set singlecodes [punk::ansi::ta::get_codes_single $str]
set mergeinfo [punk::ansi::codetype::sgr_merge_singles $singlecodes -info]
@ -7497,17 +7580,51 @@ tcl::namespace::eval punk::ansi {
return $effective
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::is_gx
@cmd -name punk::ansi::codetype::is_gx\
-summary\
"Test if code contains a complete G0/G1 charset shift group."\
-help\
{Test whether code contains a complete charset shift group: an opening
\x1b(0 (G0) or \x1b)0 (G1) designation of the DEC line-drawing set,
through to the corresponding close \x1b(B / \x1b)B returning to ASCII.}
@values -min 1 -max 1
code -type string
} ]
proc is_gx {code} {
#g0 {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
#g1 {(?:\x1b\)0)(?:(?!\x1b\)B).)*\x1b\)B}
regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::is_gx_open
@cmd -name punk::ansi::codetype::is_gx_open\
-summary\
"Test if code contains a G0/G1 line-drawing charset open sequence."\
-help\
{Test whether code contains \x1b(0 (G0) or \x1b)0 (G1)
- designating the DEC line-drawing character set.}
@values -min 1 -max 1
code -type string
} ]
proc is_gx_open {code} {
#todo g2,g3?
#pin to start and end with ^ and $ ?
#regexp {\x1b\(0|\x1b\)0} $code
regexp {\x1b(?:\(0|\)0)} $code
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::is_gx_close
@cmd -name punk::ansi::codetype::is_gx_close\
-summary\
"Test if code contains a G0/G1 charset close sequence."\
-help\
{Test whether code contains \x1b(B (G0) or \x1b)B (G1)
- returning the character set to ASCII.}
@values -min 1 -max 1
code -type string
} ]
proc is_gx_close {code} {
#regexp {\x1b\(B|\x1b\)B} $code
regexp {\x1b(?:\(B|\)B)} $code
@ -7580,6 +7697,22 @@ tcl::namespace::eval punk::ansi {
# sgr_merge $args
#}
#-------------------------------------------------------
lappend PUNKARGS [list {
@id -id ::punk::ansi::codetype::sgr_merge
@cmd -name punk::ansi::codetype::sgr_merge\
-summary\
"Merge the SGR codes from a list of ANSI strings into one SGR when possible."\
-help\
"As punk::ansi::codetype::sgr_merge_singles - but each element of
codelist may contain multiple codes (each element is first split with
punk::ansi::ta::get_codes_single)."
@values -min 1 -max -1
codelist -type list -help\
"List of ANSI code strings to merge. Unlike sgr_merge_singles, an
element may contain multiple codes."
arg -type string -optional 1 -multiple 1 -help\
"Additional arguments passed through to sgr_merge_singles (e.g -info)."
} ]
proc sgr_merge {codelist args} {
if {[llength $codelist] == 0 && [llength $args] == 0} {
return ""
@ -8162,16 +8295,54 @@ tcl::namespace::eval punk::ansi {
#\u0060-\u007E
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_Fe7
@cmd -name punk::ansi::sequence_type::is_Fe7\
-summary\
"Test if code starts with a 7-bit Fe (C1 control) escape."\
-help\
{Test whether code starts with a 7-bit Fe escape: ESC followed by a
byte in the range 0x40-0x5F (@A-Z and bracket/caret/underscore chars).
This is the typical form of the C1 control codes
- e.g the 7-bit CSI introducer.}
@values -min 1 -max 1
code -type string
} ]
proc is_Fe7 {code} {
# C1 control codes
#7bit - typical case
# ESC @A-Z[\]^
return [regexp {^\033[\u0040-\u005F]} $code]
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_Fe
@cmd -name punk::ansi::sequence_type::is_Fe\
-summary\
"Test if code starts with an Fe (C1 control) escape, 7 or 8 bit."\
-help\
{Test whether code starts with an Fe (C1 control) escape in either
7-bit form (ESC + byte in 0x40-0x5F) or 8-bit form
(a byte in 0x80-0x9F).}
@values -min 1 -max 1
code -type string
} ]
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]}]
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_Fe8
@cmd -name punk::ansi::sequence_type::is_Fe8\
-summary\
"Test if code starts with an 8-bit C1 control byte."\
-help\
{Test whether code starts with an 8-bit C1 control byte
(\u0080-\u009f) - e.g \u009b as the single-byte CSI.
Note that in modern encodings these byte values are often used for
other purposes, so the 2-byte 7-bit sequences are more typical.}
@values -min 1 -max 1
code -type string
} ]
proc is_Fe8 {code} {
#8bit
#review - all C1 escapes ? 0x80-0x9F
@ -8181,6 +8352,18 @@ tcl::namespace::eval punk::ansi {
return [regexp {^[\u0080-\u09F]} $code]
}
#ESC 0-9,:,;,<,=,>,?
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_Fp
@cmd -name punk::ansi::sequence_type::is_Fp\
-summary\
"Test if code is a single-byte Fp (private-use) escape."\
-help\
{Test whether code is exactly a single-byte Fp private-use escape:
ESC followed by one byte in the range 0x30-0x3F (0-9:;<=>?)
- e.g ESC 7 / ESC 8 (DEC save/restore cursor).}
@values -min 1 -max 1
code -type string
} ]
proc is_Fp {code} {
#single byte following ESC
return [regexp {^\033[\u0030-\u003F]$} $code]
@ -8191,12 +8374,40 @@ tcl::namespace::eval punk::ansi {
# ESC a (INT) interrupts the current process
# ESC c (RIS) reset terminal to initial state
#ESC `a-z{|}~
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_Fs
@cmd -name punk::ansi::sequence_type::is_Fs\
-summary\
"Test if code is a single-byte Fs (standardised single function) escape."\
-help\
{Test whether code is exactly a single-byte Fs escape (ISO/IEC 2022
standardised single control function): ESC followed by one byte in
the range 0x60-0x7E (backquote, a-z, braces, pipe, tilde)
- e.g ESC c (RIS reset to initial state).}
@values -min 1 -max 1
code -type string
} ]
proc is_Fs {code} {
#single byte following ESC
return [regexp {^\033[\u0060-\u007E]$} $code]
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_nF
@cmd -name punk::ansi::sequence_type::is_nF\
-summary\
"Test if code is an nF escape sequence."\
-help\
{Test whether code is exactly an nF escape sequence: ESC followed by
one or more intermediate bytes in the range 0x20-0x2F and a final byte
in 0x30-0x7E - e.g the charset designations ESC ( 0 and ESC ( B.
nF sequences are subcategorised by the low two bits of the first
intermediate byte (n) and by whether the final byte is in the
private-use range (p) or not (t) - see classify.}
@values -min 1 -max 1
code -type string
} ]
proc is_nF {code} {
#2 bytes
#subcategorised by the low two bits of the first byte (n)
@ -8211,21 +8422,86 @@ tcl::namespace::eval punk::ansi {
# ESC#4 DECDHL double-height letters bottom half
# ESC#5 DECSWL single-width line
# ESC#6 DECDWL double-width line
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_3Fp
@cmd -name punk::ansi::sequence_type::is_3Fp\
-summary\
"Test if code is a 3Fp private-use escape sequence."\
-help\
{Test whether code is exactly a 3Fp private-use escape:
ESC # then optional intermediate bytes and a final byte in 0x30-0x3F
- e.g the VT100 line-size codes ESC # 3 to ESC # 6 (DECDHL/DECSWL/DECDWL).}
@values -min 1 -max 1
code -type string
} ]
proc is_3Fp {code} {
return [regexp {^\033#[\u0020-\u002F]*[\u0030-\u003F]$} $code] ;#check regexp
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_code7
@cmd -name punk::ansi::sequence_type::is_code7\
-summary\
"Test if code is a 7-bit ANSI escape (Fe, Fs, Fp or nF form)."\
-help\
{Test whether code matches any of the 7-bit escape sequence forms:
Fe (C1 control - prefix match), or exactly Fs, Fp or nF.}
@values -min 1 -max 1
code -type string
} ]
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]
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_code8
@cmd -name punk::ansi::sequence_type::is_code8\
-summary\
"Test if code starts with an 8-bit C1 control byte."\
-help\
{Test whether code starts with an 8-bit C1 control byte (0x80-0x9F).
Encoding caveats as for is_Fe8.}
@values -min 1 -max 1
code -type string
} ]
proc is_code8 {code} {
return [regexp {^[\u0080-\u09F]} $code]
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::is_code
@cmd -name punk::ansi::sequence_type::is_code\
-summary\
"Test if code is a recognised 7-bit or 8-bit ANSI escape."\
-help\
{Test whether code is recognised as an ANSI escape in either
7-bit (is_code7) or 8-bit (is_code8) form.}
@values -min 1 -max 1
code -type string
} ]
proc is_code {code} {
return [expr {[is_code8 $code] || [is_code7 $code]}]
}
lappend PUNKARGS [list {
@id -id ::punk::ansi::sequence_type::classify
@cmd -name punk::ansi::sequence_type::classify\
-summary\
"Classify an escape sequence by ANSI/ECMA-48 form."\
-help\
"Classify an escape sequence, returning one of:
Fp - single-byte private-use escape
Fe - C1 control escape (7 or 8 bit)
Fs - single-byte standardised escape
<n>Ft / <n>Fp
- nF escape, where n is the low two bits of the first
intermediate byte and the suffix indicates a standard (t)
or private-use (p) final byte
3Fp - ESC # private-use form (e.g VT100 DECDHL)
unknown
- not recognised as one of the above forms"
@values -min 1 -max 1
code -type string
} ]
proc classify {code} {
return [switch -regexp -- $code {
{^\033[\u0030-\u003F]$} {string cat Fp}
@ -8568,6 +8844,22 @@ tcl::namespace::eval punk::ansi::ta {
regexp <re> $text
}]
#can be used on dicts - but will check keys too. keys could also contain ansi and have escapes
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect_in_list
@cmd -name punk::ansi::ta::detect_in_list\
-summary\
"Test if any element of a list contains completed ANSI codes"\
-help\
"Return a boolean indicating whether *complete* ANSI codes were detected
in any element of the list (as punk::ansi::ta::detect per element).
Can be used on dicts - but keys are checked too.
See punk::ansi::ta::detect for the caveat about escaping/bracing
introduced by list operations on ANSI strings."
@values -min 1
list -type list
} ]
}
proc detect_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
foreach item $list {
@ -8579,9 +8871,39 @@ tcl::namespace::eval punk::ansi::ta {
}
#will detect for example lone opening or closing PM
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detectcode
@cmd -name punk::ansi::ta::detectcode\
-summary\
"Test if text has ANSI codes - complete pairing not required"\
-help\
"Return a boolean indicating whether ANSI codes were detected in text.
Slightly faster than punk::ansi::ta::detect, and does not require paired
sequences (e.g PM privacy message) to have both their opening and closing
sequences present - so it will detect, for example, a lone opening or
closing PM."
@values -min 1
text -type string
} ]
}
proc detectcode {text} [string map [list <re> [list $re_ansi_detectcode]] {
regexp <re> $text
}]
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detectcode_in_list
@cmd -name punk::ansi::ta::detectcode_in_list\
-summary\
"Test if any element of a list contains ANSI codes (detectcode per element)"\
-help\
"Return a boolean indicating whether ANSI codes were detected in any
element of the list, using punk::ansi::ta::detectcode per element
(complete pairing of paired sequences not required)."
@values -min 1
list -type list
} ]
}
proc detectcode_in_list {list} {
#loop is commonly faster than using join. (certain ansi codes triggering list quoting? review)
foreach item $list {
@ -8598,6 +8920,20 @@ tcl::namespace::eval punk::ansi::ta {
detect [join $list " "]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect_g0
@cmd -name punk::ansi::ta::detect_g0\
-summary\
"Test if text contains a complete G0 charset shift group"\
-help\
"Return a boolean indicating whether a complete G0 group was detected:
an ESC ( 0 designation of the DEC line-drawing set through to the
closing ESC ( B returning to ASCII."
@values -min 1
text -type string
} ]
}
proc detect_g0 {text} [string map [list <re> [list $re_g0_group]] {
regexp <re> $text
}]
@ -8610,16 +8946,59 @@ tcl::namespace::eval punk::ansi::ta {
expr {[regexp $re_ansi_detect $text]}
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect_open
@cmd -name punk::ansi::ta::detect_open\
-summary\
"Test if text contains an opening/incomplete ANSI sequence"\
-help\
"Return a boolean indicating whether an ANSI opening sequence was
detected - including openings of paired sequences whose closing
sequence is not present. Useful when processing streamed or truncated
data where a code may not have arrived in full."
@values -min 1
text -type string
} ]
}
proc detect_open {text} {
variable re_ansi_detect_open
expr {[regexp $re_ansi_detect_open $text]}
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect_st_open
@cmd -name punk::ansi::ta::detect_st_open\
-summary\
"Test if text contains an unterminated string-terminator-delimited sequence"\
-help\
"Return a boolean indicating whether an opening of an ST-delimited
sequence (e.g OSC, PM, APC) was detected without requiring the closing
String Terminator to be present."
@values -min 1
text -type string
} ]
}
proc detect_st_open {text} {
variable re_ST_open
expr {[regexp $re_ST_open $text]}
}
#not in perl ta
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect_csi
@cmd -name punk::ansi::ta::detect_csi\
-summary\
"Test if text contains an ANSI Control Sequence Introducer (CSI)"\
-help\
"Return a boolean indicating whether an ANSI Control Sequence Introducer
was detected in text: ESC followed by a left bracket, or the less common
8-bit single-byte CSI (0x9B)."
@values -min 1
text -type string
} ]
}
proc detect_csi {text} {
#*** !doctools
#[call [fun detect_csi] [arg text]]
@ -8632,6 +9011,21 @@ tcl::namespace::eval punk::ansi::ta {
variable re_csi_open
expr {[regexp $re_csi_open $text]}
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::detect_sgr
@cmd -name punk::ansi::ta::detect_sgr\
-summary\
"Test if text contains an ANSI SGR (Select Graphic Rendition) code"\
-help\
"Return a boolean indicating whether an ANSI SGR code was detected
- the set of CSI sequences ending in 'm'. This is most commonly an ANSI
colour code, but also covers underline, italics etc.
An SGR with an empty or single zero parameter (a reset) is also detected."
@values -min 1
text -type string
} ]
}
proc detect_sgr {text} {
#*** !doctools
#[call [fun detect_sgr] [arg text]]
@ -8721,6 +9115,22 @@ tcl::namespace::eval punk::ansi::ta {
#not in perl ta
#returns just the plaintext portions in a list
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::split_at_codes
@cmd -name punk::ansi::ta::split_at_codes\
-summary\
"Split string at ANSI codes, returning only the plaintext portions"\
-help\
"Return a list of the plaintext portions of str - the text between and
around the ANSI codes, with the codes themselves omitted.
An empty str returns an empty list.
See punk::ansi::ta::split_codes / split_codes_single for versions that
retain the codes."
@values -min 1 -max 1
str -type string
} ]
}
proc split_at_codes {str} [string map [list <re> $re_ansi_split] {
#variable re_ansi_split
#punk::ansi::internal::splitx $str ${re_ansi_split}
@ -8822,6 +9232,24 @@ tcl::namespace::eval punk::ansi::ta {
#split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"}
#split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"}
#
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::split_codes
@cmd -name punk::ansi::ta::split_codes\
-summary\
"Split text into alternating plaintext and ANSI-code elements"\
-help\
"Split text into a list of alternating plaintext and ANSI codes:
plaintext on even list indices, codes on odd indices.
The result for a non-empty input always has an odd length, with the
first and last elements being plaintext (possibly empty strings).
Runs of consecutive codes stay together in one code element - use
punk::ansi::ta::split_codes_single to split each code out separately.
An empty text returns an empty list."
@values -min 1
text -type string
} ]
}
proc split_codes {text} {
variable re_ansi_split_multi
return [_perlish_split $re_ansi_split_multi $text]
@ -8830,6 +9258,23 @@ tcl::namespace::eval punk::ansi::ta {
#like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so even/odd indices for plain ansi still holds)
#- the regex is slighly simpler than for split_codes - but split_codes is faster when there are consecutive codes.
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::split_codes_single
@cmd -name punk::ansi::ta::split_codes_single\
-summary\
"Split text into alternating plaintext and single ANSI-code elements"\
-help\
"As punk::ansi::ta::split_codes - but each ANSI escape sequence is split
out into its own element, with an empty plaintext element between
consecutive codes so the plaintext-on-even/codes-on-odd index property
still holds. split_codes is faster when there are runs of consecutive
codes.
An empty text returns an empty list."
@values -min 1
text -type string
} ]
}
proc split_codes_single {text} {
if {$text eq ""} {
return {}
@ -8870,6 +9315,20 @@ tcl::namespace::eval punk::ansi::ta {
variable re_ansi_split
return [_perlish_split $re_ansi_split $text]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ta::get_codes_single
@cmd -name punk::ansi::ta::get_codes_single\
-summary\
"Return the individual ANSI codes in text as a list"\
-help\
"Return a list of the ANSI escape sequences found in text, one code per
element, with no plaintext elements (the codes-only counterpart to
punk::ansi::ta::split_codes_single)."
@values -min 1
text -type string
} ]
}
proc get_codes_single {text} {
variable re_ansi_split
regexp -all -inline -- $re_ansi_split $text
@ -10392,6 +10851,33 @@ tcl::namespace::eval punk::ansi::ansistring {
proc NEW {string} {
punk::ansi::class::class_ansistring new $string
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::VIEW
@cmd -name punk::ansi::ansistring::VIEW\
-summary\
"Replace ANSI escapes and control characters with visible equivalents."\
-help\
"Return string with ANSI escape characters and selected control
characters substituted with visible unicode 'control picture'
equivalents (e.g ESC becomes U+241B, space U+2420) for debugging.
Options precede the string argument as -option value pairs.
For -lf, -vt and -ff the value 2 appends a real newline after the
visual character (useful to mimic terminal CRM 'show control
character' mode)."
@opts
-esc -type boolean -default 1 -help "Substitute ESC (U+241B)"
-cr -type boolean -default 1 -help "Substitute carriage return (U+240D)"
-lf -type integer -default 0 -choices {0 1 2} -help "Substitute linefeed (U+240A)"
-vt -type integer -default 0 -choices {0 1 2} -help "Substitute vertical tab (U+240B)"
-ff -type integer -default 1 -choices {0 1 2} -help "Substitute formfeed (U+240C)"
-ht -type boolean -default 1 -help "Substitute horizontal tab (U+2409)"
-bs -type boolean -default 1 -help "Substitute backspace (U+2408)"
-sp -type boolean -default 1 -help "Substitute space (U+2420)"
@values -min 1 -max 1
string -type string
} ]
}
proc VIEW {args} {
#*** !doctools
#[call [fun VIEW] [arg string]]
@ -10547,6 +11033,22 @@ tcl::namespace::eval punk::ansi::ansistring {
#we want count to return number of glyphs.. not screen width. Has to be consistent with index function
return [llength [punk::char::grapheme_split [ansistrip $string]]]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::COUNT
@cmd -name punk::ansi::ansistring::COUNT\
-summary\
"Count the graphemes in string, excluding ANSI codes."\
-help\
"Return the number of grapheme clusters (glyphs) in string, excluding
any ANSI codes. This is neither the underlying character count
(see ansistring length) nor the rendered screen width - a double-wide
grapheme still counts as one. Consistent with the index positions used
by ansistring INDEX and related functions."
@values -min 1 -max 1
string -type string
} ]
}
proc COUNT {string} {
#review - consider caching like we do for overtype::grapheme_width_cached
#we want count to return number of glyphs.. not screen width. Has to be consistent with index function
@ -10559,6 +11061,20 @@ tcl::namespace::eval punk::ansi::ansistring {
return $count
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::length
@cmd -name punk::ansi::ansistring::length\
-summary\
"Character length of string after stripping ANSI codes."\
-help\
"Return the tcl string length of string after stripping ANSI codes.
This counts characters (codepoints) - not grapheme clusters (see
ansistring COUNT) and not the rendered screen width."
@values -min 1 -max 1
string -type string
} ]
}
proc length {string} {
tcl::string::length [ansistrip $string]
}
@ -10631,6 +11147,47 @@ tcl::namespace::eval punk::ansi::ansistring {
#Note that trim/trimleft/trimright will trim spaces at the extremities that are styled with background colour, underline etc
#that may be unexpected, but it's probably the only thing that makes sense. Plain string trim can chop off whitespace that is extraneous to the ansi entirely.
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::trimleft
@cmd -name punk::ansi::ansistring::trimleft\
-summary\
"Trim leading whitespace from an ANSI string, preserving codes."\
-help\
"Return string with leading whitespace removed while preserving all
ANSI codes (including those that preceded or were interleaved with
the trimmed whitespace).
Note that whitespace styled with e.g background colour or underline is
still trimmed. A ?chars? argument as accepted by tcl string trimleft is
not yet supported."
@values -min 1 -max 1
string -type string
} ]
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::trimright
@cmd -name punk::ansi::ansistring::trimright\
-summary\
"Trim trailing whitespace from an ANSI string, preserving codes."\
-help\
"Return string with trailing whitespace removed while preserving all
ANSI codes. Note that whitespace styled with e.g background colour or
underline is still trimmed."
@values -min 1 -max 1
string -type string
} ]
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::trim
@cmd -name punk::ansi::ansistring::trim\
-summary\
"Trim leading and trailing whitespace from an ANSI string, preserving codes."\
-help\
"Return string with leading and trailing whitespace removed while
preserving all ANSI codes. Note that whitespace styled with e.g
background colour or underline is still trimmed."
@values -min 1 -max 1
string -type string
} ]
}
proc trimleft {string args} {
#todo - don't just trim whitespace - need to accept optional ?chars? to trim.
set intext 0
@ -10663,6 +11220,30 @@ tcl::namespace::eval punk::ansi::ansistring {
}
#Capitalised because it's the clustered grapheme/controlchar index - not the tcl string index
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::INDEX
@cmd -name punk::ansi::ansistring::INDEX\
-summary\
"Grapheme at index, prefixed with the SGR codes in effect at that position."\
-help\
"Return the grapheme cluster at position index of string, prefixed with a
merge of the SGR codes in effect at that position (built by tracking SGR
codes seen earlier in the string, restarting at any full SGR reset).
The index is a grapheme position (as counted by ansistring COUNT) - not
a tcl string index into the raw ANSI string. end-relative index
expressions are supported. An out of bounds index returns an empty
string, consistent with tcl string index.
The returned string has no trailing reset - even if an SGR code
immediately follows the indexed position in the original string.
Non-SGR codes are not applied to the output.
See also: ansistring INDEXCHAR (no codes), ansistring INDEXCODE (codes
only)."
@values -min 2 -max 2
string -type string
index -type indexexpression
} ]
}
proc INDEX {string index} {
#*** !doctools
#[call [fun index] [arg string] [arg index]]
@ -10929,6 +11510,22 @@ tcl::namespace::eval punk::ansi::ansistring {
return ""
}
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::INDEXCHAR
@cmd -name punk::ansi::ansistring::INDEXCHAR\
-summary\
"Grapheme at index with ANSI codes stripped."\
-help\
"Return the grapheme cluster at position index of string, with any ANSI
codes stripped (the plain counterpart to ansistring INDEX).
The index is a grapheme position - not a tcl string index into the raw
ANSI string. An out of bounds index returns an empty string."
@values -min 2 -max 2
string -type string
index -type indexexpression
} ]
}
proc INDEXCHAR {string index} {
#*** !doctools
#[call [fun INDEXCHAR] [arg string] [arg index]]
@ -10978,6 +11575,23 @@ tcl::namespace::eval punk::ansi::ansistring {
return $char
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::RANGE
@cmd -name punk::ansi::ansistring::RANGE\
-summary\
"Substring between grapheme positions, with ANSI codes preserved."\
-help\
"Return the substring of string between grapheme positions startindex
and endindex inclusive (positions as for ansistring INDEX), including
the ANSI codes in effect for those graphemes.
end-relative index expressions are supported."
@values -min 3 -max 3
string -type string
startindex -type indexexpression
endindex -type indexexpression
} ]
}
proc RANGE {string startindex endindex} {
#*** !doctools
#[call [fun RANGE] [arg string] [arg startindex] [arg endindex]]
@ -11082,6 +11696,27 @@ tcl::namespace::eval punk::ansi::ansistring {
return $rangeresult
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::INSERT
@cmd -name punk::ansi::ansistring::INSERT\
-summary\
"Insert a string at a grapheme position, wrapped in the codes in effect."\
-help\
"Return a new string with insertstr inserted at grapheme position index
(positions as for ansistring INDEX), or at the end of the string if
index is out of bounds. The inserted string is wrapped in the ANSI SGR
codes in effect at that position - e.g if a red foreground is in effect
there, the inserted string is also red - and the original styling is
re-established after the insertion.
end-relative index expressions are supported and behave as for tcl
string insert."
@values -min 3 -max 3
string -type string
index -type indexexpression
insertstr -type string
} ]
}
proc INSERT {string index insertstr} {
#*** !doctools
#[call [fun INSERT] [arg string] [arg index] [arg insertstr]]
@ -11214,6 +11849,23 @@ tcl::namespace::eval punk::ansi::ansistring {
#review - this is possibly too slow to be very useful as is.
# consider converting to oo and maintaining state of ansisplits so we don't repeat relatively expensive operations for same string
#see also punk::lib::lindex_resolve / punk::lindex_get for ways to handle tcl list/string indices without parsing them.
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::INDEXABSOLUTE
@cmd -name punk::ansi::ansistring::INDEXABSOLUTE\
-summary\
"Resolve index expressions against the ANSI-stripped content length."\
-help\
"Resolve each supplied index expression (integer, int+-int, or
end?+-int?) against the ANSI-stripped content length of string,
returning a list with one element per supplied expression: the resolved
absolute integer index, or an empty string where the expression falls
outside the content (negative, or at/past the content length)."
@values -min 1 -max -1
string -type string
index -type indexexpression -multiple 1 -optional 1
} ]
}
proc INDEXABSOLUTE {string args} {
set payload_len -1 ;# -1 as token to indicate we haven't calculated it yet (only want to call it once at most)
set testindices [list]
@ -11322,6 +11974,25 @@ tcl::namespace::eval punk::ansi::ansistring {
#return pair of column extents occupied by the character index supplied.
#single-width grapheme will return pair of integers of equal value
#double-width grapheme will return a pair of consecutive indices
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::INDEXCOLUMNS
@cmd -name punk::ansi::ansistring::INDEXCOLUMNS\
-summary\
"Column extents (1-based pair) occupied by the grapheme at an index."\
-help\
"Return the pair of 1-based column extents occupied by the grapheme at
position idx (positions as for ansistring INDEX): equal values for a
single-width grapheme, consecutive values for a double-width grapheme.
Returns an empty string for an out of bounds index.
Columns restart per line for multiline input; note that a 'row' of raw
ANSI input only corresponds to a rendered output row when the string
contains no cursor movement codes."
@values -min 2 -max 2
string -type string
idx -type indexexpression
} ]
}
proc INDEXCOLUMNS {string idx} {
#There is an index per grapheme - whether it is 1 or 2 columns wide
set index [lindex [INDEXABSOLUTE $string $idx] 0]
@ -11389,6 +12060,23 @@ tcl::namespace::eval punk::ansi::ansistring {
#multiple rows - return a list?
#return the grapheme index that occupies column col (could be first or second half of 2-wide grapheme)
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::ansi::ansistring::COLUMNINDEX
@cmd -name punk::ansi::ansistring::COLUMNINDEX\
-summary\
"Grapheme index occupying a given (1-based) column."\
-help\
"Return the grapheme index (position as for ansistring INDEX) that
occupies the 1-based column col - either half of a double-width
grapheme returns that grapheme's index. Returns nothing if col is
beyond the occupied columns.
Multiline input is not implemented (raises an error)."
@values -min 2 -max 2
string -type string
col -type integer
} ]
}
proc COLUMNINDEX {string col} {
set ansisplits [split_codes_single $string]; #we get empty pt(plaintext) between each ansi code that is in a run
@ -12945,7 +13633,7 @@ interp alias {} ansistring {} ::punk::ansi::ansistring
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::ansistring ::punk::ansi::colour ::punk::ansi::argdoc ::punk::ansi::class ::punk::ansi::ta ::punk::ansi::codetype
lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::ansistring ::punk::ansi::colour ::punk::ansi::argdoc ::punk::ansi::class ::punk::ansi::ta ::punk::ansi::codetype ::punk::ansi::sequence_type
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

3
src/modules/punk/ansi-buildversion.txt

@ -1,3 +1,4 @@
0.1.1
0.1.2
#First line must be a semantic version number
#all other lines are ignored.
#0.1.2 - documentation-only: PUNKARGS argdoc blocks added for punk::ansi::codetype (is_sgr_reset, has_sgr_leadingreset, is_cursor_move_in_line, has_all_effective, get_effective_types, is_gx/is_gx_open/is_gx_close, sgr_merge), punk::ansi::sequence_type (is_Fe7/is_Fe/is_Fe8, is_Fp, is_Fs, is_nF, is_3Fp, is_code7/is_code8/is_code, classify), punk::ansi::ta (detect_in_list, detectcode, detectcode_in_list, detect_g0, detect_open, detect_st_open, detect_csi, detect_sgr, split_at_codes, split_codes, split_codes_single, get_codes_single) and punk::ansi::ansistring (VIEW, COUNT, length, trimleft/trimright/trim, INDEX, INDEXCHAR, RANGE, INSERT, INDEXABSOLUTE, INDEXCOLUMNS, COLUMNINDEX); ::punk::ansi::sequence_type added to punk::args::register NAMESPACES so its argdocs are discoverable

3
src/tests/modules/AGENTS.md

@ -38,6 +38,9 @@ Unit tests for editable source modules under `src/modules/`, `src/modules_tcl8/`
## Child DOX Index
- `punkcheck/` — punkcheck module tests (install, summarize_install_resultdict, installtrack)
- `punk/ansi/` — punk::ansi tests (`testsuites/ansi/`): ansistrip/ansimerge, plus characterization of the ANSI-at-position mechanisms (`ansistring.test`: INDEX/INDEXCODE/INDEXCHAR/RANGE/INSERT grapheme indexing with SGR-prefix merging, INDEXCOLUMNS/COLUMNINDEX double-wide column mapping, trim/VIEW), code splitting invariants (`ta.test`: detect/detectcode distinction, split_codes/split_codes_single/split_at_codes shapes and round-trip) and single-code/effective-state semantics (`codetype.test`: is_sgr_reset/has_sgr_leadingreset, has_any/all_effective, sgr_merge, sequence_type classify). ANSI codes in these tests are literal escape strings so results are colour-state independent
- `punk/args/` — punk::args tests (`testsuites/args/`): parsing, choices/choicegroups, forms, rendering/indentation characterization, and usage-marking characterization (`usagemarking.test`: -parsedargs/-badarg/-scheme marking primitives plus goodchoice highlighting of selected/default-in-effect choice words, asserted by SGR-parameter subset against the live colour arrays; GAP pins for the nocolour-scheme fallthrough and shared colour-array leakage that G-049 will flip)
- `punk/ns/` — punk::ns tests (`testsuites/ns/`): cmdwhich/cmdinfo/cmd_traverse doc-lookup flow (`cmdflow.test`, G-040 parity) and cmdhelp usage-rendering integration (`cmdhelp.test`: scheme selection, goodarg/badarg marking, goodchoice highlighting of supplied/default choice words, alias path, cmdinfo result shape; GAP pins for badarg coverage/scheme-on-failure/caller attribution (G-049), pseudo-command cmdtype + space-form docid prefixes (G-051, real `string is` pins behind the have_tclcoredocs constraint), TclOO undocumented-method fallback (G-052), and synopsis marking absence (G-050))
- `punk/mix/` — punk::mix::cli tests (prune helpers, punkcheck virtual sources) and punk::mix::commandset::repo fossil move/rename characterization tests (`testsuites/repo/`, FOSSIL_HOME-isolated; GAP-marked tests pin behaviour G-022 will change)
- `punk/libunknown/` — .tm same-version shadowing pin-tests (`testsuites/shadowing/`): tcl::tm::add prepend rule, head-of-tm-list wins exact-version ties, version beats order, punk::libunknown parity — shipped behaviour depends on these (runtests tm ordering, punk_main package-mode precedence, G-033); mixed .tm/pkgIndex.tcl characterization is goal G-035

209
src/tests/modules/punk/ansi/testsuites/ansi/ansistring.test

@ -1,23 +1,186 @@
package require tcltest
namespace eval ::testspace {
namespace import ::tcltest::*
variable common {
set result ""
}
test ansistring_insert_end_relative {test ansistring INSERT matches string insert behaviour for end-relative indices}\
-setup $common -body {
lappend result [ansistring INSERT re end d]
lappend result [ansistring INSERT re end-1 d]
}\
-cleanup {
}\
-result [list\
red rde
]
}
tcltest::cleanupTests ;#needed to produce test summary.
package require tcltest
package require punk::lib
package require punk::ansi
#ansistring index/code-tracking characterization extended 2026-07-10 alongside the
#PUNKARGS documentation pass over ansistring/ta/codetype (punk::ansi 0.1.2).
#ansistring INDEX/INDEXCODE/RANGE are the canonical "ANSI in effect at a character
#position" mechanisms in punk (the test-local SGR helpers in the punk::args/punk::ns
#usage-marking suites are deliberately-independent miniatures of this) - so the
#grapheme indexing, code-prefix merging and column mapping are pinned here.
#ANSI codes are written as literal escape strings (not generated via a+) so the tests
#are independent of the punk::console colour on/off state.
#The fixture uses a CJK double-wide grapheme (丁) to pin grapheme-vs-column
#distinctions.
namespace eval ::testspace {
namespace import ::tcltest::*
variable common {
set result ""
}
variable RED "\x1b\[31m"
variable RESET "\x1b\[0m"
#a RED b <wide> BOLD c RESET d (graphemes: a b <wide> c d = 5)
variable S "a\x1b\[31mb丁\x1b\[1mc\x1b\[0md"
test ansistring_insert_end_relative {test ansistring INSERT matches string insert behaviour for end-relative indices}\
-setup $common -body {
lappend result [ansistring INSERT re end d]
lappend result [ansistring INSERT re end-1 d]
}\
-cleanup {
}\
-result [list\
red rde
]
test ansistring_count_and_length {COUNT counts graphemes, length counts stripped characters}\
-setup $common -body {
variable S
lappend result [ansistring COUNT $S]
lappend result [ansistring length $S]
lappend result [ansistring COUNT ""]
}\
-cleanup {
}\
-result [list 5 5 0]
test ansistring_index_code_prefix {INDEX returns the grapheme prefixed with the merged SGR codes in effect}\
-setup $common -body {
variable S
#no code in effect at position 0
lappend result [ansistring INDEX $S 0]
#red in effect at position 1
lappend result [ansistring INDEX $S 1]
#red then bold merged into a single code at position 3
lappend result [ansistring INDEX $S 3]
#the reset before 'd' restarts the tracked stack - reset code applied as prefix
lappend result [ansistring INDEX $S end]
#out of bounds - empty string as for tcl string index
lappend result [ansistring INDEX $S 99]
}\
-cleanup {
}\
-result [list\
a\
"\x1b\[31mb"\
"\x1b\[1;31mc"\
"\x1b\[0md"\
{}\
]
test ansistring_indexchar_stripped {INDEXCHAR returns just the grapheme}\
-setup $common -body {
variable S
lappend result [ansistring INDEXCHAR $S 1]
lappend result [ansistring INDEXCHAR $S 2]
lappend result [ansistring INDEXCHAR $S 99]
}\
-cleanup {
}\
-result [list b 丁 {}]
test ansistring_indexcode_in_effect {INDEXCODE returns the merged code in effect at a position; end+1 gives the state after the string}\
-setup $common -body {
variable S
lappend result [ansistring INDEXCODE $S 0]
lappend result [ansistring INDEXCODE $S 1]
lappend result [ansistring INDEXCODE $S 3]
lappend result [ansistring INDEXCODE $S end+1]
}\
-cleanup {
}\
-result [list\
{}\
"\x1b\[31m"\
"\x1b\[1;31m"\
"\x1b\[0m"\
]
test ansistring_range_preserves_codes {RANGE returns the grapheme range with codes in effect preserved}\
-setup $common -body {
variable S
set r [ansistring RANGE $S 1 3]
lappend result [punk::ansi::ansistrip $r]
lappend result $r
}\
-cleanup {
}\
-result [list\
"b丁c"\
"\x1b\[31mb丁\x1b\[1;31mc"\
]
test ansistring_insert_inside_styled_run {INSERT places the string at the grapheme position within the styled run}\
-setup $common -body {
variable S
set r [ansistring INSERT $S 2 X]
lappend result [punk::ansi::ansistrip $r]
lappend result $r
}\
-cleanup {
}\
-result [list\
"abX丁cd"\
"a\x1b\[31mbX丁\x1b\[1mc\x1b\[0md"\
]
test ansistring_indexabsolute {INDEXABSOLUTE resolves index expressions against the content length - empty string when out of bounds}\
-setup $common -body {
lappend result [ansistring INDEXABSOLUTE "abcde" 2 end end-1 7 -1 1+2]
}\
-cleanup {
}\
-result [list [list 2 4 3 {} {} 3]]
test ansistring_indexcolumns_doublewide {INDEXCOLUMNS returns 1-based column extents - a pair spanning two columns for a double-wide grapheme}\
-setup $common -body {
lappend result [ansistring INDEXCOLUMNS "a丁b" 0]
lappend result [ansistring INDEXCOLUMNS "a丁b" 1]
lappend result [ansistring INDEXCOLUMNS "a丁b" 2]
lappend result [ansistring INDEXCOLUMNS "a丁b" 9]
}\
-cleanup {
}\
-result [list {1 1} {2 3} {4 4} {}]
test ansistring_columnindex_doublewide {COLUMNINDEX maps either column of a double-wide grapheme to its index}\
-setup $common -body {
lappend result [ansistring COLUMNINDEX "a丁b" 1]
lappend result [ansistring COLUMNINDEX "a丁b" 2]
lappend result [ansistring COLUMNINDEX "a丁b" 3]
lappend result [ansistring COLUMNINDEX "a丁b" 4]
}\
-cleanup {
}\
-result [list 0 1 1 2]
test ansistring_trim_preserves_codes {trim/trimleft/trimright remove whitespace (including styled whitespace) while preserving codes}\
-setup $common -body {
variable RED
variable RESET
lappend result [ansistring trim " ${RED} x ${RESET} "]
lappend result [ansistring trimleft " ${RED} x "]
lappend result [ansistring trimright " x ${RESET} "]
}\
-cleanup {
}\
-result [list\
"\x1b\[31mx\x1b\[0m"\
"\x1b\[31mx "\
" x\x1b\[0m"\
]
test ansistring_view_visuals {VIEW substitutes ESC and (by default) space with control-picture equivalents; -sp 0 leaves spaces}\
-setup $common -body {
lappend result [ansistring VIEW "a b\x1b\[31m"]
lappend result [ansistring VIEW -sp 0 "a b"]
}\
-cleanup {
}\
-result [list "a␠b␛\[31m" "a b"]
}
tcltest::cleanupTests ;#needed to produce test summary.

163
src/tests/modules/punk/ansi/testsuites/ansi/codetype.test

@ -0,0 +1,163 @@
package require tcltest
package require punk::ansi
#Characterization of punk::ansi::codetype (single-code tests, effective-state queries,
#SGR merging) and punk::ansi::sequence_type (escape-form classification) - added
#2026-07-10 alongside the PUNKARGS documentation pass (punk::ansi 0.1.2).
#These are the primitives behind the ANSI-in-effect tracking used by ansistring
#INDEX/INDEXCODE and the usage-marking machinery, so their semantics are pinned directly.
#ANSI codes are written as literal escape strings (not generated via a+) so the tests are
#independent of the punk::console colour on/off state.
namespace eval ::testspace {
namespace import ::tcltest::*
variable common {
set result ""
}
variable RED "\x1b\[31m"
variable BOLD "\x1b\[1m"
variable RESET "\x1b\[0m"
#--- single-code tests --------------------------------------------------------------------
test codetype_is_sgr {is_sgr: trailing SGR detected; non-SGR CSI is not}\
-setup $common -body {
variable RED
lappend result [punk::ansi::codetype::is_sgr $RED]
lappend result [punk::ansi::codetype::is_sgr "\x1b\[2A"]
lappend result [punk::ansi::codetype::is_sgr "plain"]
}\
-cleanup {
}\
-result [list 1 0 0]
test codetype_is_sgr_reset {is_sgr_reset: pure trailing reset only - embedded or non-trailing resets not detected}\
-setup $common -body {
variable RESET
lappend result [punk::ansi::codetype::is_sgr_reset $RESET]
lappend result [punk::ansi::codetype::is_sgr_reset "\x1b\[m"]
#reset amongst other parameters is not a *pure* reset
lappend result [punk::ansi::codetype::is_sgr_reset "\x1b\[31;0m"]
#reset not at the very end is not detected
lappend result [punk::ansi::codetype::is_sgr_reset "${RESET}x"]
}\
-cleanup {
}\
-result [list 1 1 0 0]
test codetype_has_sgr_leadingreset {has_sgr_leadingreset: first parameter of the leading SGR must be a reset}\
-setup $common -body {
lappend result [punk::ansi::codetype::has_sgr_leadingreset "\x1b\[0;31m"]
lappend result [punk::ansi::codetype::has_sgr_leadingreset "\x1b\[31;0m"]
lappend result [punk::ansi::codetype::has_sgr_leadingreset "\x1b\[m"]
}\
-cleanup {
}\
-result [list 1 0 1]
test codetype_is_cursor_move_in_line {is_cursor_move_in_line: within-line moves (C/D/G) accepted, vertical moves not}\
-setup $common -body {
lappend result [punk::ansi::codetype::is_cursor_move_in_line "\x1b\[5C"]
lappend result [punk::ansi::codetype::is_cursor_move_in_line "\x1b\[3G"]
lappend result [punk::ansi::codetype::is_cursor_move_in_line "\x1b\[2A"]
}\
-cleanup {
}\
-result [list 1 1 0]
test codetype_is_gx_family {is_gx / is_gx_open / is_gx_close for G0/G1 charset sequences}\
-setup $common -body {
lappend result [punk::ansi::codetype::is_gx "\x1b(0abc\x1b(B"]
lappend result [punk::ansi::codetype::is_gx "\x1b(0abc"]
lappend result [punk::ansi::codetype::is_gx_open "\x1b(0"]
lappend result [punk::ansi::codetype::is_gx_close "\x1b(B"]
lappend result [punk::ansi::codetype::is_gx_open "\x1b(B"]
}\
-cleanup {
}\
-result [list 1 0 1 1 0]
#--- effective-state queries ---------------------------------------------------------------
test codetype_has_any_effective {has_any_effective: state must survive to the end of the string}\
-setup $common -body {
variable RED
variable RESET
lappend result [punk::ansi::codetype::has_any_effective "${RED}text" fg]
#a trailing reset makes the red ineffective
lappend result [punk::ansi::codetype::has_any_effective "${RED}text${RESET}" fg]
#no bg was ever set
lappend result [punk::ansi::codetype::has_any_effective "${RED}text" bg]
#any-semantics: one of the requested states suffices
lappend result [punk::ansi::codetype::has_any_effective "${RED}text" bg fg]
}\
-cleanup {
}\
-result [list 1 0 0 1]
test codetype_has_all_effective {has_all_effective: every requested state must be in effect; bold matches intensity 1}\
-setup $common -body {
variable RED
variable BOLD
lappend result [punk::ansi::codetype::has_all_effective "${RED}${BOLD}x" fg bold]
lappend result [punk::ansi::codetype::has_all_effective "${RED}x" fg bold]
}\
-cleanup {
}\
-result [list 1 0]
test codetype_get_effective_types {get_effective_types lists surviving states; a trailing reset clears them (the reset code itself still reports 'sgr')}\
-setup $common -body {
variable RED
variable BOLD
variable RESET
lappend result [punk::ansi::codetype::get_effective_types "${RED}${BOLD}x"]
lappend result [punk::ansi::codetype::get_effective_types "${RED}x${RESET}"]
}\
-cleanup {
}\
-result [list {sgr intensity fg bold} sgr]
test codetype_sgr_merge {sgr_merge combines separate SGR codes into a single code}\
-setup $common -body {
variable RED
variable BOLD
lappend result [punk::ansi::codetype::sgr_merge [list $RED $BOLD]]
}\
-cleanup {
}\
-result [list "\x1b\[1;31m"]
#--- sequence_type classification -----------------------------------------------------------
test sequence_type_classify {classify recognises Fp/Fe/Fs/nF/3Fp forms and unknown}\
-setup $common -body {
variable RED
lappend result [punk::ansi::sequence_type::classify $RED]
lappend result [punk::ansi::sequence_type::classify "\x1b7"]
lappend result [punk::ansi::sequence_type::classify "\x1bc"]
lappend result [punk::ansi::sequence_type::classify "\x1b(0"]
lappend result [punk::ansi::sequence_type::classify "\x1b#4"]
lappend result [punk::ansi::sequence_type::classify "abc"]
}\
-cleanup {
}\
-result [list Fe Fp Fs 0Fp 3Fp unknown]
test sequence_type_is_forms {is_Fp / is_Fs / is_nF / is_code form tests}\
-setup $common -body {
variable RED
lappend result [punk::ansi::sequence_type::is_Fp "\x1b7"]
lappend result [punk::ansi::sequence_type::is_Fs "\x1bc"]
lappend result [punk::ansi::sequence_type::is_nF "\x1b(0"]
lappend result [punk::ansi::sequence_type::is_Fe7 $RED]
lappend result [punk::ansi::sequence_type::is_code $RED]
lappend result [punk::ansi::sequence_type::is_code "abc"]
}\
-cleanup {
}\
-result [list 1 1 1 1 1 0]
}
tcltest::cleanupTests ;#needed to produce test summary line.

185
src/tests/modules/punk/ansi/testsuites/ansi/ta.test

@ -0,0 +1,185 @@
package require tcltest
package require punk::ansi
#Characterization of punk::ansi::ta (text-ansi) detection and splitting - added 2026-07-10
#alongside the PUNKARGS documentation pass over ta/codetype/sequence_type/ansistring
#(punk::ansi 0.1.2). These functions underpin most ANSI processing in punk (including the
#character-position code tracking that ansistring INDEX/INDEXCODE and opunk::Str INDEXCODE
#build on), so their splitting invariants are pinned directly here.
#ANSI codes are written as literal escape strings (not generated via a+) so the tests are
#independent of the punk::console colour on/off state.
namespace eval ::testspace {
namespace import ::tcltest::*
variable common {
set result ""
}
variable RED "\x1b\[31m"
variable BOLD "\x1b\[1m"
variable RESET "\x1b\[0m"
#--- detection ----------------------------------------------------------------------------
test ta_detect_basics {detect: complete codes detected, plain text and truncated sequences are not}\
-setup $common -body {
variable RED
lappend result [punk::ansi::ta::detect "a${RED}b"]
lappend result [punk::ansi::ta::detect "plain text"]
#a lone trailing ESC is not a complete code
lappend result [punk::ansi::ta::detect "abc\x1b"]
#a lone CSI opening is not a *complete* code either
lappend result [punk::ansi::ta::detect "abc\x1b\["]
}\
-cleanup {
}\
-result [list 1 0 0 0]
test ta_detectcode_lone_openings {detectcode: detects codes without requiring paired/complete sequences - a lone CSI opening counts}\
-setup $common -body {
variable RED
lappend result [punk::ansi::ta::detectcode "a${RED}b"]
lappend result [punk::ansi::ta::detectcode "plain text"]
#the difference from detect: a lone CSI opening is detected
lappend result [punk::ansi::ta::detectcode "abc\x1b\["]
#but a lone ESC alone is not
lappend result [punk::ansi::ta::detectcode "abc\x1b"]
}\
-cleanup {
}\
-result [list 1 0 1 0]
test ta_detect_in_list {detect_in_list/detectcode_in_list: per-element detection}\
-setup $common -body {
variable RED
lappend result [punk::ansi::ta::detect_in_list [list plain "a${RED}b" more]]
lappend result [punk::ansi::ta::detect_in_list [list plain more]]
lappend result [punk::ansi::ta::detectcode_in_list [list plain "abc\x1b\["]]
}\
-cleanup {
}\
-result [list 1 0 1]
test ta_detect_csi_vs_sgr {detect_csi detects any CSI sequence; detect_sgr only those ending in m}\
-setup $common -body {
variable RED
#cursor-up is a CSI but not an SGR
lappend result [punk::ansi::ta::detect_csi "\x1b\[2A"]
lappend result [punk::ansi::ta::detect_sgr "\x1b\[2A"]
lappend result [punk::ansi::ta::detect_csi "a${RED}b"]
lappend result [punk::ansi::ta::detect_sgr "a${RED}b"]
#an SGR reset is also an SGR
lappend result [punk::ansi::ta::detect_sgr "\x1b\[0m"]
}\
-cleanup {
}\
-result [list 1 0 1 1 1]
test ta_detect_g0 {detect_g0 requires a complete G0 open..close group}\
-setup $common -body {
lappend result [punk::ansi::ta::detect_g0 "\x1b(0qqq\x1b(B"]
lappend result [punk::ansi::ta::detect_g0 "\x1b(0qqq"]
lappend result [punk::ansi::ta::detect_g0 "plain"]
}\
-cleanup {
}\
-result [list 1 0 0]
#--- splitting ----------------------------------------------------------------------------
test ta_split_codes_shape {split_codes: plaintext on even indices, codes on odd; first/last always plaintext; consecutive codes stay together}\
-setup $common -body {
variable RED
variable BOLD
variable RESET
lappend result [punk::ansi::ta::split_codes ""]
lappend result [punk::ansi::ta::split_codes "a"]
#string ending in a code gets a trailing empty plaintext element
lappend result [punk::ansi::ta::split_codes "a${RED}"]
lappend result [punk::ansi::ta::split_codes "${RED}a${RESET}b"]
#consecutive codes remain in ONE code element
lappend result [punk::ansi::ta::split_codes "${RED}${BOLD}b"]
}\
-cleanup {
}\
-result [list\
{}\
[list a]\
[list a "\x1b\[31m" ""]\
[list "" "\x1b\[31m" a "\x1b\[0m" b]\
[list "" "\x1b\[31m\x1b\[1m" b]\
]
test ta_split_codes_single_shape {split_codes_single: each code in its own element with empty plaintext between consecutive codes}\
-setup $common -body {
variable RED
variable BOLD
lappend result [punk::ansi::ta::split_codes_single "${RED}${BOLD}b"]
lappend result [punk::ansi::ta::split_codes_single ""]
}\
-cleanup {
}\
-result [list\
[list "" "\x1b\[31m" "" "\x1b\[1m" b]\
{}\
]
test ta_split_at_codes_plaintext_only {split_at_codes returns only the plaintext portions}\
-setup $common -body {
variable RED
variable RESET
lappend result [punk::ansi::ta::split_at_codes "a${RED}b${RESET}c"]
lappend result [punk::ansi::ta::split_at_codes ""]
}\
-cleanup {
}\
-result [list [list a b c] {}]
test ta_get_codes_single {get_codes_single returns just the codes, one per element}\
-setup $common -body {
variable RED
variable BOLD
lappend result [punk::ansi::ta::get_codes_single "a${RED}b${BOLD}c"]
lappend result [punk::ansi::ta::get_codes_single "plain"]
}\
-cleanup {
}\
-result [list [list "\x1b\[31m" "\x1b\[1m"] {}]
test ta_split_roundtrip {joining split_codes / split_codes_single output reconstructs the original string}\
-setup $common -body {
variable RED
variable BOLD
variable RESET
set s "start${RED}${BOLD}mid${RESET}end"
lappend result [expr {[join [punk::ansi::ta::split_codes $s] ""] eq $s}]
lappend result [expr {[join [punk::ansi::ta::split_codes_single $s] ""] eq $s}]
}\
-cleanup {
}\
-result [list 1 1]
#--- length / extract ---------------------------------------------------------------------
test ta_length_excludes_codes {length counts characters excluding ANSI codes}\
-setup $common -body {
variable RED
lappend result [punk::ansi::ta::length "a${RED}b"]
lappend result [punk::ansi::ta::length ""]
}\
-cleanup {
}\
-result [list 2 0]
test ta_extract_codes_only {extract returns only the ANSI codes (opposite of strip)}\
-setup $common -body {
variable RED
variable RESET
lappend result [punk::ansi::ta::extract "a${RED}b${RESET}"]
}\
-cleanup {
}\
-result [list "\x1b\[31m\x1b\[0m"]
}
tcltest::cleanupTests ;#needed to produce test summary line.
Loading…
Cancel
Save