From fe85dfadd0399fb6674a9ef83c9327ab7d1572a2 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 10 Jul 2026 04:16:12 +1000 Subject: [PATCH] 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 --- src/modules/punk/ansi-999999.0a1.0.tm | 690 +++++++++++++++++- src/modules/punk/ansi-buildversion.txt | 3 +- src/tests/modules/AGENTS.md | 3 + .../punk/ansi/testsuites/ansi/ansistring.test | 209 +++++- .../punk/ansi/testsuites/ansi/codetype.test | 163 +++++ .../modules/punk/ansi/testsuites/ansi/ta.test | 185 +++++ 6 files changed, 1228 insertions(+), 25 deletions(-) create mode 100644 src/tests/modules/punk/ansi/testsuites/ansi/codetype.test create mode 100644 src/tests/modules/punk/ansi/testsuites/ansi/ta.test diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 3eaabdd8..1ef883ed 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/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 + Ft / 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 $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 [list $re_ansi_detectcode]] { regexp $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 [list $re_g0_group]] { regexp $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_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 } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ diff --git a/src/modules/punk/ansi-buildversion.txt b/src/modules/punk/ansi-buildversion.txt index 781c895b..c9312fe1 100644 --- a/src/modules/punk/ansi-buildversion.txt +++ b/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 diff --git a/src/tests/modules/AGENTS.md b/src/tests/modules/AGENTS.md index 211f266f..7e076623 100644 --- a/src/tests/modules/AGENTS.md +++ b/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 diff --git a/src/tests/modules/punk/ansi/testsuites/ansi/ansistring.test b/src/tests/modules/punk/ansi/testsuites/ansi/ansistring.test index 3fd834fe..d7ecc3ac 100644 --- a/src/tests/modules/punk/ansi/testsuites/ansi/ansistring.test +++ b/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. \ No newline at end of file +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 BOLD c RESET d (graphemes: a b 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. diff --git a/src/tests/modules/punk/ansi/testsuites/ansi/codetype.test b/src/tests/modules/punk/ansi/testsuites/ansi/codetype.test new file mode 100644 index 00000000..1dcab77a --- /dev/null +++ b/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. diff --git a/src/tests/modules/punk/ansi/testsuites/ansi/ta.test b/src/tests/modules/punk/ansi/testsuites/ansi/ta.test new file mode 100644 index 00000000..f87b37b2 --- /dev/null +++ b/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.