diff --git a/src/modules/canaryspace-999999.0a1.0.tm b/src/modules/canaryspace-999999.0a1.0.tm index 80cee604..4bebef94 100644 --- a/src/modules/canaryspace-999999.0a1.0.tm +++ b/src/modules/canaryspace-999999.0a1.0.tm @@ -13,8 +13,8 @@ # Meta summary Diagnostic tool for namespace navigation/introspection to help avoid command conflicts. # Meta description canaryspace loads the ::canaryspace namespace with wrappers for the set of commands # Meta description that exist in the global namespace :: at the time the canaryspace package is loaded. -# Meta description These commands just emit info to stderr to assist in determining whether calls are -# Meta description unintentionally being run in the namespace. +# Meta description These commands just emit info to stderr to assist in determining whether calls are +# Meta description unintentionally being run in the namespace. # Meta description This is often the case with commands which use uplevel 1 or similar constructs to call # Meta description code in the callers namespace. If such commands need to run in arbitrary namespaces # Meta description which may have arbitrary commands then uplevelled commands may need to be prefixed with @@ -68,6 +68,6 @@ namespace eval canaryspace { ## Ready package provide canaryspace [namespace eval canaryspace { ::variable version - ::set version 999999.0a1.0 + ::set version 999999.0a1.0 }] return \ No newline at end of file diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index a53ea000..d43529f1 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -1583,7 +1583,7 @@ namespace eval punk { } %# { set active_key_type "string" - if $get_not { + if {$get_not} { error "!%# not string length is not supported" } #string length - REVIEW - @@ -1595,7 +1595,7 @@ namespace eval punk { %%# { #experimental set active_key_type "string" - if $get_not { + if {$get_not} { error "!%%# not string length is not supported" } #string length - REVIEW - @@ -1606,7 +1606,7 @@ namespace eval punk { } %str { set active_key_type "string" - if $get_not { + if {$get_not} { error "!%str - not string-get is not supported" } lappend INDEX_OPERATIONS string-get @@ -1617,7 +1617,7 @@ namespace eval punk { %sp { #experimental set active_key_type "string" - if $get_not { + if {$get_not} { error "!%sp - not string-space is not supported" } lappend INDEX_OPERATIONS string-space @@ -1628,7 +1628,7 @@ namespace eval punk { %empty { #experimental set active_key_type "string" - if $get_not { + if {$get_not} { error "!%empty - not string-empty is not supported" } lappend INDEX_OPERATIONS string-empty @@ -1638,7 +1638,7 @@ namespace eval punk { } @words { set active_key_type "string" - if $get_not { + if {$get_not} { error "!%words - not list-words-from-string is not supported" } lappend INDEX_OPERATIONS list-words-from-string @@ -1650,7 +1650,7 @@ namespace eval punk { #experimental - leading character based on result not input(?) #input type is string - but output is list set active_key_type "list" - if $get_not { + if {$get_not} { error "!%chars - not list-chars-from-string is not supported" } lappend INDEX_OPERATIONS list-from_chars @@ -1662,7 +1662,7 @@ namespace eval punk { #experimental - flatten one level of list #join without arg - output is list set active_key_type "string" - if $get_not { + if {$get_not} { error "!@join - not list-join-list is not supported" } lappend INDEX_OPERATIONS list-join-list @@ -1674,7 +1674,7 @@ namespace eval punk { #experimental #input type is list - but output is string set active_key_type "string" - if $get_not { + if {$get_not} { error "!%join - not string-join-list is not supported" } lappend INDEX_OPERATIONS string-join-list @@ -1684,7 +1684,7 @@ namespace eval punk { } %ansiview { set active_key_type "string" - if $get_not { + if {$get_not} { error "!%# not string-ansiview is not supported" } lappend INDEX_OPERATIONS string-ansiview @@ -1694,7 +1694,7 @@ namespace eval punk { } %ansiviewstyle { set active_key_type "string" - if $get_not { + if {$get_not} { error "!%# not string-ansiviewstyle is not supported" } lappend INDEX_OPERATIONS string-ansiviewstyle @@ -5368,6 +5368,7 @@ namespace eval punk { #for var="val {a b c}" #proc ::punk::val {{v {}}} {tailcall lindex $v} #proc ::punk::val {{v {}}} {return $v} ;#2023 - approx 2x faster than the tailcall lindex version + #tclint-disable-next-line proc ::punk::val [list [list v [purelist]]] {return $v} #---------------- @@ -7437,7 +7438,7 @@ namespace eval punk { foreach v $known_punk { set c1 [overtype::left $col1 $v] if {[info exists ::env($v)]} { - set c2 [overtype::left $col2 [set ::env($v)] + set c2 [overtype::left $col2 [set ::env($v)]] } else { set c2 [overtype::right $col2 "(NOT SET)"] } diff --git a/src/modules/punk/char-999999.0a1.0.tm b/src/modules/punk/char-999999.0a1.0.tm index 94f382c9..05e7875a 100644 --- a/src/modules/punk/char-999999.0a1.0.tm +++ b/src/modules/punk/char-999999.0a1.0.tm @@ -19,7 +19,7 @@ #[manpage_begin punkshell_module_punk::char 0 999999.0a1.0] #[copyright "2024"] #[titledesc {character-set and unicode utilities}] [comment {-- Name section and table of contents description --}] -#[moddesc {character-set nad unicode}] [comment {-- Description at end of page heading --}] +#[moddesc {character-set nad unicode}] [comment {-- Description at end of page heading --}] #[require punk::char] #[keywords module encodings] #[description] @@ -49,11 +49,11 @@ #*** !doctools #[item] [package {overtype}] -#[para] - +#[para] - #[item] [package {textblock}] -#[para] - +#[para] - #[item] [package console] -#[para] - +#[para] - package require Tcl 8.6- #dependency on tcllib not ideal for bootstrapping as punk::char is core to many features.. (textutil::wcswidth is therefore included in bootsupport/include_modules.config) review @@ -92,20 +92,20 @@ tcl::namespace::eval punk::char { #just the 7-bit ascii. use [page ascii] for the 8-bit layout proc ascii {} {return { 00 NUL 01 SOH 02 STX 03 ETX 04 EOT 05 ENQ 06 ACK 07 BEL - 08 BS 09 HT 0a LF 0b VT 0c FF 0d CR 0e SO 0f SI + 08 BS 09 HT 0a LF 0b VT 0c FF 0d CR 0e SO 0f SI 10 DLE 11 DC1 12 DC2 13 DC3 14 DC4 15 NAK 16 SYN 17 ETB - 18 CAN 19 EM 1a SUB 1b ESC 1c FS 1d GS 1e RS 1f US - 20 SP 21 ! 22 " 23 # 24 $ 25 % 26 & 27 ' - 28 ( 29 ) 2a * 2b + 2c , 2d - 2e . 2f / - 30 0 31 1 32 2 33 3 34 4 35 5 36 6 37 7 - 38 8 39 9 3a : 3b ; 3c < 3d = 3e > 3f ? - 40 @ 41 A 42 B 43 C 44 D 45 E 46 F 47 G - 48 H 49 I 4a J 4b K 4c L 4d M 4e N 4f O - 50 P 51 Q 52 R 53 S 54 T 55 U 56 V 57 W - 58 X 59 Y 5a Z 5b [ 5c \ 5d ] 5e ^ 5f _ - 60 ` 61 a 62 b 63 c 64 d 65 e 66 f 67 g - 68 h 69 i 6a j 6b k 6c l 6d m 6e n 6f o - 70 p 71 q 72 r 73 s 74 t 75 u 76 v 77 w + 18 CAN 19 EM 1a SUB 1b ESC 1c FS 1d GS 1e RS 1f US + 20 SP 21 ! 22 " 23 # 24 $ 25 % 26 & 27 ' + 28 ( 29 ) 2a * 2b + 2c , 2d - 2e . 2f / + 30 0 31 1 32 2 33 3 34 4 35 5 36 6 37 7 + 38 8 39 9 3a : 3b ; 3c < 3d = 3e > 3f ? + 40 @ 41 A 42 B 43 C 44 D 45 E 46 F 47 G + 48 H 49 I 4a J 4b K 4c L 4d M 4e N 4f O + 50 P 51 Q 52 R 53 S 54 T 55 U 56 V 57 W + 58 X 59 Y 5a Z 5b [ 5c \ 5d ] 5e ^ 5f _ + 60 ` 61 a 62 b 63 c 64 d 65 e 66 f 67 g + 68 h 69 i 6a j 6b k 6c l 6d m 6e n 6f o + 70 p 71 q 72 r 73 s 74 t 75 u 76 v 77 w 78 x 79 y 7a z 7b { 7c | 7d } 7e ~ 7f DEL }} @@ -124,7 +124,7 @@ tcl::namespace::eval punk::char { } elseif {[tcl::string::length $v] == 0} { set v " " } - append out "$k $v " + append out "$k $v " if {$i > 0 && $i % 8 == 0} { set out [tcl::string::range $out 0 end-2] append out \n " " @@ -143,7 +143,7 @@ tcl::namespace::eval punk::char { set out "" append out [page dingbats] \n set unicode_dict [charset_dictget Dingbats] - + append out " " set i 1 tcl::dict::for {k charinfo} $unicode_dict { @@ -155,7 +155,7 @@ tcl::namespace::eval punk::char { } else { set displayv $char } - append out "$k $displayv " + append out "$k $displayv " if {$i > 0 && $i % 8 == 0} { set out [tcl::string::range $out 0 end-2] append out \n " " @@ -205,7 +205,7 @@ tcl::namespace::eval punk::char { tcl::dict::lappend d $encname $mname } } - } + } foreach enc [lsort $encnames] { set mime_enc [${encmimens}::mapencoding $enc] if {$mime_enc ne ""} { @@ -236,7 +236,7 @@ tcl::namespace::eval punk::char { tailcall page $encname {*}$args } - #This will not display for example, c0 glyphs for cp437 + #This will not display for example, c0 glyphs for cp437 # we could use the punk::ansi::cp437_map dict - but while that might be what some expect to see - it would probably be too much magic for this function - which is intended to align more with what Tcl's encoding convertfrom/to actually does. # for nonprinting members of the page, 2 and 3 letter codes are used rather than unicode visualisation replacements or even unicode equivalent replacements known to be appropriate for the page proc page {encname args} { @@ -255,7 +255,7 @@ tcl::namespace::eval punk::char { #set d_ascii [pagedict_raw ascii] set d_ascii [basedict] - set d_asciiposn [lreverse $d_ascii] ;#values should be unique except for "???". We are mainly interested in which ones have display-names e.g cr csi + set d_asciiposn [lreverse $d_ascii] ;#values should be unique except for "???". We are mainly interested in which ones have display-names e.g cr csi #The results of this are best seen by comparing the ebcdic and ascii pages set d_page [pagedict_raw $encname] @@ -285,7 +285,7 @@ tcl::namespace::eval punk::char { set displayv $bytedisplay } else { if {[tcl::string::length $rawchar] == 0} { - set displayv " " + set displayv " " } else { #presumed 1 set displayv " $rawchar " @@ -294,7 +294,7 @@ tcl::namespace::eval punk::char { } } - append out "$k $displayv " + append out "$k $displayv " if {$i > 0 && $i % $cols == 0} { set out [tcl::string::range $out 0 end-2] append out \n " " @@ -318,7 +318,7 @@ tcl::namespace::eval punk::char { set outchar [encoding convertfrom $encpage $ch] } else { #here we will use \0xFFFD instead of our replacement string ??? - as the name pagechar implies always returning a single character. REVIEW. - set outchar $::punk::char::invalid_display_char + set outchar $::punk::char::invalid_display_char } return $outchar } @@ -348,7 +348,7 @@ tcl::namespace::eval punk::char { #set outchar [encoding convertto $encpage [format %c $num]] set outchar [format %c $num] } else { - set outchar $::punk::char::invalid_display_char + set outchar $::punk::char::invalid_display_char } return $outchar } @@ -381,7 +381,7 @@ tcl::namespace::eval punk::char { } proc pagedict_raw {encname} { - variable invalid ;# ="???" + variable invalid ;# ="???" set encname [encname $encname] set d [tcl::dict::create] for {set i 0} {$i < 256} {incr i} { @@ -409,7 +409,7 @@ tcl::namespace::eval punk::char { tcl::dict::set d $k [tcl::dict::get $a128 $k] } else { # - tcl::dict::set d $k $invalid + tcl::dict::set d $k $invalid } if {$i <=32} { @@ -457,7 +457,7 @@ tcl::namespace::eval punk::char { } return $d } - + proc basedict {} { #this gives same result independent of current value of 'encoding system' set d [tcl::dict::create] @@ -529,10 +529,10 @@ tcl::namespace::eval punk::char { return $d } - #-- --- --- --- --- --- --- --- + #-- --- --- --- --- --- --- --- # encoding convertfrom & encoding convertto can be somewhat confusing to think about. (Need to think in reverse.) # e.g encoding convertto dingbats will output something that doesn't look dingbatty on screen. - #-- --- --- --- --- --- --- --- + #-- --- --- --- --- --- --- --- #must use Tcl instead of tcl (at least for 8.6) if {![package vsatisfies [package present Tcl] 8.7-]} { proc encodable "s {enc [encoding system]}" { @@ -574,7 +574,7 @@ tcl::namespace::eval punk::char { } } } - #-- --- --- --- --- --- --- --- + #-- --- --- --- --- --- --- --- proc test_japanese {{encoding jis0208}} { #A very basic test of 2char encodings such as jis0208 set yatbun 日本 ;# encoding convertfrom jis0208 F|K\\ @@ -584,7 +584,7 @@ tcl::namespace::eval punk::char { set ebun [encoding convertto $encoding $bun] puts "$encoding encoded: ${eyat} ${ebun}" puts "reencoded: [encoding convertfrom $encoding $eyat] [encoding convertfrom $encoding $ebun]" - return $yatbun + return $yatbun } proc test_grave {} { set g [format %c 0x300] @@ -692,7 +692,7 @@ tcl::namespace::eval punk::char { #ESC ( B ESC ) B ASCII Set #ESC ( 0 ESC ) 0 Special Graphics #ESC ( 1 ESC ) 1 Alternate Character ROM Standard Character Set - #ESC ( 2 ESC ) 2 Alternate Character ROM Special Graphic + #ESC ( 2 ESC ) 2 Alternate Character ROM Special Graphic # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # Unicode character sets - some hardcoded - some loadable from data files @@ -700,7 +700,7 @@ tcl::namespace::eval punk::char { variable charinfo [tcl::dict::create] variable charsets [tcl::dict::create] - + # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # Aggregate character sets (ones that pick various ranges from underlying unicode ranges) # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -741,7 +741,7 @@ tcl::namespace::eval punk::char { } # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - # Unicode ranges + # Unicode ranges # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- tcl::dict::set charsets "greek" [list ranges [list {start 880 end 1023} {start 7936 end 8191}] description "Greek and Coptic" settype "other"] @@ -975,9 +975,9 @@ tcl::namespace::eval punk::char { variable charset_extents_rangenames ;# dict keyed on start,end pointing to list of 2-tuples {setname rangeindex_within_set} #build 2 indexes for each range.(charsets are not just unicode blocks so can have multiple ranges) #Note that a range could be as small as a single char (startpoint = endpoint) so there can be many ranges with same start and end if charsets use some of the same subsets. - #as each charset_extents_startpoins,charset_extents_endpoints is built - the associated range name and index is appended to the rangenames dict - #startpoints - key is startpoint of a range, value is list of endpoints one for each range starting at this startpoint-key - #endpoints - key is endpoint of a range, value is list of startpoints one for each range ending at this endpoint-key + #as each charset_extents_startpoins,charset_extents_endpoints is built - the associated range name and index is appended to the rangenames dict + #startpoints - key is startpoint of a range, value is list of endpoints one for each range starting at this startpoint-key + #endpoints - key is endpoint of a range, value is list of startpoints one for each range ending at this endpoint-key proc _build_charset_extents {} { variable charsets variable charset_extents_startpoints @@ -995,7 +995,7 @@ tcl::namespace::eval punk::char { set end [tcl::dict::get [lindex $ranges 0] end] if {![tcl::dict::exists $charset_extents_startpoints $start] || $end ni [tcl::dict::get $charset_extents_startpoints $start]} { #assertion if end wasn't in startpoits list - then start won't be in endpoints list - tcl::dict::lappend charset_extents_startpoints $start $end + tcl::dict::lappend charset_extents_startpoints $start $end tcl::dict::lappend charset_extents_endpoints $end $start } tcl::dict::lappend charset_extents_rangenames ${start},${end} [list $setname 1] @@ -1023,14 +1023,14 @@ tcl::namespace::eval punk::char { #no need to sort charset_extents_rangenames - lookup only done using dict methods return [tcl::dict::size $charset_extents_startpoints] } - _build_charset_extents ;#rebuilds for all charsets + _build_charset_extents ;#rebuilds for all charsets #nerdfonts are within the Private use E000 - F8FF range proc load_nerdfonts {} { variable charsets variable charinfo package require fileutil - set ver [package provide punk::char] + set ver [package provide punk::char] if {$ver ne ""} { set ifneeded [package ifneeded punk::char [package provide punk::char]] #puts stderr "punk::char ifneeded script: $ifneeded" @@ -1038,7 +1038,7 @@ tcl::namespace::eval punk::char { set basedir [file dirname [lindex $sourceinfo end]] } else { #review - will only work at package load time - set scr [info script] + set scr [info script] if {$scr eq ""} { error "load_nerdfonts unable to determine package folder" } @@ -1048,7 +1048,7 @@ tcl::namespace::eval punk::char { set fname [file join $pkg_data_dir nerd-fonts-glyph-list.txt] if {[file exists $fname]} { #puts stderr "load_nerdfonts loading $fname" - set data [fileutil::cat -translation binary $fname] + set data [fileutil::cat -translation binary $fname] set short_seen [tcl::dict::create] set current_set_range [tcl::dict::create] set filesets_loading [list] @@ -1066,7 +1066,7 @@ tcl::namespace::eval punk::char { dict unset charset $setname } set newrange [list start $dec end $dec] - tcl::dict::set current_set_range $setname $newrange + tcl::dict::set current_set_range $setname $newrange tcl::dict::set charsets $setname [list ranges [list $newrange] description "nerd fonts $rawsetname" settype "nerdfonts privateuse"] lappend filesets_loading $setname @@ -1080,13 +1080,13 @@ tcl::namespace::eval punk::char { #overwrite last ranges element set rangelist [lrange [tcl::dict::get $charsets $setname ranges] 0 end-1] lappend rangelist [tcl::dict::get $current_set_range $setname] - tcl::dict::set charsets $setname ranges $rangelist + tcl::dict::set charsets $setname ranges $rangelist } else { #new range for set tcl::dict::set current_set_range $setname start $dec tcl::dict::set current_set_range $setname end $dec set rangelist [tcl::dict::get $charsets $setname ranges] - lappend rangelist [tcl::dict::get $current_set_range $setname] + lappend rangelist [tcl::dict::get $current_set_range $setname] tcl::dict::set charsets $setname ranges $rangelist } @@ -1130,7 +1130,7 @@ tcl::namespace::eval punk::char { proc package_base {} { #assume punk::char is in .tm form and we can use the package provide statement to determine base location - #review + #review set pkgver [package present punk::char] set pkginfo [package ifneeded punk::char $pkgver] set tmfile [lindex $pkginfo end] @@ -1156,7 +1156,7 @@ tcl::namespace::eval punk::char { if {[tcl::dict::exists $dictValue {*}$keys]} { return [tcl::dict::get $dictValue {*}$keys] } else { - return [lindex $args end] + return [lindex $args end] } } } @@ -1193,7 +1193,7 @@ tcl::namespace::eval punk::char { if {[set pcolon [tcl::string::first ";" $ln]] > 0} { set lhs [tcl::string::trim [tcl::string::range $ln 0 $pcolon-1]] set name [tcl::string::trim [tcl::string::range $ln $pcolon+1 end]] - set lhsparts [split $lhs .] + set lhsparts [split $lhs .] set start [lindex $lhsparts 0] set end [lindex $lhsparts end] #puts "$start -> $end '$name'" @@ -1207,9 +1207,9 @@ tcl::namespace::eval punk::char { return $block_count } - #unicode scripts + #unicode scripts - #unicode UnicodeData.txt + #unicode UnicodeData.txt @@ -1225,8 +1225,8 @@ tcl::namespace::eval punk::char { # -- --- #A = Ambiguous - All characters that can be sometimes wide and sometimes narrow. (wide in east asian legacy sets, narrow in non-east asian usage) (private use chars considered ambiguous) #F = East Asian Full-width - #H = East Asian Half-width - #N = Not east Asian (Neutral) - all other characters. (do not occur in legacy East Asian character sets) - treated like Na + #H = East Asian Half-width + #N = Not east Asian (Neutral) - all other characters. (do not occur in legacy East Asian character sets) - treated like Na #Na = East Asian Narrow - all other characters that are always narrow and have explicit full-width counterparts (e.g includes all of ASCII) #W = East Asian Wide - all other characters that are always wide (Occur only in the context of Eas Asian Typography) # -- --- @@ -1304,7 +1304,7 @@ tcl::namespace::eval punk::char { set initial_fields $known_fields if {"testwidth" ni $opt_fields} { if {"testwidth" ni $opt_except} { - lappend opt_except testwidth + lappend opt_except testwidth } } if {"char" ni $opt_fields} { @@ -1369,13 +1369,13 @@ tcl::namespace::eval punk::char { #testwidth is one of the main ones likely to be worthwhile excluding as querying the console via ansi takes time set existing_testwidth "" if {[tcl::dict::exists $charinfo $dec_char testwidth]} { - set existing_testwidth [tcl::dict::get $charinfo $dec_char testwidth] + set existing_testwidth [tcl::dict::get $charinfo $dec_char testwidth] } if {$existing_testwidth eq ""} { #no cached data - do expensive cursor-position test (Note this might not be 100% reliable - terminals lie e.g if ansi escape sequence has set to wide printing.) set char [format %c $dec_char] set chwidth [char_info_testwidth $char] - + tcl::dict::set returninfo testwidth $chwidth #cache it. todo - -verify flag to force recalc in case font/terminal changed in some way? tcl::dict::set charinfo $dec_char testwidth $chwidth @@ -1387,10 +1387,10 @@ tcl::namespace::eval punk::char { set char [format %c $dec_char] tcl::dict::set returninfo char $char } - memberof { + memberof { #memberof takes in the order of a few hundred microseconds if a simple scan of all ranges is taken - possibly worthwhile caching/optimising #note that memberof is not just unicode blocks - but scripts and other non-contiguous sets consisting of multiple ranges - some of which may include ranges of a single character. (e.g WGL4) - #This means there probably isn't a really efficient means of calculating membership other than scanning all the defined ranges. + #This means there probably isn't a really efficient means of calculating membership other than scanning all the defined ranges. #We could potentially populate it using a side-thread - but it seems reasonable to just cache result after first use here. #some efficiency could also be gained by pre-calculating the extents for each charset which isn't a simple unicode block. (and perhaps sorting by max char) set memberof [list] @@ -1435,7 +1435,7 @@ tcl::namespace::eval punk::char { set splen [tcl::dict::size $charset_extents_startpoints] set eplen [tcl::dict::size $charset_extents_endpoints] set s [lsearch -bisect -integer $skeys $dec] - set s_at_or_below [lrange $skeys 0 $s] + set s_at_or_below [lrange $skeys 0 $s] set e_of_s [list] foreach sk $s_at_or_below { lappend e_of_s {*}[tcl::dict::get $charset_extents_startpoints $sk] @@ -1472,16 +1472,16 @@ tcl::namespace::eval punk::char { set eps [list] } - + return [tcl::dict::create startpoints $splen endpoints $eplen midpoint [expr {floor($eplen/2)}] posn $e lhs_endpoints_to_check "[llength $reduced_endpoints]/[llength $e_of_s]=[llength $sps]ranges" rhs_startpoints_to_check "[llength $reduced_startpoints]/[llength $s_of_e]=[llength $eps]"] } #for just a few extra sets such as wgl4 and unicode blocks loaded - this gives e.g 5x + better performance than the simple search above, and up to twice as slow for tcl 8.6 #performance biased towards lower numbered characters (which is not too bad in the context of unicode) #todo - could be tuned to perform better at end by assuming a fairly even distribution of ranges - and so searching startpoint ranges first for items left of middle, endpoint ranges first for items right of middle - #review with scripts loaded and more defined ranges.. + #review with scripts loaded and more defined ranges.. #This algorithm supports arbitrary overlapping ranges and ranges with same start & endpoints #Should be much better than O(n) for n sets except for pathological case of member of all or nearly-all intervals ? - #review - compare with 'interval tree' algorithms. + #review - compare with 'interval tree' algorithms. proc char_info_dec_memberof {dec} { variable charset_extents_startpoints variable charset_extents_endpoints @@ -1563,7 +1563,7 @@ tcl::namespace::eval punk::char { set matchcount 0 foreach glob $and_globs { if {[tcl::string::match -nocase $glob $s] || [tcl::string::match -nocase $glob $d]} { - incr matchcount + incr matchcount } } if {$matchcount == [llength $and_globs]} { @@ -1595,12 +1595,12 @@ tcl::namespace::eval punk::char { } - #non-overlapping unicode blocks + #non-overlapping unicode blocks proc char_blocks {{name_or_glob *}} { variable charsets #todo - more efficient datastructures? if {![regexp {[?*]} $name_or_glob]} { - #no glob - just retrieve it + #no glob - just retrieve it if {[tcl::dict::exists $charsets $name_or_glob]} { if {[tcl::dict::get $charsets $name_or_glob settype] eq "block"} { return [tcl::dict::create $name_or_glob [tcl::dict::get $charsets $name_or_glob]] @@ -1630,7 +1630,7 @@ tcl::namespace::eval punk::char { proc charset_names {{name_or_glob *}} { variable charsets if {![regexp {[?*]} $name_or_glob]} { - #no glob - just retrieve it + #no glob - just retrieve it if {[tcl::dict::exists $charsets $name_or_glob]} { return [list $name_or_glob] } @@ -1641,7 +1641,7 @@ tcl::namespace::eval punk::char { } } else { if {$name_or_glob eq "*"} { - return [lsort [tcl::dict::keys $charsets]] + return [lsort [tcl::dict::keys $charsets]] } #tcl::dict::keys $dict doesn't have option for case insensitive searches return [lsort [lsearch -all -inline -nocase [tcl::dict::keys $charsets] $name_or_glob]] @@ -1655,7 +1655,7 @@ tcl::namespace::eval punk::char { variable charsets #dictionary sorting of the keys is slow! - we should obviously store it in sorted order instead of sorting entire list on retrieval - or just sort results #set sortedkeys [lsort -increasing -dictionary [tcl::dict::keys $charsets]] ;#NOTE must use -dictionary to use -sorted flag below - set sortedkeys [lsort -increasing [tcl::dict::keys $charsets]] + set sortedkeys [lsort -increasing [tcl::dict::keys $charsets]] if {$namesearch eq "*"} { return $sortedkeys } @@ -1664,7 +1664,7 @@ tcl::namespace::eval punk::char { return [lsearch -all -inline -nocase $sortedkeys $namesearch] ;#no point using -sorted flag when -all is used } else { #return [lsearch -sorted -inline -nocase $sortedkeys $namesearch] ;#no globs - bails out earlier if -sorted? - return [lsearch -inline -nocase $sortedkeys $namesearch] ;#no globs + return [lsearch -inline -nocase $sortedkeys $namesearch] ;#no globs } } proc charsets {{namesearch *}} { @@ -1738,7 +1738,7 @@ tcl::namespace::eval punk::char { set opt_ansi [tcl::dict::get $opts -ansi] set opt_lined [tcl::dict::get $opts -lined] # -- --- --- --- - set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} if {$opt_ansi} { set a1 [a BLACK white bold] @@ -1768,7 +1768,7 @@ tcl::namespace::eval punk::char { } set i 1 append out \n $prefix $charsetname - append out \n + append out \n set marker_line $prefix set line $prefix @@ -1847,7 +1847,7 @@ tcl::namespace::eval punk::char { } else { set charset_dict [charset_dictget $charsetname] } - + set col_items_short [list] set col_items_desc [list] tcl::dict::for {k inf} $charset_dict { @@ -1873,7 +1873,7 @@ tcl::namespace::eval punk::char { return $out } - #use console cursor movements to test and cache the column-width of each char in the set of characters returned by the search criteria + #use console cursor movements to test and cache the column-width of each char in the set of characters returned by the search criteria proc charset_calibrate {namesearch args} { variable charsets variable charinfo @@ -1909,7 +1909,7 @@ tcl::namespace::eval punk::char { set twidth [tcl::dict::get $charinfo $dec testwidth] } if {$twidth eq ""} { - #puts -nonewline stdout "." ;#this + #puts -nonewline stdout "." ;#this set width [char_info_testwidth $ch] ;#based on console test rather than unicode props tcl::dict::set charinfo $dec testwidth $width } else { @@ -1925,10 +1925,10 @@ tcl::namespace::eval punk::char { #maint warning - also in overtype! #intended for single grapheme - but will work for multiple - #cannot contain ansi or newlines + #cannot contain ansi or newlines #(a cache of ansifreestring_width calls - as these are quite regex heavy) #review - effective memory leak on longrunning programs if never cleared - #tradeoff in fragmenting cache and reducing efficiency vs ability to clear in a scoped manner + #tradeoff in fragmenting cache and reducing efficiency vs ability to clear in a scoped manner proc grapheme_width_cached {ch {key ""}} { variable grapheme_widths #if key eq "*" - we won't be able to clear that cache individually. Perhaps that's ok @@ -1975,7 +1975,7 @@ tcl::namespace::eval punk::char { # - compare with wcswidth returning -1 for entire string containing such in python,perl proc wcswidth {string} { #faster than textutil::wcswidth (at least for string up to a few K in length) - #..but - 'scan' is horrible for 400K+ (Tcl evaluation stack has to be reallocated/copied?) + #..but - 'scan' is horrible for 400K+ (Tcl evaluation stack has to be reallocated/copied?) #Tcl initial evaluation stack size is 2000 (? review) #REVIEW - when we cater for grapheme clusters - we can't just split the string at arbitrary points like this!! set chunksize 2000 @@ -1984,14 +1984,14 @@ tcl::namespace::eval punk::char { set startidx 0 set endidx [expr {$startidx + $chunksize -1}] for {set i 0} {$i < $chunks_required} {incr i} { - set chunk [tcl::string::range $string $startidx $endidx] + set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] foreach c $codes { if {$c <= 255 && !($c < 31 || $c == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? - #todo - compare with python or other lang wcwidth - incr width + #todo - compare with python or other lang wcwidth + incr width } elseif {$c < 917504 || $c > 917631} { #TODO - various other joiners and non-printing chars set w [textutil::wcswidth_char $c] @@ -2023,7 +2023,7 @@ tcl::namespace::eval punk::char { set graphemes [list] while {$i < [tcl::string::length $string]} { set aftercluster [tk::endOfCluster $string $i] - lappend graphemes [string range $string $i $aftercluster-1] + lappend graphemes [string range $string $i $aftercluster-1] set i $aftercluster } return $graphemes @@ -2052,15 +2052,15 @@ tcl::namespace::eval punk::char { } } incr width $gw - + #if {[string first \u200d $g] >=0} { - # incr width 2 + # incr width 2 #} else { # #other joiners??? # incr width [wcswidth_unclustered $g] #} } else { - incr width [wcswidth_unclustered $g] + incr width [wcswidth_unclustered $g] } set i $aftercluster } @@ -2071,8 +2071,8 @@ tcl::namespace::eval punk::char { scan $char %c dec if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? - #todo - compare with python or other lang wcwidth - return 1 + #todo - compare with python or other lang wcwidth + return 1 } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars return [textutil::wcswidth_char $dec] ;#note textutil::wcswidth_char takes a decimal codepoint! @@ -2086,8 +2086,8 @@ tcl::namespace::eval punk::char { scan $c %c dec if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? - #todo - compare with python or other lang wcwidth - incr width + #todo - compare with python or other lang wcwidth + incr width } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint @@ -2105,7 +2105,7 @@ tcl::namespace::eval punk::char { # - compare with wcswidth returning -1 for entire string containing such in python,perl proc wcswidth_unclustered {string} { #faster than textutil::wcswidth (at least for string up to a few K in length) - #..but - 'scan' is horrible for 400K+ (Tcl evaluation stack has to be reallocated/copied?) + #..but - 'scan' is horrible for 400K+ (Tcl evaluation stack has to be reallocated/copied?) #Tcl initial evaluation stack size is 2000 (? review) #we can only split the string at arbitrary points like this because we are specifically dealing with input that has no clusters!. set chunksize 2000 @@ -2114,14 +2114,14 @@ tcl::namespace::eval punk::char { set startidx 0 set endidx [expr {$startidx + $chunksize -1}] for {set i 0} {$i < $chunks_required} {incr i} { - set chunk [tcl::string::range $string $startidx $endidx] + set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] foreach dec $codes { if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? - #todo - compare with python or other lang wcwidth - incr width + #todo - compare with python or other lang wcwidth + incr width } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars set w [textutil::wcswidth_char $dec] @@ -2141,8 +2141,8 @@ tcl::namespace::eval punk::char { proc wcswidth0 {string} { #faster than textutil::wcswidth (at least for string up to a few K in length) - #..but - 'scan' is horrible for 400K+ - #TODO + #..but - 'scan' is horrible for 400K+ + #TODO set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 foreach dec $codes { @@ -2150,9 +2150,9 @@ tcl::namespace::eval punk::char { if {$dec < 917504 || $dec > 917631} { if {$dec <= 255} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? - #todo - compare with python or other lang wcwidth + #todo - compare with python or other lang wcwidth if {!($dec < 31 || $dec == 127)} { - incr width + incr width } } else { #TODO - various other joiners and non-printing chars @@ -2179,11 +2179,11 @@ tcl::namespace::eval punk::char { #prerequisites - no ansi escapes - no newlines - utf8 encoding assumed #review - what about \r \t \b ? #NO processing of \b - already handled in ansi::printing_length which then calls this - #this version breaks string into sequences of ascii vs unicode + #this version breaks string into sequences of ascii vs unicode proc ansifreestring_width {text} { #caller responsible for calling ansistrip first if text may have ansi codes - and for ensuring no newlines #we can c0 control characters after or while processing ansi escapes. - #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) + #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error #if {[tcl::string::first \033 $text] >= 0} { # error "string_width doesn't accept ansi escape sequences. Use punk::ansi::ansistrip first" @@ -2204,11 +2204,11 @@ tcl::namespace::eval punk::char { #experiment to detect leading diacritics - but this isn't necessary - it's still zero-width - and if the user is splitting properly we shouldn't be getting a string with leading diacritics anyway #(leading combiners may display in terminal as mark on rightmost prompt char which is usually a space - but won't add width even then) - #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} + #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} #if {[regexp $re_leading_diacritic $text]} { - # set text " $text" + # set text " $text" #} - set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} set text [regsub -all $re_diacritics $text ""] # -- --- --- --- --- --- --- @@ -2221,10 +2221,10 @@ tcl::namespace::eval punk::char { #for now - strip them out #ZWNJ \u200c should also be zero length - but as a 'non' joiner - it should add zero to the length - #ZWSP \u200b zero width space + #ZWSP \u200b zero width space #\uFFEFBOM/ ZWNBSP and others that should be zero width - #todo - work out proper way to mark/group zero width. + #todo - work out proper way to mark/group zero width. #set text [tcl::string::map [list \u200b "" \u200c "" \u200d "" \uFFEF ""] $text] set text [tcl::string::map [list \u200b "" \u200c "" \u200d ""] $text] @@ -2241,7 +2241,7 @@ tcl::namespace::eval punk::char { #c1 controls - first section of the Latin-1 Supplement block - all non-printable from a utf-8 perspective #some or all of these may have a visual representation in other encodings e.g cp855 seems to have 1 width for them all - #we are presuming that the text supplied has been converted from any other encoding to utf8 - so we don't need to handle that here + #we are presuming that the text supplied has been converted from any other encoding to utf8 - so we don't need to handle that here #they should also be unlikely to be present in an ansi-free string (as is a precondition for use of this function) set text [regsub -all {[\u0080-\u009f]+} $text ""] @@ -2262,7 +2262,7 @@ tcl::namespace::eval punk::char { #set can_regex_high_unicode [tcl::string::match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] #tcl pre 2023-11 - braced high unicode regexes don't work #fixed in bug-4ed788c618 2023-11 - #set uc_chars [regexp -all -inline "\[\u0100-\U10FFFF\]" $text] ;#e.g return list of chars in range only + #set uc_chars [regexp -all -inline "\[\u0100-\U10FFFF\]" $text] ;#e.g return list of chars in range only #maintain unicode as sequences - todo - scan for grapheme clusters #set uc_sequences [punk::ansi::ta::_perlish_split "(?:\[\u0100-\U10FFFF\])+" $text] @@ -2291,7 +2291,7 @@ tcl::namespace::eval punk::char { #we can c0 control characters after or while processing ansi escapes. - #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) + #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error #if {[tcl::string::first \033 $text] >= 0} { # error "string_width doesn't accept ansi escape sequences. Use punk::ansi::ansistrip first" @@ -2312,11 +2312,11 @@ tcl::namespace::eval punk::char { #experiment to detect leading diacritics - but this isn't necessary - it's still zero-width - and if the user is splitting properly we shouldn't be getting a string with leading diacritics anyway #(leading combiners may display in terminal as mark on rightmost prompt char which is usually a space - but won't add width even then) - #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} + #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} #if {[regexp $re_leading_diacritic $text]} { - # set text " $text" + # set text " $text" #} - set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} set text [regsub -all $re_diacritics $text ""] #review @@ -2325,7 +2325,7 @@ tcl::namespace::eval punk::char { #ZWNJ \u0200c should also be zero length - but as a 'non' joiner - it should add zero to the length - #ZWSP \u0200b zero width space + #ZWSP \u0200b zero width space #we should only map control sequences to nothing after processing ones with length effects, such as \b (\x07f) or DEL \x1f @@ -2343,10 +2343,10 @@ tcl::namespace::eval punk::char { } #review - wcswidth should detect these - set re_ascii_fullwidth {[\uFF01-\uFF5e]} + set re_ascii_fullwidth {[\uFF01-\uFF5e]} set doublewidth_char_count 0 - set zerowidth_char_count 0 + set zerowidth_char_count 0 #split just to get the standalone character widths - and then scan for other combiners (?) #review #set can_regex_high_unicode [tcl::string::match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] @@ -2354,7 +2354,7 @@ tcl::namespace::eval punk::char { #fixed in bug-4ed788c618 2023-11 #set uc_sequences [regexp -all -inline -indices {[\u0100-\U10FFFF]} $text] #set uc_sequences [regexp -all -inline -indices "\[\u0100-\U10FFFF\]" $text] ;#e.g for string: \U0001f9d1abc\U001f525ab returns {0 0} {4 4} - set uc_chars [regexp -all -inline "\[\u0100-\U10FFFF\]" $text] ;#e.g return list of chars in range only + set uc_chars [regexp -all -inline "\[\u0100-\U10FFFF\]" $text] ;#e.g return list of chars in range only foreach c $uc_chars { if {[regexp $re_ascii_fullwidth $c]} { incr doublewidth_char_count @@ -2364,12 +2364,12 @@ tcl::namespace::eval punk::char { # b)- textutil::wcswidth_char seems to be east-asian-width based - and not a reliable indicator of 'character cells taken by the character when printed to the terminal' despite this statement in tclllib docs. #(character width is a complex context-dependent topic) # c) by checking for a cached console testwidth first - we make this function less deterministic/repeatable depending on whether console tests have been run. - # d) Upstream caching of grapheme_width may also lock in a result from whatever method was first employed here + # d) Upstream caching of grapheme_width may also lock in a result from whatever method was first employed here #Despite all this - the mechanism is hoped to give best effort consistency for terminals - #further work needed for combining emojis etc - which can't be done in a per character loop + #further work needed for combining emojis etc - which can't be done in a per character loop #todo - see if wcswidth does any of this. It is very slow for strings that include mixed ascii/unicode - so perhaps we can use a perlish_split # to process sequences of unicode. - #- and the user has the option to test character sets first if terminal position reporting gives better results + #- and the user has the option to test character sets first if terminal position reporting gives better results if {[char_info_is_testwidth_cached $c]} { set width [char_info_testwidth_cached $c] } else { @@ -2378,7 +2378,7 @@ tcl::namespace::eval punk::char { set width [textutil::wcswidth_char [scan $c %c]] } if {$width == 0} { - incr zerowidth_char_count + incr zerowidth_char_count } elseif {$width == 2} { incr doublewidth_char_count } @@ -2395,7 +2395,7 @@ tcl::namespace::eval punk::char { #we can c0 control characters after or while processing ansi escapes. - #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) + #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error #if {[tcl::string::first \033 $text] >= 0} { # error "string_width doesn't accept ansi escape sequences. Use punk::ansi::ansistrip first" @@ -2416,11 +2416,11 @@ tcl::namespace::eval punk::char { #experiment to detect leading diacritics - but this isn't necessary - it's still zero-width - and if the user is splitting properly we shouldn't be getting a string with leading diacritics anyway #(leading combiners may display in terminal as mark on rightmost prompt char which is usually a space - but won't add width even then) - #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} + #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} #if {[regexp $re_leading_diacritic $text]} { - # set text " $text" + # set text " $text" #} - set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} set text [regsub -all $re_diacritics $text ""] #we should only map control sequences to nothing after processing ones with length effects, such as \b (\x07f) or DEL \x1f @@ -2437,7 +2437,7 @@ tcl::namespace::eval punk::char { return [tcl::string::length $text] } - #slow when ascii mixed with unicode (but why?) + #slow when ascii mixed with unicode (but why?) return [punk::char::wcswidth $text] } #This shouldn't be called on text containing ansi codes! @@ -2516,11 +2516,11 @@ tcl::namespace::eval punk::char { return [format $fmt {*}$declist] } - #split into plaintext and runs of combiners (combining diacritical marks - not ZWJ or ZWJNJ) + #split into plaintext and runs of combiners (combining diacritical marks - not ZWJ or ZWJNJ) proc combiner_split {text} { #split into odd numbered list (or zero) in a similar way to punk::ansi::ta::_perlish_split # - #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} set graphemes [list] if {[tcl::string::length $text] == 0} { return {} @@ -2528,12 +2528,12 @@ tcl::namespace::eval punk::char { set list [list] set start 0 set strlen [tcl::string::length $text] - #make sure our regexes aren't non-greedy - or we may not have exit condition for loop + #make sure our regexes aren't non-greedy - or we may not have exit condition for loop #review while {$start < $strlen && [regexp -start $start -indices -- {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} $text match]} { lassign $match matchStart matchEnd #puts "->start $start ->match $matchStart $matchEnd" - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] set start [expr {$matchEnd+1}] } lappend list [tcl::string::range $text $start end] @@ -2547,7 +2547,7 @@ tcl::namespace::eval punk::char { #This is difficult in Tcl without unicode property based Character Classes in the regex engine #review - this needs to be performant - it is used a lot by punk terminal/ansi features #todo - trie data structures for unicode? - #for now we can at least combine diacritics + #for now we can at least combine diacritics #should also handle the ZWJ (and the variation selectors? eg \uFE0F) character which should account for emoji clusters #Note - emoji cluster could be for example 11 code points/41 bytes (family emoji with skin tone modifiers for each member, 3 ZWJs) #This still leaves a whole class of clusters.. korean etc unhandled :/ @@ -2560,7 +2560,7 @@ tcl::namespace::eval punk::char { set clist [split $pt ""] lappend graphemes {*}[lrange $clist 0 end-1] lappend graphemes [tcl::string::cat [lindex $clist end] $combiners] - } + } #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme if {[lindex $csplits end] ne ""} { lappend graphemes {*}[split [lindex $csplits end] ""] @@ -2575,7 +2575,7 @@ tcl::namespace::eval punk::char { set combiner_decs [scan $combiners [tcl::string::repeat %c [tcl::string::length $combiners]]] lset pt_decs end [concat [lindex $pt_decs end] $combiner_decs] lappend graphemes {*}$pt_decs - } + } #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme if {[lindex $csplits end] ne ""} { lappend graphemes {*}[scan [lindex $csplits end] [tcl::string::repeat %c [tcl::string::length [lindex $csplits end]]]] @@ -2592,7 +2592,7 @@ tcl::namespace::eval punk::char { lset pt_decs end [concat [lindex $pt_decs end] $combiner_decs] } lappend graphemes {*}$pt_decs - } + } return $graphemes } proc grapheme_split2 {text} { @@ -2601,7 +2601,7 @@ tcl::namespace::eval punk::char { foreach {pt combiners} [lrange $csplits 0 end-1] { set clist [split $pt ""] lappend graphemes {*}[lrange $clist 0 end-1] [tcl::string::cat [lindex $clist end] $combiners] - } + } #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme if {[lindex $csplits end] ne ""} { lappend graphemes {*}[split [lindex $csplits end] ""] @@ -2645,10 +2645,10 @@ tcl::namespace::eval punk::char { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready +## Ready package provide punk::char [tcl::namespace::eval punk::char { variable version - set version 999999.0a1.0 + set version 999999.0a1.0 }] return diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 6fc60a2c..e0b822e8 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -777,7 +777,7 @@ namespace eval punk::console { set extension [lindex [split $waitvar($callid) -] 1] if {$extension eq ""} { puts "blank extension $waitvar($callid)" - puts "->[set $waitvar($callid]<-" + puts "->[set $waitvar($callid)]<-" } puts stderr "get_ansi_response_payload Extending timeout by $extension" after cancel $timeoutid($callid) diff --git a/src/modules/punk/icomm-999999.0a1.0.tm b/src/modules/punk/icomm-999999.0a1.0.tm index c88e173c..7c5560d4 100644 --- a/src/modules/punk/icomm-999999.0a1.0.tm +++ b/src/modules/punk/icomm-999999.0a1.0.tm @@ -21,7 +21,7 @@ #[manpage_begin shellspy_module_punk::icomm 0 999999.0a1.0] #[copyright "2025"] #[titledesc {Module API}] [comment {-- Name section and table of contents description --}] -#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] #[require punk::icomm] #[keywords module] #[description] @@ -107,7 +107,7 @@ package require punk::args # # Note that the actual code was changed in several places (Reordered, # eval speedup) -# +# # comm works just like Tk's send, except that it uses sockets. # These commands work just like "send" and "winfo interps": # @@ -116,7 +116,7 @@ package require punk::args # # See the manual page comm.n for further details on this package. -package require Tcl 8.6- +package require Tcl 8.6- package require snit ; # comm::future objects. namespace eval ::punk::icomm { @@ -196,7 +196,7 @@ namespace eval ::punk::icomm { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[subsection {Namespace punk::icomm}] - #[para] Core API functions for punk::icomm + #[para] Core API functions for punk::icomm #[list_begin definitions] variable PUNKARGS @@ -306,7 +306,7 @@ namespace eval ::punk::icomm { ## API: Setup async result generation for a remotely invoked command. # (future,fid,) -> list (future) - # (current,async) -> bool (default 0) + # (current,async) -> bool (default 0) # (current,state) -> list (chan fid cmd ser) proc comm_cmd_return_async {chan} { @@ -711,7 +711,6 @@ namespace eval ::punk::icomm { # # Results: # None. - proc commConfigure {chan {force 0} args} { variable comm @@ -891,7 +890,7 @@ namespace eval ::punk::icomm { #treat as always connected - call commIncoming imediately. punk::icomm::commIncoming $chan $comm($chan,tclchan) "localaddr" "localtclchan" return - } + } #------------------------- @@ -1133,7 +1132,7 @@ namespace eval ::punk::icomm { } if {![info exists vers]} { close $fid - if {[info exists comm($chan,silent)] && + if {[info exists comm($chan,silent)] && [string is true -strict $comm($chan,silent)]} { return } @@ -1382,7 +1381,7 @@ namespace eval ::punk::icomm { # Unpack the indices, then extract the word. #foreach {s e step} $cmdrange break lassign $cmdrange s e step - + set cmd [string range $data $s $e] commDebug {puts stderr "<$chan> cmd <$data>"} if {[string equal "" $cmd]} break @@ -1849,7 +1848,7 @@ namespace eval ::punk::icomm { # backslash-quoted braces we look for double-backslashes # as well and skip them. Without this a string like '{puts # \\}' will incorrectly find a \} at the end, missing the - # end of the word. + # end of the word. set re {((\\\\)|([{}])|(\\[{}]))} ;#split out for dumb editor to fix highlighting # ^^ ^ ^ # |\\ regular \quoted @@ -2018,14 +2017,14 @@ tcl::namespace::eval punk::icomm::lib { tcl::namespace::path [tcl::namespace::parent] #*** !doctools #[subsection {Namespace punk::icomm::lib}] - #[para] Secondary functions that are part of the API + #[para] Secondary functions that are part of the API #[list_begin definitions] #proc utility1 {p1 args} { # #*** !doctools # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] - # #[para]Description of utility1 - # return 1 + # #[para]Description of utility1 + # return 1 #} @@ -2043,16 +2042,16 @@ tcl::namespace::eval punk::icomm::lib { #tcl::namespace::eval punk::icomm::system { #*** !doctools #[subsection {Namespace punk::icomm::system}] - #[para] Internal functions that are not part of the API + #[para] Internal functions that are not part of the API #} -# == === === === === === === === === === === === === === === +# == === === === === === === === === === === === === === === # Sample 'about' function with punk::args documentation -# == === === === === === === === === === === === === === === +# == === === === === === === === === === === === === === === tcl::namespace::eval punk::icomm { tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase variable PUNKARGS @@ -2061,7 +2060,7 @@ tcl::namespace::eval punk::icomm { lappend PUNKARGS [list { @id -id "(package)punk::icomm" @package -name "punk::icomm" -help\ - "taken from tcllib comm package + "taken from tcllib comm package todo - describe changes" }] @@ -2076,7 +2075,7 @@ tcl::namespace::eval punk::icomm { set about_topics [list] foreach f $topic_funs { set tail [namespace tail $f] - lappend about_topics [string range $tail [string length get_topic_] end] + lappend about_topics [string range $tail [string length get_topic_] end] } #Adjust this function or 'default_topics' if a different order is required return [lsort $about_topics] @@ -2084,11 +2083,11 @@ tcl::namespace::eval punk::icomm { proc default_topics {} {return [list Description *]} # ------------------------------------------------------------- - # get_topic_ functions add more to auto-include in about topics + # get_topic_ functions add more to auto-include in about topics # ------------------------------------------------------------- proc get_topic_Description {} { - punk::args::lib::tstr [string trim { - package punk::icomm + punk::args::lib::tstr [string trim { + package punk::icomm description to come.. } \n] } @@ -2122,9 +2121,9 @@ tcl::namespace::eval punk::icomm { # we re-use the argument definition from punk::args::standard_about and override some items set overrides [dict create] dict set overrides @id -id "::punk::icomm::about" - dict set overrides @cmd -name "punk::icomm::about" + dict set overrides @cmd -name "punk::icomm::about" dict set overrides @cmd -help [string trim [punk::args::lib::tstr { - About punk::icomm + About punk::icomm }] \n] dict set overrides topic -choices [list {*}[punk::icomm::argdoc::about_topics] *] dict set overrides topic -choicerestricted 1 @@ -2140,7 +2139,7 @@ tcl::namespace::eval punk::icomm { } } # end of sample 'about' function -# == === === === === === === === === === === === === === === +# == === === === === === === === === === === === === === === # ----------------------------------------------------------------------------- @@ -2155,11 +2154,11 @@ namespace eval ::punk::args::register { # ----------------------------------------------------------------------------- # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready +## Ready package provide punk::icomm [tcl::namespace::eval punk::icomm { variable pkg punk::icomm variable version - set version 999999.0a1.0 + set version 999999.0a1.0 }] return diff --git a/src/modules/punk/jtest.tcl b/src/modules/punk/jtest.tcl index 6379cfd9..2447100b 100644 --- a/src/modules/punk/jtest.tcl +++ b/src/modules/punk/jtest.tcl @@ -41,4 +41,5 @@ defaultSilent 0 } #test - set x blah \ No newline at end of file + set x blah + diff --git a/src/modules/punk/repl-999999.0a1.0.tm b/src/modules/punk/repl-999999.0a1.0.tm index bb06e1bd..baaac1ef 100644 --- a/src/modules/punk/repl-999999.0a1.0.tm +++ b/src/modules/punk/repl-999999.0a1.0.tm @@ -8,7 +8,7 @@ global run_commandstr "" set stdin_info [chan configure stdin] if {[dict exists $stdin_info -inputmode]} { - #this is the only way I currently know to detect console on windows.. doesn't work on Alma linux. + #this is the only way I currently know to detect console on windows.. doesn't work on Alma linux. # tcl_interactive used by repl to determine if stderr output prompt to be printed. # (that way, piping commands into stdin should not produce prompts for each command) set tcl_interactive 1 @@ -63,7 +63,7 @@ if {![info exists ::env(TERM)]} { #todo - move to less generic namespace ie punk::repl namespace eval repl { - variable codethread + variable codethread if {![info exists codethread]} { set codethread "" } @@ -122,7 +122,7 @@ namespace eval punk::repl { puts stderr "^^^^^^^^^^^^^^^^^^^" } proc bgerror {args} { - set message [lindex $args 0] + set message [lindex $args 0] set errdict [lindex $args 1] puts stderr "\n*> repl background error: '$message'" #puts stderr "*> [set ::errorInfo]" @@ -159,8 +159,8 @@ proc ::punk::repl::init_signal_handlers {} { variable signal_control_c_msg switch -- [lindex $args 0] { ctrl-c { - #puts stderr "->event $args" - flush stderr + #puts stderr "->event $args" + flush stderr incr signal_control_c #rputs stderr "* console_control: $args" if {[tsv::get console is_raw]} { @@ -170,7 +170,7 @@ proc ::punk::repl::init_signal_handlers {} { #review - dodgy.. we just want to interrupt child processes but then still be able to interrupt repl set ::punk::repl::signal_control_c 0 set preverr [string map {"child killed" "child_killed"} $::errorInfo] - catch {error $preverr} ;#for errorInfo display + catch {error $preverr} ;#for errorInfo display return 42 } else { #how to let rawmode loop handle it? It doesn't seem to get through if we return 0 @@ -183,7 +183,7 @@ proc ::punk::repl::init_signal_handlers {} { puts stderr "signal ctrl-c error get_size error:$errM" } - if {$signal_control_c < 3} { + if {$signal_control_c < 3} { set remaining [expr {3 - $signal_control_c}] if {[catch { punk::repl::console_controlnotification "[a+ web-orange]ctrl-c ($remaining more to quit, enter to continue)[a]" $console_width $console_height @@ -198,12 +198,12 @@ proc ::punk::repl::init_signal_handlers {} { puts stderr "signal ctrl-c error console_controlnotification error:$errM" } flush stderr - after 25 + after 25 quit return 1 } elseif {$signal_control_c > 5} { #fallback if quit didn't work - #puts stderr "signal ctrl-c $signal_control_c received - sending to default handler" + #puts stderr "signal ctrl-c $signal_control_c received - sending to default handler" if {[catch { punk::repl::console_controlnotification "ctrl-c $signal_control_c received - sending to default handler" $console_width $console_height } errM]} { @@ -214,7 +214,7 @@ proc ::punk::repl::init_signal_handlers {} { return 0 } - return 1 + return 1 #after 200 {exit 42} ;#temp #return 42 } @@ -224,8 +224,8 @@ proc ::punk::repl::init_signal_handlers {} { if {[lindex $::errorCode 0] eq "CHILDKILLED"} { set signal_control_c 0 set preverr [string map {"child killed" "child_killed"} $::errorInfo] - catch {error $preverr} ;#for errorInfo display - return 42 + catch {error $preverr} ;#for errorInfo display + return 42 } if {[catch { lassign [punk::console::get_size] _w console_width _h console_height @@ -252,7 +252,7 @@ proc ::punk::repl::init_signal_handlers {} { puts stderr "signal ctrl-c error console_controlnotification error:$errM" } flush stderr - after 25 + after 25 quit return 1 } elseif {$signal_control_c == 4} { @@ -280,7 +280,7 @@ proc ::punk::repl::init_signal_handlers {} { } } twapi::set_console_control_handler ::punk::repl::handler_console_control - #we can't yet emit from an event with proper prompt handling - + #we can't yet emit from an event with proper prompt handling - #repl::rputs stdout "twapi loaded" } else { #repl::rputs stderr " Failed to load twapi" @@ -360,7 +360,7 @@ proc repl::start {inchan args} { #review if {$codethread eq ""} { error "start - no codethread. call init first. (options -safe 0|1)" - } + } variable commandstr # --- @@ -398,9 +398,9 @@ proc repl::start {inchan args} { namespace eval ::punk::repl::codethread {} set ::punk::repl::codethread::running 1 namespace eval ::punk::ns::ns_current {} - set ::punk::ns::ns_current %ns1% + set ::punk::ns::ns_current %ns1% } - }] + }] set commandstr "" # --- @@ -409,10 +409,10 @@ proc repl::start {inchan args} { set editbuf_linenum_submitted 0 set editbuf_active_index 0 # --- - + if {$::punk::console::ansi_wanted == 2} { if {[::punk::console::test_can_ansi]} { - set ::punk::console::ansi_wanted 1 + set ::punk::console::ansi_wanted 1 } else { set ::punk::console::ansi_wanted -1 } @@ -422,7 +422,7 @@ proc repl::start {inchan args} { doprompt "P% " fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] set reading 1 - + #catch { # set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] #} @@ -458,7 +458,7 @@ proc repl::start {inchan args} { } thread::cancel $codethread thread::cond destroy $codethread_cond ;#race if we destroy cond before child thread has exited - as it can send a -async quit - set codethread "" + set codethread "" set codethread_cond "" punk::console::mode line ;#review - revert to line mode on final exit - but we may be exiting a nested repl puts "end repl::start" @@ -498,7 +498,7 @@ proc repl::reopen_stdin {} { puts stderr "restarting repl on inputchannel:$s" return [repl::start $s -title "reopen_stdin a"] } else { - #/dev/tty - reference to the controlling terminal for a process + #/dev/tty - reference to the controlling terminal for a process #review/test set s [open "/dev/tty" r] } @@ -506,7 +506,7 @@ proc repl::reopen_stdin {} { repl::start stdin -title "reopen_stdin b" } -#todo - avoid putting this in gobal namespace? +#todo - avoid putting this in gobal namespace? #collisions with other libraries apps? proc punk::repl::quit {args} { set ::repl::done "quit {*}$args" @@ -518,7 +518,7 @@ proc punk::repl::quit {args} { proc repl::reopen_stdinX {} { #windows - todo unix package require twapi - + if 0 { if {[catch {package require Memchan} errM]} { #package require tcl::chan::fifo2 @@ -527,52 +527,52 @@ proc repl::reopen_stdinX {} { set x [tcl::chan::fifo] } else { #lassign [fifo2] a b - set x [fifo] + set x [fifo] } #first channel opened after stdin closed becomes stdin #use a fifo or fifo2 because [chan pipe] assigns the wrong end first! - #a will be stdin + #a will be stdin } #these can't replace proper stdin (filehandle 0) because they're not 'file backed' or 'os level' #try opening a named pipe server to become stdin set pipename {\\.\pipe\stdin_%id%} set pipename [string map [list %id% [pid]] $pipename] - - - + + + package require tcl::chan::fifo - + chan close stdin - lassign [tcl::chan::fifo] a - - + lassign [tcl::chan::fifo] a + + puts stderr "newchan: $a" puts stderr "|test> $a [chan conf $a]" - + #set server [twapi::namedpipe_server $pipename] #set client [twapi::namedpipe_client $pipename] ;#open a client and connect to the server we just made puts stderr "chan names: [chan names]" - + #by now $server not valid? - #set server stdin - + #set server stdin + #chan configure $server -buffering line -encoding unicode #chan configure $client -buffering line -encoding unicode - + #puts stderr "|test>ns-server $server [chan conf $server]" #puts stderr "|test>ns-client $client [chan conf $client]" - + set conin [twapi::get_console_handle stdin] twapi::set_standard_handle stdin $conin - + set h_in [twapi::get_standard_handle stdin] - + puts stderr "|test> $a [chan conf $a]" - + #chan configure $client -blocking 0 after 2 repl::start $a - + } #add to sliding buffer of last x chars emmitted to screen by repl @@ -642,17 +642,17 @@ proc repl::newout2 {} { #-------------------------------------- proc repl::doprompt {prompt {col {green bold}}} { - #prompt to stderr. + #prompt to stderr. #We can pipe commands into repl's stdin without the prompt interfering with the output. #Although all command output for each line goes to stdout - not just what is emitted with puts - + if {$::tcl_interactive} { flush stdout; #we are writing this prompt on stderr, but stdout could still be writing to screen #our first char on stderr is based on the 'lastchar' of stdout which we have recorded but may not have arrived on screen. #The issue we're trying to avoid is the (stderr)prompt arriving midway through a large stdout chunk #REVIEW - this basic attempt to get stderr/stdout to cooperate is experimental and unlikely to achieve the desired effect in all situations #It the above flush does seem to help though. - #note that our 'flush stdout' tcl call does not wait if stdout is non-blocking + #note that our 'flush stdout' tcl call does not wait if stdout is non-blocking #todo - investigate if the overhead is reasonable for a special channel that accepts stdout and stderr records with a reader to send to console in chunk-sizes we know will be emitted correctly # - reader of such channel could be ok to be blocking (on read? on write to real channels?)... except everything still needs to be interruptable by things like signals? #? - we want ordinary puts to stderr to be prioritized? to arrive on-screen - just not at arbitrary locations within stdout, and still must be correctly ordered wrt all other stderr @@ -682,8 +682,8 @@ proc repl::doprompt {prompt {col {green bold}}} { set prompt [lindex $plines end] } - #this sort of works - but steals some of our stdin data ? review - # + #this sort of works - but steals some of our stdin data ? review + # #lassign [punk::console::get_cursor_pos_list] column row #if {$row != 1} { # set c "\n" @@ -692,7 +692,7 @@ proc repl::doprompt {prompt {col {green bold}}} { set o [a {*}$col] set r [a] puts -nonewline stderr $c$pre$o$prompt$r - screen_last_char_add " " "prompt-stderr" prompt + screen_last_char_add " " "prompt-stderr" prompt flush stderr } } @@ -704,7 +704,7 @@ proc repl::doprompt {prompt {col {green bold}}} { # rputs deliberately doesn't check screen_last_chars before emitting data (unless reporting an error in rputs itself) proc repl::rputs {args} { variable screen_last_chars - variable last_out_was_newline + variable last_out_was_newline variable last_repl_char set pseudo_map [dict create\ @@ -720,7 +720,7 @@ proc repl::rputs {args} { set rputschan [lindex $args 0] #map pseudo-channels to real if {$rputschan in [dict keys $pseudo_map]} { - lset args 0 [dict get $pseudo_map $rputschan] + lset args 0 [dict get $pseudo_map $rputschan] } } elseif {[llength $args] == 1} { set this_tail \n @@ -731,7 +731,7 @@ proc repl::rputs {args} { set rputschan [lindex $args 1] #map pseudo-channels to real if {$rputschan in [dict keys $pseudo_map]} { - lset args 0 [dict get $pseudo_map $rputschan] + lset args 0 [dict get $pseudo_map $rputschan] } } set last_char_info_width 60 @@ -756,7 +756,7 @@ proc repl::rputs {args} { #TODO - something better #failure case: #set x \ud83c\udf1e - #(2 surrogate pairs - treated as single char in tcl8 - fixed in 9 but won't/can't be backported) - + #(2 surrogate pairs - treated as single char in tcl8 - fixed in 9 but won't/can't be backported) - #see also: https://core.tcl-lang.org/tips/doc/trunk/tip/619.md puts stderr "$repl_error" } @@ -816,7 +816,7 @@ proc repl::screen_needs_clearance {} { namespace eval repl { variable startinstance 0 variable loopinstance 0 - variable in_repl_handler [list] + variable in_repl_handler [list] variable last_controlc_count 0 } @@ -831,7 +831,7 @@ namespace eval punk::repl::class { variable o_config variable o_rendered_lines - variable o_remaining ;#? + variable o_remaining ;#? #o_chunk_list & o_chunk_info should make timed viewing of replays possible variable o_chunk_list @@ -850,7 +850,7 @@ namespace eval punk::repl::class { #-- set ch [dict get $configdict rendered_initialchunk] my add_rendered_chunk $ch - } + } set o_context $contextdict #error "[self class].constructor Unable to interpret config '$o_config'" @@ -911,21 +911,21 @@ namespace eval punk::repl::class { if {$o_cursor_col > $line_nextchar_col} { set o_cursor_col $line_nextchar_col } - + set mergedinfo [overtype::renderline -info 1 -expand_right 1 -insert_mode $o_insert_mode -cursor_column $o_cursor_col -cursor_row $o_cursor_row $underlay $new0] set result [dict get $mergedinfo result] set o_insert_mode [dict get $mergedinfo insert_mode] set result_col [dict get $mergedinfo cursor_column] set result_row [dict get $mergedinfo cursor_row] - set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v + set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v set unapplied [dict get $mergedinfo unapplied] set instruction [dict get $mergedinfo instruction] set insert_lines_below [dict get $mergedinfo insert_lines_below] set insert_lines_above [dict get $mergedinfo insert_lines_above] - # -- --- --- --- --- --- + # -- --- --- --- --- --- set debug_first_row 2 #puts "merged: $mergedinfo" set debug "add_chunk0" @@ -938,7 +938,7 @@ namespace eval punk::repl::class { } else { #?? } - # -- --- --- --- --- --- + # -- --- --- --- --- --- set o_cursor_col $result_col set cursor_row_idx [expr {$o_cursor_row-1}] @@ -949,7 +949,7 @@ namespace eval punk::repl::class { lf_start { #for normal commandline - we just add a line below lappend o_rendered_lines "" - incr nextrow + incr nextrow set o_cursor_col 1 } } @@ -970,7 +970,7 @@ namespace eval punk::repl::class { set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""] set o_cursor_col 1 } - + set o_cursor_row $nextrow set cursor_row_idx [expr {$o_cursor_row-1}] if {$cursor_row_idx < [llength $o_rendered_lines]} { @@ -991,11 +991,11 @@ namespace eval punk::repl::class { } } #puts stderr "overtype::renderline -info 1 -expand_right 1 -insert_mode $o_insert_mode -cursor_column $o_cursor_col -cursor_row $o_cursor_row $activeline '$p'" - set underlay $activeline + set underlay $activeline set line_nextchar_col [expr {[punk::char::string_width $underlay] + 1}] if {$o_cursor_col > $line_nextchar_col} { set o_cursor_col $line_nextchar_col - } + } set mergedinfo [overtype::renderline -info 1 -expand_right 1 -insert_mode $o_insert_mode -cursor_column $o_cursor_col -cursor_row $o_cursor_row $underlay $p] set debug "add_chunk$i" append debug \n $mergedinfo @@ -1007,7 +1007,7 @@ namespace eval punk::repl::class { set o_insert_mode [dict get $mergedinfo insert_mode] set o_cursor_col [dict get $mergedinfo cursor_column] set cmove [dict get $mergedinfo cursor_row] - set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v + set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v set unapplied [dict get $mergedinfo unapplied] set insert_lines_below [dict get $mergedinfo insert_lines_below] if {[string is integer -strict $cmove]} { @@ -1015,7 +1015,7 @@ namespace eval punk::repl::class { set nextrow [expr {$o_cursor_row + 1}] set o_cursor_col 1 } elseif {$cmove == 1} { - #check for overflow_right and unapplied + #check for overflow_right and unapplied #leave cursor_column } elseif {$cmove >= 1} { @@ -1030,8 +1030,8 @@ namespace eval punk::repl::class { } set o_cursor_row $nextrow if {$insert_lines_below} { - - } + + } set cursor_row_idx [expr {$o_cursor_row-1}] if {$cursor_row_idx < [llength $o_rendered_lines]} { @@ -1042,9 +1042,8 @@ namespace eval punk::repl::class { } lset o_rendered_lines $cursor_row_idx $result - incr i - } - + incr i + } } method add_rendered_chunk {rchunk} { #split only on lf newlines - movement codes and \b \v \r not expected @@ -1053,7 +1052,7 @@ namespace eval punk::repl::class { #but we don't yet have grapheme split info for it if {[regexp {[\v\b\r]} $rchunk]} { - error "[self class].add_rendered_chunk chunk contains \\v or \\b or \\r. Rendered chunk shouldn't contain these characters or ANSI movement codes" + error "[self class].add_rendered_chunk chunk contains \\v or \\b or \\r. Rendered chunk shouldn't contain these characters or ANSI movement codes" } lappend o_chunk_list $rchunk ;#rchunk may contain newlines - that's ok dict set o_chunk_info [expr {[llength $o_chunk_list] -1}] [dict create micros [clock microseconds] type rendered] @@ -1062,15 +1061,15 @@ namespace eval punk::repl::class { #lappend o_chunk_list $rchunk set lastrline [lindex $o_rendered_lines end] - #in renderedlines list merge last line of old with first line of new + #in renderedlines list merge last line of old with first line of new #we can't just cat the newpart on to existing rendered line - the chunk could have split a grapheme (e.g char+combiner(s)) - #we + #we #todo - redo grapheme split on merged line set merged [string cat $lastrline [lindex $newparts 0]] - lset o_rendered_lines end $merged + lset o_rendered_lines end $merged #todo - #each newpart needs its grapheme split info to be stored + #each newpart needs its grapheme split info to be stored #jmn #set o_rendered_lines [concat $o_rendered_lines [lrange $newparts 1 end]] lappend o_rendered_lines {*}[lrange $newparts 1 end] @@ -1111,7 +1110,7 @@ namespace eval punk::repl::class { #todo - index base??? method lines_numbered {args} { - #build a paired list so we don't have to do various calcs on end+ end- etc checking llength + #build a paired list so we don't have to do various calcs on end+ end- etc checking llength #punk::lib::range will use lseq if available - else use it's own slower code set max [llength $o_rendered_lines] ;#assume >=1 set nums [punk::lib::range 1 $max] @@ -1151,7 +1150,7 @@ namespace eval punk::repl::class { #1-based method view_lines {args} { set llist [my lines {*}$args] - return [join $llist \n] + return [join $llist \n] } method view_lines_numbered {args} { set ANSI_linenum [a+ green] @@ -1191,7 +1190,7 @@ namespace eval punk::repl::class { foreach ln $o_rendered_lines { append result [ansistring VIEW -lf 1 -vt 1 $ln] \n ;#should be no lf or vt - but if there is.. we'd better show it } - append result \n "cursor row: $o_cursor_row col: $o_cursor_col" + append result \n "cursor row: $o_cursor_row col: $o_cursor_col" return $result } method last_char {} { @@ -1237,13 +1236,13 @@ namespace eval punk::repl::class { } return $result } - + method debugview_chunks {} { set result "" foreach ln $o_chunk_list { append result [ansistring VIEW -lf 1 -vt 1 $ln] \n } - append result \n "cursor row: $o_cursor_row col: $o_cursor_col" + append result \n "cursor row: $o_cursor_row col: $o_cursor_col" return $result } method view_raw {} { @@ -1310,7 +1309,7 @@ proc punk::repl::repl_handler_restorechannel_if_not_eof {inputchan previous_inpu rputs stderr "|repl>original: [ansistring VIEW $previous_input_state]" rputs stderr "|repl>current : [ansistring VIEW [chan conf $inputchan]]" rputs stderr "\n|repl> Failed to return $inputchan to original state" - rputs stderr "|repl>ERR: $errM" + rputs stderr "|repl>ERR: $errM" } } return [chan conf $inputchan] @@ -1318,7 +1317,7 @@ proc punk::repl::repl_handler_restorechannel_if_not_eof {inputchan previous_inpu proc repl::repl_handler {inputchan prompt_config} { # -- review variable in_repl_handler - set in_repl_handler [list $inputchan $prompt_config] + set in_repl_handler [list $inputchan $prompt_config] # -- variable last_controlc_count @@ -1333,7 +1332,7 @@ proc repl::repl_handler {inputchan prompt_config} { #note -inputmode not available in Tcl 8.6 for chan configure! #According to DKF - -buffering option doesn't affect input channels set rawmode 0 - set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state + set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state if {[dict exists $original_input_conf -inputmode]} { if {[dict get $original_input_conf -inputmode] eq "raw"} { #user or script has apparently put stdin into raw mode - update punk::console::is_raw to match @@ -1344,20 +1343,20 @@ proc repl::repl_handler {inputchan prompt_config} { #set ::punk::console::is_raw 0 tsv::set console is_raw 0 } - #what about enable/disable virtualTerminal ? - #using stdin -inputmode to switch modes won't set virtualterminal input state appropriately + #what about enable/disable virtualTerminal ? + #using stdin -inputmode to switch modes won't set virtualterminal input state appropriately #we expect the state of -inputmode to be 'normal' even though we flip it during the read part of our repl loop #if it's been set to raw - assume it is deliberately done this way as the user could have alternatively called punk::mode raw or punk::console::enableVirtualTerminal #by not doing this automatically - we assume the caller has a reason. } else { #JMN FIX! - #this returns 0 in rawmode on 8.6 after repl thread changes + #this returns 0 in rawmode on 8.6 after repl thread changes #set rawmode [set ::punk::console::is_raw] set rawmode [tsv::get console is_raw] } if {!$rawmode} { - #linemode + #linemode #stdin with line-mode readable events (at least on windows for Tcl 8.7a6 to 9.0a) can get stuck with bytes pending when input longer than 100chars - even though there is a linefeed further on than that. #This potentially affects a reasonable number of Tcl8.7 kit/tclsh binaries out in the wild. @@ -1365,14 +1364,14 @@ proc repl::repl_handler {inputchan prompt_config} { #when in non-blocking mode we will have to read that in to get further - but we don't know if that was the end of line or if there is more - and we may not get a newline even though one was present originally on stdin. #presence of 8.7 buffering bug will result in unrecoverable situation - even switching to raw and using read will not be able to retrieve tail data. #the readable event only gives us 200 bytes (same problem may be at 4k/8k in other versions) - #This occurs whether we use gets or read - + #This occurs whether we use gets or read - set stdinlines [list] if {[dict get $original_input_conf -blocking] ne "0"} { chan configure $inputchan -blocking 0 } set waitingchunk "" - #review - input_chunks_waiting in line mode - + #review - input_chunks_waiting in line mode - if {[info exists input_chunks_waiting($inputchan)] && [llength $input_chunks_waiting($inputchan)]} { #puts stderr "repl_handler input_chunks_waiting($inputchan) while in line mode. Had data:[ansistring VIEW -lf 1 $input_chunks_waiting($inputchan)]" set allwaiting [join $input_chunks_waiting($inputchan) ""] @@ -1404,7 +1403,7 @@ proc repl::repl_handler {inputchan prompt_config} { if {[chan blocked $inputchan]} { #REVIEW - #todo - figure out why we're here. - #can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) + #can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) #punk::console::get_size is problematic if -winsize not available on the stdout channel - which is the case for certain 8.6 versions at least.. platform variances? ## can't do this: set screeninfo [punk::console::get_size]; lassign $screeninfo _c cols _r rows set outconf [chan configure stdout] @@ -1415,9 +1414,9 @@ proc repl::repl_handler {inputchan prompt_config} { set msg "${RED}$inputchan chan blocked is true.$RST \{$allwaiting\}" } set cols "" - set rows "" + set rows "" if {[dict exists $outconf -winsize]} { - lassign [dict get $outconf -winsize] cols rows + lassign [dict get $outconf -winsize] cols rows } else { #fallback - try external executable. Which is a bit ugly #tput can't seem to get dimensions (on FreeBSD at least) when not run interactively - ie via exec. (always returns 80x24 no matter if run with <@stdin) @@ -1425,13 +1424,13 @@ proc repl::repl_handler {inputchan prompt_config} { #bizarrely - tput can work with exec on windows if it's installed e.g from msys2 #but can be *slow* compared to unix e.g 400ms+ vs <2ms on FreeBSD ! #stty -a is 400ms+ vs 500us+ on FreeBSD - + if {"windows" eq $::tcl_platform(platform)} { set tputcmd [auto_execok tput] if {$tputcmd ne ""} { if {![catch {exec {*}$tputcmd cols lines} values]} { lassign $values cols rows - } + } } } @@ -1445,7 +1444,7 @@ proc repl::repl_handler {inputchan prompt_config} { #the more parseable: stty -g doesn't give rows/columns if {![catch {exec {*}$sttycmd -a} result]} { lassign [split $result \n] firstline - set lineparts [split $firstline {;}] ;#we seem to get segments that look well behaved enough to be treated as tcl lists - review - regex? + set lineparts [split $firstline {;}] ;#we seem to get segments that look well behaved enough to be treated as tcl lists - review - regex? set rowinfo [lsearch -index end -inline $lineparts rows] if {[llength $rowinfo] == 2} { set rows [lindex $rowinfo 0] @@ -1463,14 +1462,14 @@ proc repl::repl_handler {inputchan prompt_config} { #puts -nonewline stdout [punk::ansi::move $rows 4]$msg #use cursorsave_ version which avoids get_cursor_pos_list call set msglen [ansistring length $msg] - punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg + punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg } else { - #no mechanism to get console dimensions + #no mechanism to get console dimensions #we are reduced to continuously spewing lines. puts stderr $msg } - after 100 + after 100 } set input_chunks_waiting($inputchan) [list $allwaiting] } @@ -1501,7 +1500,7 @@ proc repl::repl_handler {inputchan prompt_config} { } else { #rawmode if {[info exists input_chunks_waiting($inputchan)] && [llength $input_chunks_waiting($inputchan)]} { - #we could concat and process as if one chunk - but for now at least - we want to preserve the 'chunkiness' + #we could concat and process as if one chunk - but for now at least - we want to preserve the 'chunkiness' set chunkwaiting_zero [lpop input_chunks_waiting($inputchan) 0] ;#pop off lhs of wait list (tcl 8.6 is tcl imp of lpop - a little slower) uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $chunkwaiting_zero [list] $prompt_config] } else { @@ -1531,7 +1530,7 @@ proc repl::repl_handler {inputchan prompt_config} { uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] while {[llength $input_chunks_waiting($inputchan)]} { set chunkzero [lpop input_chunks_waiting($inputchan) 0] - if {$chunkzero eq ""} {continue} ;#why empty waiting - and is there any point passing on? + if {$chunkzero eq ""} {continue} ;#why empty waiting - and is there any point passing on? uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $chunkzero [list] $prompt_config] } } @@ -1551,7 +1550,7 @@ proc repl::repl_handler {inputchan prompt_config} { } else { #repl_handler_checkchannel $inputchan fileevent $inputchan readable {} - set reading 0 + set reading 0 thread::send -async $::repl::codethread {set ::punk::repl::codethread::running 0} if {$::tcl_interactive} { rputs stderr "\nrepl_handler EOF inputchannel:[chan conf $inputchan]" @@ -1598,7 +1597,7 @@ proc punk::repl::console_debugview {editbuf consolewidth args} { set opt_chunktype [dict get $opts -chunktype] set opt_rightmargin [dict get $opts -rightmargin] - #debugview_raw frame + #debugview_raw frame set RST [a] if {[catch { set info [$editbuf debugview_raw] @@ -1627,10 +1626,10 @@ proc punk::repl::console_debugview {editbuf consolewidth args} { set spacepatch [textblock::block $debug_width $patch_height " "] #puts -nonewline [punk::ansi::cursor_off] punk::console::cursor_off - #use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. + #use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. set debug_offset [expr {$consolewidth - $debug_width - $opt_rightmargin}] set row_clear [expr {$opt_row -2}] - punk::console::move_emitblock_return $row_clear $debug_offset $spacepatch + punk::console::move_emitblock_return $row_clear $debug_offset $spacepatch punk::console::move_emitblock_return $opt_row $debug_offset $info set topleft [list $debug_offset $opt_row] ;#col,row REVIEW #puts -nonewline [punk::ansi::cursor_on] @@ -1675,7 +1674,7 @@ proc punk::repl::console_editbufview {editbuf consolewidth args} { set editbuf_offset [expr {$consolewidth - $editbuf_width - $opt_rightmargin}] set row_clear [expr {$opt_row -2}] - punk::console::cursorsave_move_emitblock_return $row_clear $editbuf_offset $spacepatch + punk::console::cursorsave_move_emitblock_return $row_clear $editbuf_offset $spacepatch punk::console::cursorsave_move_emitblock_return $opt_row $editbuf_offset $info return [dict create width $editbuf_width] @@ -1719,7 +1718,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config variable editbuf variable editbuf_list variable editbuf_linenum_submitted - + # --- variable reading variable id_outstack @@ -1750,16 +1749,16 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #single loop while to allow break on escape while {$onetime && [string length $chunk] >= 0 } { set onetime 0 - #punk::console::move_emitblock_return 20 120 $chunklen-->[chan conf stdin]<-- + #punk::console::move_emitblock_return 20 120 $chunklen-->[chan conf stdin]<-- #if {$chunklen == 0} { # #document examples of when we expect zero-byte chunk # #1) ctrl-z - # #review + # #review # rputs stderr "->0byte read stdin" # if {[chan eof $inputchan]} { # fileevent $inputchan readable {} - # set reading 0 + # set reading 0 # #set running 0 # if {$::tcl_interactive} { # rputs stderr "\n|repl> EOF on $inputchan." @@ -1769,7 +1768,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config # #JMN # #tailcall repl::reopen_stdin # } - # break + # break #} #set info1 "read $chunklen bytes->[ansistring VIEW -lf 1 -vt 1 $chunk]" @@ -1778,11 +1777,11 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config # terminals (by default) generally use a lone cr to represent enter (LNM reset ie CSI 20l) #(as per above doc: "For compatibility with Digital's software you should keep LNM reset (line feed)") - #You can insert an lf using ctrl-j - and of course stdin could have crlf or lf + #You can insert an lf using ctrl-j - and of course stdin could have crlf or lf #pasting from notepad++ with mixed line endings seems to paste everything ok #we don't really know the source of input keyboard vs paste vs pipe - and whether a read has potentially chopped a crl in half.. #possibly no real way to determine that. We could wait a small time to see if there's more data coming.. and potentially impact performance. - #Instead we'll try to make sense of it here. + #Instead we'll try to make sense of it here. if {$chunklen == 1} { #presume it's a keypress from terminal @@ -1793,25 +1792,25 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config if {[string first \n $chunk] < 0} { set chunk [string map {\r \n} $chunk] } - #else - + #else - #has lf - but what if last char is cr? #It may require user to hit enter - probably ok. - #could be a sequence of cr's from holding enter key + #could be a sequence of cr's from holding enter key } #review - we can receive chars such as escapes or arrow inline with other data even from keyboard if keys are pushed quickly (or automated?) # - so we probably shouldn't really rely on whether a char arrives alone in a chunk as a factor in its behaviour #On the other hand - timing of keystrokes could be legitimate indications of intention in a cli ? - #esc or ctrl-lb + #esc or ctrl-lb if {$chunk eq "\x1b"} { #return - set stdinlines [list "\x1b"] + set stdinlines [list "\x1b"] set commandstr "" - set chunk "" + set chunk "" $editbuf clear_tail screen_last_char_add \x1b stdin escape - break + break } #if ProcessedInput is disabled - we can get ctrl-c, but then we wouldn't be in raw mode and wouldn't be here. @@ -1820,16 +1819,16 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #ctrl-c if {$chunk eq "\x03"} { #::punk::repl::handler_console_control "ctrl-c_via_rawloop" - error "character 03 -> ctrl-c" + error "character 03 -> ctrl-c" } - + if {$chunk eq "\x7f"} { #review - configurable? #translate raw del to backspace del for those terminals that send plain del set chunk "\b\x7f" } elseif {$chunk eq "\x7f\x7f"} { #commonly if key held down we will get 2 dels in a row - #review - could get more in a row depending on hardware/os + #review - could get more in a row depending on hardware/os set chunk "\b\x7f\b\x7f" } elseif {$chunk eq "\x1c"} { #ctrl-bslash @@ -1839,7 +1838,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config after 250 {exit 42} return } elseif {$chunk eq "\x1a"} { - #for now - exit with small delay for tidyup + #for now - exit with small delay for tidyup #ctrl-z #::punk::repl::handler_console_control "ctrl-z_via_rawloop" if {[catch {mode line}]} { @@ -1852,7 +1851,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #we *could* intercept arrow keys here before they are handled in the editbuf #but there should only be the need to do so for situations where we aren't editing a commandline #if {$chunk eq "\x1b\[D"} { - # #rputs stderr "${debugprompt}arrow-left D" + # #rputs stderr "${debugprompt}arrow-left D" # #set commandstr "" # #punk::console::move_back 1 ;#terminal does it anyway? #} @@ -1861,7 +1860,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config $editbuf add_chunk $chunk - #-------------------------- + #-------------------------- # editbuf and debugview rhs frames #for now disable entirely on vt52 - we can only do cursor save restore - nothing that requires responses on stdin (?) if {!$is_vt52 && [set ::punk::console::ansi_available]} { @@ -1870,7 +1869,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #testing each time is very inefficient (1+ms) #unfortunately there isn't an easy way to get such an event on windows console based systems - REVIEW. set do_checkwidth 1 ;#make configurable if performance hit is too severe? TODO - set consolewidth 132 + set consolewidth 132 if {$do_checkwidth} { if {[catch {set consolewidth [dict get [punk::console::get_size] columns]} errM]} { #review @@ -1890,7 +1889,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set clearance [expr {$debug_width + $rightmargin}] set space_occupied [punk::repl::console_editbufview $editbuf $consolewidth -row 10 -rightmargin $clearance] } - #-------------------------- + #-------------------------- set lines_unsubmitted [expr {[$editbuf linecount] - $editbuf_linenum_submitted}] @@ -1915,7 +1914,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config puts -nonewline stdout "\x1b\[B" } flush stdout - + set leftmargin 3 @@ -1944,8 +1943,8 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config if {[string length $waiting] > 0} { set waiting [a+ yellow bold]$waiting[a] #puts stderr "waiting $waiting" - $editbuf clear_tail - lappend input_chunks_waiting($inputchan) $waiting + $editbuf clear_tail + lappend input_chunks_waiting($inputchan) $waiting } } if {$editbuf_linenum_submitted == 0} { @@ -1958,7 +1957,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config if {$nextsubmit_line_num < $last_line_num} { foreach ln [$editbuf lines $nextsubmit_line_num end-1] { lappend stdinlines $ln - incr editbuf_linenum_submitted + incr editbuf_linenum_submitted } } } @@ -1970,7 +1969,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config rputs stderr "trap1 POSIX '$e' eopts:'$eopts" flush stderr } on error {repl_error erropts} { - rputs stderr "error1 in repl_handler: $repl_error" + rputs stderr "error1 in repl_handler: $repl_error" rputs stderr "-------------" rputs stderr "$::errorInfo" rputs stderr "-------------" @@ -2013,7 +2012,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config if {$linenum == 0} { doprompt "E% " {yellow bold} set line "" - #screen_last_char_add " " empty empty + #screen_last_char_add " " empty empty } else { doprompt "\nE% " {yellow bold} #screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required @@ -2026,7 +2025,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #set commandstr "" } if {$line eq "\x1b\[D"} { - #rputs stderr "${debugprompt}arrow-left D" + #rputs stderr "${debugprompt}arrow-left D" #set commandstr "" #punk::console::move_back 1 } @@ -2070,7 +2069,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config } else { #append commandstr $line #puts "0=============>[string length $commandstr] bytes , [string map [list \r -r- \n -n-] $commandstr] , info complete:[info complete $line]" - append commandstr $line + append commandstr $line } #puts "=============>[string length $commandstr] bytes , [string map [list \r -r- \n -n-] $commandstr] , info complete:[info complete $line]" @@ -2092,7 +2091,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set errstack [list] - #oneshot repl debug + #oneshot repl debug set wordparts [regexp -inline -all {\S+} $commandstr] lassign $wordparts cmd_firstword cmd_secondword if {$cmd_firstword eq "debugrepl"} { @@ -2143,9 +2142,9 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #work around weird behaviour in tcl 8.6 & 8.7a5 (at least) part1 #https://wiki.tcl-lang.org/page/representation #/scriptlib/tests/listrep_bug.tcl - #after the uplevel #0 $commandstr call + #after the uplevel #0 $commandstr call # vars within the script that were set to a list, and have no string-rep, will generate a string-rep once the script (commandstr) is unset, or set to another value - #review - although the rep change is weird - what actual problem was caused aside from an unexpected shimmer? + #review - although the rep change is weird - what actual problem was caused aside from an unexpected shimmer? #probably just that the repl can't then be used to debug representation issues and possibly that the performance is not ideal for list pipeline commands(?) #now that we eval in another thread and interp - we seem to lose the list rep anyway. #(unless we also save the script in that interp too in a run_command_cache) @@ -2157,7 +2156,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set repl_runid [tsv::incr repl runid] tsv::set repl runchunks-$repl_runid [list] ;#last_run_display catch { - #REVIEW - when we launch a subshell and run more than 10 commands, + #REVIEW - when we launch a subshell and run more than 10 commands, #we delete runchunks from the outer shell that we'll return to! #we should use a toplevel key pertaining to the shell/subshell instead of just 'repl' tsv::unset repl runchunks-[expr {$repl_runid - 10}] @@ -2178,7 +2177,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #} variable codethread - variable codethread_cond + variable codethread_cond variable codethread_mutex lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::repl::output_stderr}] @@ -2206,7 +2205,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config while {[set status [tsv::get codethread_$codethread status]] == -1} { thread::cond wait $codethread_cond $codethread_mutex 50 update ;#we need a full update here to allow interrupts to be processed - #While update is often considered risky - here we know our input channel readable event has been disabled - so re-entrancy shouldn't be possible. + #While update is often considered risky - here we know our input channel readable event has been disabled - so re-entrancy shouldn't be possible. #however - child thread can send quit - transferring processing from here back to repl::start - which then ends - making a mess (child not yet finished when trying to tidy up) #we should give the child a way to quit by setting a tsv we pick up here *after the while loop* - and then we can set done. } @@ -2283,9 +2282,9 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config screen_last_char_add "\uFFFF" clearance "clearance after direct unknown call" if {[tsv::llength repl runchunks-$repl_runid]} { if {$status == 0} { - set result [tsv::get repl runchunks-$repl_runid] ;#last_run_display + set result [tsv::get repl runchunks-$repl_runid] ;#last_run_display } else { - + } set result_is_chunk_list 1 } @@ -2302,11 +2301,11 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set cdisplay [punk::ansi::ansistring::VIEW -lf 1 -vt 1 $c] #assertion cdisplay has no raw newlines if {[punk::char::ansifreestring_width $cdisplay] == 1} { - set cdisplay "$cdisplay " ;#make 2 wide + set cdisplay "$cdisplay " ;#make 2 wide } if {[string match repl-debugreport* $whatinfo]} { - #exclude noise debug_repl_emit - but still show the last_char - set whysummary "" + #exclude noise debug_repl_emit - but still show the last_char + set whysummary "" } else { #set whysummary [string map [list \n "-n-"] $whyinfo] set whysummary [punk::ansi::ansistring::VIEW -lf 1 -vt 1 $whyinfo] @@ -2328,11 +2327,11 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #puts stderr "'$::repl::output_stdout' lastoutchar:'$lastoutchar' result:'$result'" - #$command is an unevaluated script at this point - # so may not be a well formed list e.g 'set x [list a "b"]' + #$command is an unevaluated script at this point + # so may not be a well formed list e.g 'set x [list a "b"]' #- lindex $command would sometimes fail #if {[lindex $command 0] eq "runx"} {} - + if { [string equal -length [string length "d/ "] "d/ " $commandstr] || \ @@ -2358,10 +2357,10 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config } # -- --- --- --- --- --- --- --- --- --- - ##an attempt to preserve underlying rep + ##an attempt to preserve underlying rep ##this is not for performance - just to be less disruptive to underlying rep to aid in learning/debugging # -- --- --- --- --- --- --- --- --- --- - # JN 2023 - The lrange operation is destructive to path internal representation + # JN 2023 - The lrange operation is destructive to path internal representation # The lrange operation is destructive to strings with leading/trailing newlines # -- --- --- --- --- --- --- --- --- --- #set saved_errorCode $::errorCode @@ -2374,12 +2373,12 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config # set is_result_empty [expr {[llength $result_as_list] == 0}] #} # -- --- --- --- --- --- --- --- --- --- - #set resultrep [::tcl::unsupported::representation $result] + #set resultrep [::tcl::unsupported::representation $result] set is_result_empty [expr {$result eq ""}] - + #catch {puts stderr "yy--->[rep $::arglej]"} - + set reading 1 if {!$is_result_empty} { if {$status == 0} { @@ -2418,7 +2417,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config } else { #----------------------------------------------------------- # avoid repl forcing string rep of simple results. This is just to aid analysis using tcl::unsupported::representation - #set rparts [split $result {}] + #set rparts [split $result {}] #if {[lsearch $rparts \n] < 0} { # #type of $result unaffected # rputs "$resultprompt $result" @@ -2427,7 +2426,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config # rputs $resultprompt[string map [list \n "\n$resultprompt"] $result] #} #----------------------------------------------------------- - + #we have copied rawresult using append with empty string - so our string interaction with result var here shouldn't affect the returned value #empty-string result handled in other branch if {![tsv::llength repl runchunks-$repl_runid]} { @@ -2437,7 +2436,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set flat [string map [list \r\n "" \n ""] $result] if {[string length $flat] == [string length $result]} { #no line-endings in data - rputs "$resultprompt$result" + rputs "$resultprompt$result" } else { #if {[string index $result end] eq "\n"} { # set result [string range $result 0 end-1] @@ -2453,7 +2452,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set h [textblock::height $result] set promptcol [string repeat $resultprompt\n $h] set promptcol [string range $promptcol 0 end-1] - #promptcol is uniform-width lines, result may not be. We are ok to join with ragged rhs col here, so use join_basic instead of join + #promptcol is uniform-width lines, result may not be. We are ok to join with ragged rhs col here, so use join_basic instead of join rputs [textblock::join_basic -- $promptcol $result] #orig @@ -2486,7 +2485,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config } } } - + set c [a yellow bold] set n [a] rputs stderr $c$result$n @@ -2497,7 +2496,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #doprompt "P% " "green normal" if {$linenum == 0} { doprompt "P% " "green normal" - screen_last_char_add " " empty empty + screen_last_char_add " " empty empty } else { doprompt "\nP% " "green normal" screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required @@ -2542,12 +2541,12 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config flush stdout } else { - #Incomplete command + #Incomplete command # parse and determine outermost unclosed quote/bracket and include in prompt if {$linenum == $maxlinenum} { if {$rawmode} { #review - #we haven't put the data following last le into commandstr - but we want to display proper completion status prior to enter being hit or more data coming in. + #we haven't put the data following last le into commandstr - but we want to display proper completion status prior to enter being hit or more data coming in. #this could give spurious results for large pastes where buffering chunks it in odd places.? #it does however give sensible output for the common case of a small paste where the last line ending wasn't included set waiting [punk::lib::system::incomplete $commandstr[$editbuf line end]] @@ -2572,10 +2571,10 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config if {$maxlinenum == -1} { #when in raw mode - no linefeed yet received #rputs stderr "repl: no complete input line: $commandstr" - #screen_last_char_add "\n" empty empty + #screen_last_char_add "\n" empty empty + + screen_last_char_add [string index [$editbuf line end] end] stdinchunk stdinchunk - screen_last_char_add [string index [$editbuf line end] end] stdinchunk stdinchunk - } @@ -2587,7 +2586,7 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config rputs stderr "trap POSIX '$e' eopts:'$eopts" flush stderr } on error {repl_error erropts} { - rputs stderr "error in repl_handler: $repl_error" + rputs stderr "error in repl_handler: $repl_error" rputs stderr "-------------" rputs stderr "$::errorInfo" rputs stderr "-------------" @@ -2664,7 +2663,7 @@ namespace eval repl { error "repl:init codethread: $codethread already exists. use -force 1 to override" } set codethread [thread::create -preserved] - #review - naming of the possibly 2 cond variables parent and child thread + #review - naming of the possibly 2 cond variables parent and child thread set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) set codethread_mutex [thread::mutex create] @@ -2683,13 +2682,13 @@ namespace eval repl { set init_script { set ::argv0 %argv0% set ::argv %argv% - set ::argc %argc% + set ::argc %argc% tcl::tm::remove {*}[tcl::tm::list] tcl::tm::add {*}[lreverse %tmlist%] ;#Must be added in reverse order to get same order as original list! #this sets the auto_path in the thread but outside of the code interp that will be created. #It will also need to be added in that interp - set ::auto_path %autopath% + set ::auto_path %autopath% set tclmajorv [lindex [split [tcl::info::tclversion] .] 0] #jmn2 #puts stdout "CODETHREAD tm list" @@ -2744,13 +2743,13 @@ namespace eval repl { #it will need to delegate to a call here in the main interp of the codethread using an installed alias set md5version [package require md5] #we also need to 'package provide md5 $md5version' in the safe interp itself so that it won't override - + #punk::configure_unknown ;#must be called because we hacked the tcl 'unknown' proc #child codethread (outside of code interp) needs to know details of the calling repl set ::punk::repl::codethread::replthread %replthread% ;#point to thread id of parent thread (repl) - set ::punk::repl::codethread::replthread_cond %replthread_cond% + set ::punk::repl::codethread::replthread_cond %replthread_cond% set ::punk::repl::codethread::replthread_interp %replthread_interp% # -- --- --- --- @@ -2759,7 +2758,7 @@ namespace eval repl { # -- --- --- --- namespace eval ::repl::interphelpers { proc quit {args} { - #child codethreads run in a 'code' interp therefore if they started another repl - it is within the 'code' interp in that thread + #child codethreads run in a 'code' interp therefore if they started another repl - it is within the 'code' interp in that thread # whereas the first repl launched in the process runs in root interp "" thread::send -async %replthread% [list interp eval %replthread_interp% ::punk::repl::quit] } @@ -2787,8 +2786,8 @@ namespace eval repl { if {[llength $args]} { #colour call was not a query set new_state [thread::send %replthread% [list punk::console::colour {*}$args]] - if {[expr {$new_state}] ne [expr {$colour_state}]} { - interp eval code [list punk::console::colour {*}$args] ;#align code interp's view of colour state with repl thread + if {[expr {$new_state}] ne [expr {$colour_state}]} { + interp eval code [list punk::console::colour {*}$args] ;#align code interp's view of colour state with repl thread #we don't want to run a raw script directly in our code interp if we're using variables #because we will potentially collide with user vars in that context (or create vars there) - so use apply @@ -2836,7 +2835,7 @@ namespace eval repl { #punk repl tsv wrappers proc set_repl_last_unknown args { - tsv::set repl last_unknown {*}$args + tsv::set repl last_unknown {*}$args } proc get_repl_runid args { if {[tsv::exists repl runid]} { @@ -2864,9 +2863,9 @@ namespace eval repl { puts stderr "safebase: $msg" } } - + namespace eval ::repl::interphelpers::repl_ensemble { - namespace export {[a-z]*} + namespace export {[a-z]*} namespace ensemble create namespace ensemble configure [namespace current] -unknown ::repl::interphelpers::repl_ensemble_unknown variable replinfo @@ -2882,8 +2881,8 @@ namespace eval repl { thread::send %replthread% $script } proc stack {} { - set iname %replthread_interp% - set tid %replthread% + set iname %replthread_interp% + set tid %replthread% lappend stack [list thread $tid interp $iname] while {$iname eq "code"} { set iname [thread::send $tid {set ::punk::repl::codethread::replthread_interp}] @@ -2894,7 +2893,7 @@ namespace eval repl { } } namespace eval ::repl::interphelpers::subshell_ensemble { - namespace export {[a-z]*} + namespace export {[a-z]*} namespace ensemble create proc punk {} { set ts_start [clock seconds] @@ -2943,8 +2942,8 @@ namespace eval repl { #flush stdout set args %args% - set safe [dict get $args -safe] - set safelog [dict get $args -safelog] + set safe [dict get $args -safe] + set safelog [dict get $args -safelog] set paths [list] if {[dict exists $args -paths]} { set paths [dict get $args -paths] @@ -2960,9 +2959,9 @@ namespace eval repl { code alias "file normalize" "file normalize" code alias "file dirname" "file dirname" code alias "file exists" "file exists" - code alias ::tcl::file::normalize ::tcl::file::normalize - code alias ::tcl::file::dirname ::tcl::file::dirname - code alias ::tcl::file::exists ::tcl::file::exists + code alias ::tcl::file::normalize ::tcl::file::normalize + code alias ::tcl::file::dirname ::tcl::file::dirname + code alias ::tcl::file::exists ::tcl::file::exists #code alias ::punk::console::colour ::punk::console::colour } punksafe { @@ -2972,9 +2971,9 @@ namespace eval repl { code alias "file normalize" "file normalize" code alias "file dirname" "file dirname" code alias "file exists" "file exists" - code alias ::tcl::file::normalize ::tcl::file::normalize - code alias ::tcl::file::dirname ::tcl::file::dirname - code alias ::tcl::file::exists ::tcl::file::exists + code alias ::tcl::file::normalize ::tcl::file::normalize + code alias ::tcl::file::dirname ::tcl::file::dirname + code alias ::tcl::file::exists ::tcl::file::exists code alias ::punk::console::colour ::punk::console::colour } punk - 0 { @@ -2983,7 +2982,7 @@ namespace eval repl { punkisland { interp create code #todo - #when no island paths specified - should be like safebase, but without folder hiding and with expanded read to ::auto_path folders + #when no island paths specified - should be like safebase, but without folder hiding and with expanded read to ::auto_path folders } } @@ -3095,7 +3094,7 @@ namespace eval repl { if {[file exists $path]} { set data [readFile $path] code eval [list info script $path] - code eval $data + code eval $data code eval [list info script $prior_infoscript] } else { error "safe - failed to find $path" @@ -3120,7 +3119,7 @@ namespace eval repl { #interp eval code { # set ::argv0 %argv0% # set ::auto_path %autopath% - #} + #} interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] @@ -3161,7 +3160,7 @@ namespace eval repl { set ::argv {} #puts stdout "safebase interp" #flush stdout - } + } interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] @@ -3200,16 +3199,16 @@ namespace eval repl { safe::interpAddToAccessPath code [file join $termbase ansi] safe::interpAddToAccessPath code [file join $termbase ansi code] } - #safe::interpAddToAccessPath code NUL + #safe::interpAddToAccessPath code NUL if {$safelog ne ""} { #setting setLogCmd here gives potentially interesting feedback regarding behaviour of things such as glob - safe::setLogCmd $safelog + safe::setLogCmd $safelog } #code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm code alias detok ::safe::DetokPath code ;#temp - this violates the point of the {$p(:X:)} paths - #review - exit should do something slightly different + #review - exit should do something slightly different # see ::safe::interpDelete code alias exit ::repl::interphelpers::quit @@ -3298,7 +3297,7 @@ namespace eval repl { #puts stderr "loading natsort" #natsort has 'application mode' which can exit. #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions - package require natsort + package require natsort #package require punk ;# Thread #package require shellrun ;#subcommand exists of file @@ -3321,13 +3320,13 @@ namespace eval repl { error "$errM" } - } + } } punk - 0 { interp eval code { #safe !=1 and safe !=2, tmlist: %tmlist% - set ::argv0 %argv0% + set ::argv0 %argv0% set ::argv %argv% set ::argc %argc% set ::auto_path %autopath% @@ -3339,12 +3338,12 @@ namespace eval repl { #review #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) #review - can we speed that scan up? - ##catch {package require flobrudder-nonexistant} + ##catch {package require flobrudder-nonexistant} # -- --- if {[catch { package require vfs - package require vfs::zip + package require vfs::zip } errM]} { puts stderr "repl code interp can't load vfs,vfs::zip" } @@ -3359,7 +3358,7 @@ namespace eval repl { #puts stderr "loading natsort" #natsort has 'application mode' which can exit. #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions - package require natsort + package require natsort #catch {package require packageTrace} package require punk package require punk::args @@ -3404,7 +3403,7 @@ namespace eval repl { #JMN #code alias cmdtype ::repl::interphelpers::cmdtype - #temporary debug aliases - deliberate violation of safety provided by safe interp + #temporary debug aliases - deliberate violation of safety provided by safe interp code alias escapeeval ::repl::interphelpers::escapeeval @@ -3431,11 +3430,11 @@ namespace eval repl { error $errMsg } } - #init - don't auto init - require init with possible options e.g -safe + #init - don't auto init - require init with possible options e.g -safe } package provide punk::repl [namespace eval punk::repl { variable version - set version 999999.0a1.0 + set version 999999.0a1.0 }] #repl::start $program_read_stdin_pipe diff --git a/tclint.toml b/tclint.toml new file mode 100644 index 00000000..009de3ac --- /dev/null +++ b/tclint.toml @@ -0,0 +1,34 @@ +# patterns to exclude when searching directories. defaults to empty list. +# follows gitignore pattern format: https://git-scm.com/docs/gitignore#_pattern_format +# the one exception is that a leading "#" character will be automatically escaped +#exclude = ["ignore_me/", "ignore*.tcl", "/ignore_from_here"] +# lint violations to ignore. defaults to empty list. +# can also supply an inline table with a path and a list of violations to ignore under that path. + +#ignore = [ +# "unbraced-expr", +# { path = "files_with_long_lines/", rules = ["line-length"] } +#] + +# extensions of files to lint when searching directories. defaults to tcl, sdc, +# xdc, and upf. +extensions = ["tcl", "tm", "sdc"] +# path to command spec defining tool-specific commands and arguments, generated by +# `tclint-plugins make-spec`. + +#commands = "~/.tclint/openroad.json" + +# with the exception of line-length, the [style] settings affect tclfmt rather than tclint. + +[style] +# number of spaces to indent. can also be set to "tab". defaults to 4. +#indent = 2 +# maximum allowed line length. defaults to 100. +line-length = 400 +# maximum allowed number of consecutive blank lines. defaults to 2. +max-blank-lines = 10 +# whether to require indenting of "namespace eval" blocks. defaults to true. +#indent-namespace-eval = false +# whether to expect a single space (true) or no spaces (false) surrounding the contents of a braced expression or script argument. +# defaults to false. +#spaces-in-braces = true \ No newline at end of file