Browse Source

table,ansi fixes; ansi extended underline and colour support

master
Julian Noble 6 months ago
parent
commit
b9d81798f8
  1. 14
      src/modules/punk-0.1.tm
  2. 251
      src/modules/punk/ansi-999999.0a1.0.tm
  3. 24
      src/modules/punk/console-999999.0a1.0.tm
  4. 61
      src/modules/punk/repl-0.1.tm
  5. 8
      src/modules/punk/unixywindows-999999.0a1.0.tm
  6. 34
      src/modules/textblock-999999.0a1.0.tm

14
src/modules/punk-0.1.tm

@ -6066,15 +6066,15 @@ namespace eval punk {
lappend result filebytes [format_number $filebytes] lappend result filebytes [format_number $filebytes]
} }
if {$::repl::running} { if {$::repl::running} {
if {[llength [info commands ::repl::term::set_console_title]]} { if {[llength [info commands ::punk::console::titleset]]} {
repl::term::set_console_title [lrange $result 1 end] ;#strip location key ::punk::console::titleset [lrange $result 1 end]
} }
set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo]
#puts stdout $out #puts stdout $out
#puts stderr [a+ white]$out[a] #puts stderr [a+ white]$out[a]
set chunklist [list] set chunklist [list]
lappend chunklist [list stdout "[a+ white light]$out[a]\n"] lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"]
lappend chunklist [list result $result] lappend chunklist [list result $result]
set ::punk::last_run_display $chunklist set ::punk::last_run_display $chunklist
} }
@ -6185,7 +6185,7 @@ namespace eval punk {
dict lappend this_result pattern [dict get $matchinfo opts -glob] dict lappend this_result pattern [dict get $matchinfo opts -glob]
if {$::repl::running} { if {$::repl::running} {
set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo]
lappend chunklist [list stdout "[a+ white light]$out[a]\n"] lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"]
} }
@ -6236,11 +6236,11 @@ namespace eval punk {
set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo]
#return $out\n[pwd] #return $out\n[pwd]
set chunklist [list] set chunklist [list]
lappend chunklist [list stdout "[a+ white light]$out[a]\n"] lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"]
lappend chunklist [list result $result] lappend chunklist [list result $result]
set ::punk::last_run_display $chunklist set ::punk::last_run_display $chunklist
if {[llength [info commands ::repl::term::set_console_title]]} { if {[llength [info commands ::punk::console::titleset]]} {
repl::term::set_console_title [lrange $result 1 end] ;#strip location key ::punk::console::titleset [lrange $result 1 end] ;#strip location key
} }
} }
return $result return $result

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

@ -1867,7 +1867,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set out "" set out ""
set indent " " set indent " "
set RST [a] set RST [a]
append out "[a+ web-white]Standard SGR colours and attributes [a]" \n append out "[a+ web-white]Extended underlines$RST" \n
set undercurly "undercurly \[a+ undercurly und-199-21-133\]text\[a] -> [a+ undercurly und-199-21-133]text$RST"
set underdotted "underdotted \[a+ underdotted und#FFD700\]text\[a] -> [a+ underdotted und#FFD700]text$RST"
set underdashed "underdashed \[a+ underdashed undt-45\]text\[a] -> [a+ underdashed undt-45]text$RST"
set underline_c "named terminal colour SGR underline \[a+ underline undt-deeppink1\]text\[a] -> [a+ underline undt-deeppink1]text$RST"
append out "${indent}$undercurly $underdotted" \n
append out "${indent}$underdashed" \n
append out "${indent}$underline_c" \n
append out "${indent}Extended underlines/colours can suppress other SGR codes on terminals that don't support them if codes are merged." \n
append out "${indent}punk::ansi tries to keep them in separate escape sequences even during merge operations to avoid this" \n
append out "[a+ web-white]Standard SGR colours and attributes $RST" \n
set settings_applied $SGR_setting_map set settings_applied $SGR_setting_map
set strmap [list] set strmap [list]
dict for {k v} $SGR_setting_map { dict for {k v} $SGR_setting_map {
@ -2000,7 +2010,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
$t add_row [list $i $descr $s [ansistring VIEW $s]] $t add_row [list $i $descr $s [ansistring VIEW $s]]
} }
term - Term { term - Term - undt {
set tail [string trim [string range $i 4 end] -] set tail [string trim [string range $i 4 end] -]
if {[string is integer -strict $tail]} { if {[string is integer -strict $tail]} {
if {$tail < 256} { if {$tail < 256} {
@ -2033,7 +2043,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 -
Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 -
RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 -
rgb# - Rgb# - RGB# { rgb# - Rgb# - RGB# -
und# - und- {
if {[string index $i 3] eq "#"} { if {[string index $i 3] eq "#"} {
set tail [string range $i 4 end] set tail [string range $i 4 end]
set hex $tail set hex $tail
@ -2067,6 +2078,16 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
$t add_row [list $i "$info" $s [ansistring VIEW $s]] $t add_row [list $i "$info" $s [ansistring VIEW $s]]
} }
unde {
switch -- $i {
undercurly - underdotted - underdashed - undersingle - underdouble {
$t add_row [list $i extended $s [ansistring VIEW $s]]
}
default {
$t add_row [list $i UNKNOWN $s [ansistring VIEW $s]]
}
}
}
default { default {
if {[string is integer -strict $i]} { if {[string is integer -strict $i]} {
set rmap [lreverse $SGR_map] set rmap [lreverse $SGR_map]
@ -2083,7 +2104,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
set ansi [a+ {*}$args] set ansi [a+ {*}$args]
set s ${ansi}sample set s ${ansi}sample
set merged [punk::ansi::codetype::sgr_merge_singles [list $ansi]] #set merged [punk::ansi::codetype::sgr_merge_singles [list $ansi]]
set merged [punk::ansi::codetype::sgr_merge [list $ansi]]
set s2 ${merged}sample set s2 ${merged}sample
#lappend resultlist "RESULT: [a+ {*}$args]sample[a]" #lappend resultlist "RESULT: [a+ {*}$args]sample[a]"
$t add_row [list RESULT "" $s [ansistring VIEW $s]] $t add_row [list RESULT "" $s [ansistring VIEW $s]]
@ -2175,6 +2197,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
variable TERM_colour_map variable TERM_colour_map
set t [list] set t [list]
set e [list] ;#extended codes needing to go in own escape sequence
foreach i $args { foreach i $args {
set f4 [string range $i 0 3] set f4 [string range $i 0 3]
switch -- $f4 { switch -- $f4 {
@ -2188,7 +2211,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set rgb [string map { - ;} $rgbdash] set rgb [string map { - ;} $rgbdash]
lappend t "38;2;$rgb" lappend t "38;2;$rgb"
} else { } else {
puts stderr "ansi web colour unmatched: '$i'" puts stderr "ansi web colour unmatched: '$i' in call 'a+ $args'"
} }
} }
Web- - WEB- { Web- - WEB- {
@ -2199,7 +2222,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[dict exists $WEB_colour_map $cname]} { if {[dict exists $WEB_colour_map $cname]} {
lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]" lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]"
} else { } else {
puts stderr "ansi Web colour unmatched: '$i'" puts stderr "ansi Web colour unmatched: '$i' in call 'a+ $args'"
} }
} }
rese {lappend t 0 ;#reset} rese {lappend t 0 ;#reset}
@ -2219,7 +2242,31 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
hide {lappend t 8} hide {lappend t 8}
norm {lappend t 22 ;#normal} norm {lappend t 22 ;#normal}
unde {lappend t 4 ;#underline} unde {
#TODO - fix
# extended codes with colon suppress normal SGR attributes when in same escape sequence on terminal that don't support the extended codes.
# need to emit in
switch -- $i {
underline {
lappend t 4 ;#underline
}
undersingle {
lappend e 4:1
}
underdouble {
lappend e 4:2
}
undercurly {
lappend e 4:3
}
underdotted {
lappend e 4:4
}
underdashed {
lappend e 4:5
}
}
}
doub {lappend t 21 ;#doubleunderline} doub {lappend t 21 ;#doubleunderline}
noun {lappend t 24 ;#nounderline} noun {lappend t 24 ;#nounderline}
stri {lappend t 9 ;#strike} stri {lappend t 9 ;#strike}
@ -2229,11 +2276,19 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
reve {lappend t 7 ;#reverse} reve {lappend t 7 ;#reverse}
nore {lappend t 27 ;#noreverse} nore {lappend t 27 ;#noreverse}
defa { defa {
if {$i eq "defaultfg"} { switch -- $i {
lappend t 39 defaultfg {
} else { lappend t 39
#defaultbg }
lappend t 49 defaultbg {
lappend t 49
}
defaultund {
lappend t 59
}
default {
puts stderr "ansi term unmatched: defa* '$i' in call 'a $args' (defaultfg,defaultbg,defaultund)"
}
} }
} }
nohi {lappend t 28 ;#nohide} nohi {lappend t 28 ;#nohide}
@ -2298,7 +2353,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[dict exists $TERM_colour_map $cc]} { if {[dict exists $TERM_colour_map $cc]} {
lappend t "38;5;[dict get $TERM_colour_map $cc]" lappend t "38;5;[dict get $TERM_colour_map $cc]"
} else { } else {
puts stderr "ansi term colour unmatched: '$i'" puts stderr "ansi term colour unmatched: '$i' in call 'a+ $args'"
} }
} }
} }
@ -2312,7 +2367,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[dict exists $TERM_colour_map $cc]} { if {[dict exists $TERM_colour_map $cc]} {
lappend t "48;5;[dict get $TERM_colour_map $cc]" lappend t "48;5;[dict get $TERM_colour_map $cc]"
} else { } else {
puts stderr "ansi Term colour unmatched: '$i'" puts stderr "ansi Term colour unmatched: '$i' in call 'a+ $args'"
} }
} }
} }
@ -2341,6 +2396,34 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set rgb [join [::scan $hex6 %2X%2X%2X] {;}] set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "48;2;$rgb" lappend t "48;2;$rgb"
} }
und- - und0 - und1 - und2 - und3 - und4 - und5 - und6 - und7 - und8 - und9 {
#decimal rgb underline
#allow variants und-xxx-xxx-xxx and undxxx-xxx-xxx
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {:} , {:}] $rgbspec]
lappend e "58:2::$rgb"
}
"und#" {
#hex rgb underline - (e.g kitty, wezterm) - uses colons as separators
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {:}]
lappend e "58:2::$rgb"
}
undt {
#variable TERM_colour_map
#256 colour underline by Xterm name or by integer
#name is xterm name or colour index from 0 - 255
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc] & $cc < 256} {
lappend e "58:5:$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend e "58:5:[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi term underline colour unmatched: '$i' in call 'a $args'"
}
}
}
x11- { x11- {
variable X11_colour_map variable X11_colour_map
#foreground X11 names #foreground X11 names
@ -2350,7 +2433,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set rgb [string map [list - {;}] $rgbdash] set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb" lappend t "38;2;$rgb"
} else { } else {
puts stderr "ansi x11 colour unmatched: '$i'" puts stderr "ansi x11 colour unmatched: '$i' in call 'a+ $args'"
} }
} }
X11- { X11- {
@ -2369,7 +2452,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[string is integer -strict $i] || [string first ";" $i] > 0} { if {[string is integer -strict $i] || [string first ";" $i] > 0} {
lappend t $i lappend t $i
} else { } else {
puts stderr "ansi name unmatched: '$i' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-" puts stderr "ansi name unmatched: '$i' in call 'a+ $args' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-"
} }
} }
} }
@ -2377,9 +2460,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# \033 - octal. equivalently \x1b in hex which is more common in documentation # \033 - octal. equivalently \x1b in hex which is more common in documentation
if {![llength $t]} { if {![llength $t]} {
set result "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s)) if {![llength $e]} {
set result "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s))
} else {
set result "\x1b\[[join $e {;}]m"
}
} else { } else {
set result "\x1b\[[join $t {;}]m" if {![llength $e]} {
set result "\x1b\[[join $t {;}]m"
} else {
set result "\x1b\[[join $t {;}]m\x1b\[[join $e {;}]m"
}
} }
dict set sgr_cache a+$args $result dict set sgr_cache a+$args $result
return $result return $result
@ -2408,6 +2499,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
variable TERM_colour_map variable TERM_colour_map
set t [list] set t [list]
set e [list] ;#extended codes will suppress standard SGR colours and attributes if merged in same escape sequence
foreach i $args { foreach i $args {
set f4 [string range $i 0 3] set f4 [string range $i 0 3]
switch -- $f4 { switch -- $f4 {
@ -2421,7 +2513,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set rgb [string map { - ;} $rgbdash] set rgb [string map { - ;} $rgbdash]
lappend t "38;2;$rgb" lappend t "38;2;$rgb"
} else { } else {
puts stderr "ansi web colour unmatched: '$i'" puts stderr "ansi web colour unmatched: '$i' in call 'a $args'"
} }
} }
Web- - WEB- { Web- - WEB- {
@ -2432,7 +2524,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[dict exists $WEB_colour_map $cname]} { if {[dict exists $WEB_colour_map $cname]} {
lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]" lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]"
} else { } else {
puts stderr "ansi Web colour unmatched: '$i'" puts stderr "ansi Web colour unmatched: '$i' in call 'a $args'"
} }
} }
rese {lappend t 0 ;#reset} rese {lappend t 0 ;#reset}
@ -2452,7 +2544,28 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
hide {lappend t 8} hide {lappend t 8}
norm {lappend t 22 ;#normal} norm {lappend t 22 ;#normal}
unde {lappend t 4 ;#underline} unde {
switch -- $i {
underline {
lappend t 4 ;#underline
}
undersingle {
lappend e 4:1
}
underdouble {
lappend e 4:2
}
undercurly {
lappend e 4:3
}
underdotted {
lappend e 4:4
}
underdashed {
lappend e 4:5
}
}
}
doub {lappend t 21 ;#doubleunderline} doub {lappend t 21 ;#doubleunderline}
noun {lappend t 24 ;#nounderline} noun {lappend t 24 ;#nounderline}
stri {lappend t 9 ;#strike} stri {lappend t 9 ;#strike}
@ -2462,11 +2575,19 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
reve {lappend t 7 ;#reverse} reve {lappend t 7 ;#reverse}
nore {lappend t 27 ;#noreverse} nore {lappend t 27 ;#noreverse}
defa { defa {
if {$i eq "defaultfg"} { switch -- $i {
lappend t 39 defaultfg {
} else { lappend t 39
#defaultbg }
lappend t 49 defaultbg {
lappend t 49
}
defaultund {
lappend t 59
}
default {
puts stderr "ansi term unmatched: defa* '$i' in call 'a $args' (defaultfg,defaultbg,defaultund)"
}
} }
} }
nohi {lappend t 28 ;#nohide} nohi {lappend t 28 ;#nohide}
@ -2531,7 +2652,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[dict exists $TERM_colour_map $cc]} { if {[dict exists $TERM_colour_map $cc]} {
lappend t "38;5;[dict get $TERM_colour_map $cc]" lappend t "38;5;[dict get $TERM_colour_map $cc]"
} else { } else {
puts stderr "ansi term colour unmatched: '$i'" puts stderr "ansi term colour unmatched: '$i' in call 'a $args'"
} }
} }
} }
@ -2545,7 +2666,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[dict exists $TERM_colour_map $cc]} { if {[dict exists $TERM_colour_map $cc]} {
lappend t "48;5;[dict get $TERM_colour_map $cc]" lappend t "48;5;[dict get $TERM_colour_map $cc]"
} else { } else {
puts stderr "ansi Term colour unmatched: '$i'" puts stderr "ansi Term colour unmatched: '$i' in call 'a $args'"
} }
} }
} }
@ -2574,6 +2695,34 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set rgb [join [::scan $hex6 %2X%2X%2X] {;}] set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "48;2;$rgb" lappend t "48;2;$rgb"
} }
und- - und0 - und1 - und2 - und3 - und4 - und5 - und6 - und7 - und8 - und9 {
#decimal rgb underline
#allow variants und-xxx-xxx-xxx and undxxx-xxx-xxx
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {:} , {:}] $rgbspec]
lappend e "58:2::$rgb"
}
"und#" {
#hex rgb underline - (e.g kitty, wezterm) - uses colons as separators
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {:}]
lappend e "58:2::$rgb"
}
undt {
#variable TERM_colour_map
#256 colour underline by Xterm name or by integer
#name is xterm name or colour index from 0 - 255
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc] & $cc < 256} {
lappend e "58:5:$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend e "58:5:[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi term underline colour unmatched: '$i' in call 'a $args'"
}
}
}
x11- { x11- {
variable X11_colour_map variable X11_colour_map
#foreground X11 names #foreground X11 names
@ -2602,7 +2751,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
if {[string is integer -strict $i] || [string first ";" $i] > 0} { if {[string is integer -strict $i] || [string first ";" $i] > 0} {
lappend t $i lappend t $i
} else { } else {
puts stderr "ansi name unmatched: '$i' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-" puts stderr "ansi name unmatched: '$i' in call 'a $args' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-"
} }
} }
} }
@ -2612,7 +2761,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# empty list [a] should do reset - same for [a nonexistant] # empty list [a] should do reset - same for [a nonexistant]
# explicit reset at beginning of parameter list for a= (as opposed to a+) # explicit reset at beginning of parameter list for a= (as opposed to a+)
set t [linsert $t[unset t] 0 0] set t [linsert $t[unset t] 0 0]
set result "\x1b\[[join $t {;}]m" if {[![llength $e]]} {
set result "\x1b\[[join $t {;}]m"
} else {
set result "\x1b\[[join $t {;}]m\x1b\[[join $e {;}]m"
}
dict set sgr_cache a_$args $result dict set sgr_cache a_$args $result
return $result return $result
} }
@ -3397,6 +3550,7 @@ namespace eval punk::ansi {
dict set codestate italic 3 dict set codestate italic 3
} }
4 { 4 {
#REVIEW - merging extended (e.g 4:4) underline attributes suppresses all other SGR attributes on at least some terminals which don't support extended underlines
if {[llength $paramsplit] == 1} { if {[llength $paramsplit] == 1} {
dict set codestate underline 4 dict set codestate underline 4
} else { } else {
@ -3634,11 +3788,11 @@ namespace eval punk::ansi {
} }
set codemerge "" set codemerge ""
set unmergeable "" ;# can merge with each other but not main set (for terminals not supporting extended codes)
if {[dict get $opts -filter_fg] || [dict get $opts -filter_bg]} { if {[dict get $opts -filter_fg] || [dict get $opts -filter_bg]} {
dict for {k v} $codestate { dict for {k v} $codestate {
switch -- $v { switch -- $v {
"" { "" {
} }
default { default {
switch -- $k { switch -- $k {
@ -3652,6 +3806,9 @@ namespace eval punk::ansi {
append codemerge "${v}\;" append codemerge "${v}\;"
} }
} }
underlinecolour - curlyunderline - dashedunderline - dottedunderline {
append unmergeable "${v}\;"
}
default { default {
append codemerge "${v}\;" append codemerge "${v}\;"
} }
@ -3664,20 +3821,42 @@ namespace eval punk::ansi {
switch -- $v { switch -- $v {
"" {} "" {}
default { default {
append codemerge "${v}\;" switch -- $k {
underlinecolour - curlyunderline - dashedunderline - dottedunderline {
append unmergeable "${v}\;"
}
default {
append codemerge "${v}\;"
}
}
} }
} }
} }
} }
if {$did_reset} { if {$did_reset} {
#review - unmergeable
set codemerge "0\;$codemerge" set codemerge "0\;$codemerge"
if {$codemerge eq ""} {
set unmergeable "0\;$unmergeable"
}
} }
if {[string length $codemerge]} { #puts "+==> codelist:[ansistring VIEW $codelist] did_reset:$did_reset codemerge:[ansistring VIEW $codemerge] unmergeable:[ansistring VIEW $unmergeable]"
if {$codemerge ne ""} {
set codemerge [string trimright $codemerge {;}] set codemerge [string trimright $codemerge {;}]
return "\x1b\[${codemerge}m[join $othercodes ""]" if {$unmergeable ne ""} {
set unmergeable [string trimright $unmergeable {;}]
return "\x1b\[${codemerge}m\x1b\[${unmergeable}m[join $othercodes ""]"
} else {
return "\x1b\[${codemerge}m[join $othercodes ""]"
}
} else { } else {
#there were no SGR codes - not even resets if {$unmergeable eq ""} {
return [join $othercodes ""] #there were no SGR codes - not even resets
return [join $othercodes ""]
} else {
set unmergeable [string trimright $unmergeable {;}]
return "\x1b\[${unmergeable}m[join $othercodes ""]"
}
} }
} }

24
src/modules/punk/console-999999.0a1.0.tm

@ -1201,6 +1201,9 @@ namespace eval punk::console {
namespace import ansi::cursor_on namespace import ansi::cursor_on
namespace import ansi::cursor_off namespace import ansi::cursor_off
#review - the concept of using local mechanisms at all (ie apis) vs ansi is not necessarily something we want/need to support.
#For the system to be really useful if needs to operate in conditions where the terminal is remote
#This seems to be why windows console is deprecating various non-ansi api methods for interacting with the console.
namespace eval local { namespace eval local {
proc titleset {windowtitle} { proc titleset {windowtitle} {
if {"windows" eq $::tcl_platform(platform)} { if {"windows" eq $::tcl_platform(platform)} {
@ -1247,17 +1250,21 @@ namespace eval punk::console {
return [local::titleget] return [local::titleget]
} }
proc infocmp_test {} { proc infocmp {} {
set cmd1 [auto_execok infocmp] set cmd1 [auto_execok infocmp]
if {[string length $cmd1]} { if {[string length $cmd1]} {
puts stderr "infocmp seems to be available" puts stderr "Using infocmp executable"
return [exec {*}$cmd1] return [exec {*}$cmd1]
} else { } else {
puts stderr "infcmp doesn't seem to be present" puts stderr "infocmp doesn't seem to be present"
if {$::tcl_platform(os) eq "FreeBSD"} {
puts stderr "For FreeBSD - install ncurses to get infocmp and related binaries and also install terminfo-db"
}
set tcmd [auto_execok tput] set tcmd [auto_execok tput]
if {[string length $tcmd]} { if {[string length $tcmd]} {
puts stderr "tput seems to be available. Try something like: tput -S - (freebsd)" puts stderr "tput seems to be available. Try something like: tput -S - (freebsd)"
} }
#todo - what? can tput query all caps? OS differences?
} }
} }
@ -1284,6 +1291,7 @@ namespace eval punk::console {
return [split $data ";"] return [split $data ";"]
} }
#channel?
namespace eval ansi { namespace eval ansi {
proc move {row col} { proc move {row col} {
puts -nonewline stdout [punk::ansi::move $row $col] puts -nonewline stdout [punk::ansi::move $row $col]
@ -1324,6 +1332,12 @@ namespace eval punk::console {
proc scroll_down {n} { proc scroll_down {n} {
puts -nonewline stdout [punk::ansi::scroll_down $n] puts -nonewline stdout [punk::ansi::scroll_down $n]
} }
proc enable_alt_screen {} {
puts -nonewline stdout [punk::ansi::enable_alt_screen]
}
proc disable_alt_screen {} {
puts -nonewline stdout [punk::ansi::disable_alt_screen]
}
#review - worth the extra microseconds to inline? might be if used in for example prompt on every keypress. #review - worth the extra microseconds to inline? might be if used in for example prompt on every keypress.
#caller should build as much as possible using the punk::ansi versions to avoid extra puts calls #caller should build as much as possible using the punk::ansi versions to avoid extra puts calls
@ -1377,8 +1391,10 @@ namespace eval punk::console {
namespace import ansi::cursor_restore namespace import ansi::cursor_restore
namespace import ansi::cursor_save_dec namespace import ansi::cursor_save_dec
namespace import ansi::cursor_restore_dec namespace import ansi::cursor_restore_dec
namespace import ansi::scroll_down
namespace import ansi::scroll_up namespace import ansi::scroll_up
namespace import ansi::scroll_down
namespace import ansi::enable_alt_screen
namespace import ansi::disable_alt_screen
namespace import ansi::insert_spaces namespace import ansi::insert_spaces
namespace import ansi::delete_characters namespace import ansi::delete_characters
namespace import ansi::erase_characters namespace import ansi::erase_characters

61
src/modules/punk/repl-0.1.tm

@ -23,11 +23,6 @@ set tcl_interactive 1
proc todo {} {
puts "tcl History"
puts "repltelemetry package"
puts "deaddrop package for a consistent way for modules to leave small notes to others that may come later."
}
@ -76,6 +71,12 @@ namespace eval repl {
namespace eval punk::repl { namespace eval punk::repl {
variable debug_repl 0 variable debug_repl 0
proc todo {} {
puts "tcl History"
puts "repltelemetry package"
puts "deaddrop package for a consistent way for modules to leave small notes to others that may come later."
}
proc has_script_var_bug {} { proc has_script_var_bug {} {
set script {set j [list spud] ; list} set script {set j [list spud] ; list}
append script \n append script \n
@ -95,9 +96,6 @@ namespace eval punk::repl {
return false return false
} }
} }
}
namespace eval repl {
#since we are targeting Tcl 8.6+ - we should be using 'interp bgerror .' #since we are targeting Tcl 8.6+ - we should be using 'interp bgerror .'
#todo - make optional/configurable? #todo - make optional/configurable?
proc bgerror2 {args} { proc bgerror2 {args} {
@ -110,20 +108,28 @@ namespace eval repl {
puts stderr "====================" puts stderr "===================="
puts stderr "^^^^^^^^^^^^^^^^^^^" puts stderr "^^^^^^^^^^^^^^^^^^^"
} }
proc bgerror {message} { proc bgerror {args} {
puts stderr "*> repl background error: $message" set message [lindex $args 0]
puts stderr "*> [set ::errorInfo]" set errdict [lindex $args 1]
puts stderr "\n*> repl background error: '$message'"
#puts stderr "*> [set ::errorInfo]"
puts stderr "*> errorinfo: [dict get $errdict -errorinfo]"
set stdinreader [fileevent stdin readable] set stdinreader [fileevent stdin readable]
if {![string length $stdinreader]} { if {![string length $stdinreader]} {
puts stderr "*> stdin reader inactive" puts stderr "*> stdin reader inactive"
} else { } else {
puts stderr "*> stdin reader active" puts stderr "*> stdin reader active"
} }
flush stderr
} }
if {![llength [info commands ::bgerror]]} { if {![llength [info commands ::bgerror]]} {
interp alias {} bgerror {} ::repl::bgerror #interp alias {} bgerror {} ::repl::bgerror
} }
interp bgerror "" ::punk::repl::bgerror
}
namespace eval repl {
} }
namespace eval ::repl::term { namespace eval ::repl::term {
@ -185,13 +191,6 @@ if {$::tcl_platform(platform) eq "windows"} {
} }
} }
twapi::set_console_control_handler ::repl::term::handler_console_control twapi::set_console_control_handler ::repl::term::handler_console_control
proc ::repl::term::set_console_title {text} {
#go via console - in case ansi disabled/unavailable
punk::console::titleset $text
}
proc ::repl::term::set_console_icon {name} {
#todo
}
#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" #repl::rputs stdout "twapi loaded"
} else { } else {
@ -200,30 +199,10 @@ if {$::tcl_platform(platform) eq "windows"} {
}] }]
} else { } else {
#TODO #TODO
proc ::repl::term::set_console_title {text} {
#todo - terminfo/termcap?
#puts -nonewline "\033\]2;$text\007" ;#works for xterm and most derivatives
puts -nonewline [term::ansi::code::ctrl::title $text]
}
proc ::repl::term::set_console_icon {name} {
#old xterm feature for label given to xterm window when miniaturized? TODO research
#puts -nonewline "\033\]1;$name\007"
}
} }
interp alias {} smcup {} ::punk::console::enable_alt_screen
#expermental terminal alt screens interp alias {} rmcup {} ::punk::console::disable_alt_screen
#alternatives are \x1b\[?47h ans \x1b[?\47l
proc ::repl::term::screen_push_alt {} {
#tput smcup
puts -nonewline stderr "\033\[?1049h"
}
proc ::repl::term::screen_pop_alt {} {
#tput rmcup
puts -nonewline stderr "\033\[?1049l"
}
interp alias {} smcup {} ::repl::term::screen_push_alt
interp alias {} rmcup {} ::repl::term::screen_pop_alt
# moved to punk package.. # moved to punk package..

8
src/modules/punk/unixywindows-999999.0a1.0.tm

@ -82,14 +82,18 @@ namespace eval punk::unixywindows {
proc cdwin {path} { proc cdwin {path} {
set path [towinpath $path] set path [towinpath $path]
if {$::repl::running} { if {$::repl::running} {
repl::term::set_console_title $path if {[llength [info commands ::punk::console::titleset]]} {
::punk::console::titleset $path
}
} }
cd $path cd $path
} }
proc cdwindir {path} { proc cdwindir {path} {
set path [towinpath $path] set path [towinpath $path]
if {$::repl::running} { if {$::repl::running} {
repl::term::set_console_title $path if {[llength [info commands ::punk::console::titleset]]} {
::punk::console::titleset $path
}
} }
cd [file dirname $path] cd [file dirname $path]
} }

34
src/modules/textblock-999999.0a1.0.tm

@ -1108,10 +1108,11 @@ namespace eval textblock {
lappend checked_opts $k $v lappend checked_opts $k $v
} }
-colspans { -colspans {
if {[llength $v] > [dict size $o_columndefs]} { set numcols [dict size $o_columndefs]
if {[llength $v] > $numcols} {
error "textblock::table::configure_header -colspans length ([llength $v]) is longer than number of columns ([dict size $o_columndefs])" error "textblock::table::configure_header -colspans length ([llength $v]) is longer than number of columns ([dict size $o_columndefs])"
} }
if {[llength $v] < [dict size $o_columndefs]} { if {[llength $v] < $numcols} {
puts stderr "textblock::table::configure_header warning - only [llength $v] spans specified for [dict size $o_columndefs] columns." puts stderr "textblock::table::configure_header warning - only [llength $v] spans specified for [dict size $o_columndefs] columns."
puts stderr "It is recommended to set all spans explicitly. (auto-calc not implemented)" puts stderr "It is recommended to set all spans explicitly. (auto-calc not implemented)"
} }
@ -1120,48 +1121,61 @@ namespace eval textblock {
set first_is_ok 0 set first_is_ok 0
if {$firstspan eq "all"} { if {$firstspan eq "all"} {
set first_is_ok 1 set first_is_ok 1
} elseif {[string is integer -strict $firstspan] && $firstspan > 0} { } elseif {[string is integer -strict $firstspan] && $firstspan > 0 && $firstspan <= $numcols} {
set first_is_ok 1 set first_is_ok 1
} }
if {!$first_is_ok} { if {!$first_is_ok} {
error "textblock::table::configure_header -colspans first value '$firstspan' must be integer > 0 or the string \"all\"" error "textblock::table::configure_header -colspans first value '$firstspan' must be integer > 0 & <= $numcols or the string \"all\""
} }
#we don't mind if there are less colspans specified than columns.. the tail can be deduced from the leading ones specified (review) #we don't mind if there are less colspans specified than columns.. the tail can be deduced from the leading ones specified (review)
set remaining $firstspan set remaining $firstspan
if {$remaining ne "all"} { if {$remaining ne "all"} {
incr remaining -1 incr remaining -1
} }
set spanview $v
set sidx 1
#because we allow 'all' - be careful when doing < or > comparisons - as we are mixing integer and string comparisons if we don't test for 'all' first
foreach span [lrange $v 1 end] { foreach span [lrange $v 1 end] {
if {$remaining eq "all"} { if {$remaining eq "all"} {
if {$span eq "all"} { if {$span eq "all"} {
set remaining "all" set remaining "all"
} elseif {$span > 0} { } elseif {$span > 0} {
#ok to reset to higher val immediately or after an all and any number of following zeros #ok to reset to higher val immediately or after an all and any number of following zeros
if {$span > ($numcols - $sidx)} {
lset spanview $sidx [a+ web-red]$span[a]
error "textblock::table::configure_header -colspans sequence incorrect at span '$span'. Require span <= [expr {$numcols-$sidx}] or \"all\".[a] $spanview"
}
set remaining $span set remaining $span
incr remaining -1 incr remaining -1
} else { } else {
#zero following an all - leave remaining as all #zero following an all - leave remaining as all
incr remaining -1
} }
} else { } else {
if {$span eq "0"} { if {$span eq "0"} {
if {$remaining eq "0"} { if {$remaining eq "0"} {
error "textblock::table::configure_header -colspans sequence incorrect at span '$span' remaining is $remaining - positive or \"all\" value span required" lset spanview $sidx [a+ web-red]$span[a]
error "textblock::table::configure_header -colspans sequence incorrect at span '$span' remaining is $remaining. Require positive or \"all\" value.[a] $spanview"
} else { } else {
incr remaining -1 incr remaining -1
} }
} else { } else {
if {$remaining eq "0"} { if {$remaining eq "0"} {
#ok for new span value of all or > 0 #ok for new span value of all or > 0
if {$span ne "all" && $span > ($numcols - $sidx)} {
lset spanview $sidx [a+ web-red]$span[a]
error "textblock::table::configure_header -colspans sequence incorrect at span '$span'. Require span <= [expr {$numcols-$sidx}] or \"all\".[a] $spanview"
}
set remaining $span set remaining $span
if {$remaining ne "all"} { if {$remaining ne "all"} {
incr remaining -1 incr remaining -1
} }
} else { } else {
error "textblock::table::configure_header -colspans sequence incorrect at span '$span' remaining is $remaining - zero value span required" lset spanview $sidx [a+ web-red]$span[a]
error "textblock::table::configure_header -colspans sequence incorrect at span '$span' remaining is $remaining. Require zero value span.[a] $spanview"
} }
} }
} }
incr sidx
} }
} }
#empty -colspans list should be ok #empty -colspans list should be ok
@ -5561,6 +5575,12 @@ namespace eval textblock {
} }
#options before content argument - which is allowed to be absent #options before content argument - which is allowed to be absent
#frame performance (noticeable with complex tables even of modest size) is improved significantly by frame_cache - but is still (2024) a fairly expensive operation. #frame performance (noticeable with complex tables even of modest size) is improved significantly by frame_cache - but is still (2024) a fairly expensive operation.
#
#consider if we can use -sticky nsew instead of -blockalign (as per Tk grid -sticky option)
# This would require some sort of expand equivalent e.g for -sticky ew or -sticky ns - for which we have to decide a meaning for text.. e.g ansi padding?
#We are framing 'rendered' text - so we don't have access to for example an inner frame or table to tell it to expand
#we could refactor as an object and provide a -return object option, then use stored -sticky data to influence how another object renders into it
# - but we would need to maintain support for the rendered-string based operations too.
proc frame {args} { proc frame {args} {
variable frametypes variable frametypes
set expect_optval 0 set expect_optval 0

Loading…
Cancel
Save