jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

punk::ansi a? improvements, punk::ansi::sgr_cache

master
Julian Noble 6 months ago
parent
aaaacfb293
commit
e9644754a3
4 changed files with 631 additions and 253 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 795
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 22
      src/modules/punk/console-999999.0a1.0.tm
  3. 6
      src/modules/punk/repl-0.1.tm
  4. 61
      src/modules/textblock-999999.0a1.0.tm

795
src/modules/punk/ansi-999999.0a1.0.tm
Unescape View File

@ -1001,12 +1001,15 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
] ]
#we should be able to use WEB_colour_map as a base and override only the conflicts for X11 colours ? Review - check if this is true #we should be able to use WEB_colour_map as a base and override only the conflicts for X11 colours ? Review - check if this is true
variable X11_colour_map_diff ;#maintain the difference as a separate dict so we can display in a? x11
dict set X11_colour_map_diff gray 190-190-190 ;# #BEBEBE
dict set X11_colour_map_diff green 0-255-0 ;# #00FF00
dict set X11_colour_map_diff maroon 176-48-96 ;# #B03060
dict set X11_colour_map_diff purple 160-32-240 ;# #A020F0
variable X11_colour_map variable X11_colour_map
set X11_colour_map $WEB_colour_map set X11_colour_map [dict merge $WEB_colour_map $X11_colour_map_diff]
dict set X11_colour_map gray 190-190-190 ;# #BEBEBE
dict set X11_colour_map green 0-255-0 ;# #00FF00
dict set X11_colour_map maroon 176-48-96 ;# #B03060
dict set X11_colour_map purple 160-32-240 ;# #A020F0
#Xterm colour names (256 colours) #Xterm colour names (256 colours)
#lists on web have duplicate names #lists on web have duplicate names
@ -1189,7 +1192,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
darkseagreen1\ darkseagreen1\
paleturquoise1\ paleturquoise1\
red3\ red3\
deppink3\ deeppink3\
deeppink3\ deeppink3\
magenta3\ magenta3\
magenta3\ magenta3\
@ -1407,6 +1410,35 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
return $out[a] return $out[a]
} }
proc colourtable_16_names {} {
variable TERM_colour_map_reverse
set rows [list]
set row [list]
set fg "web-white"
set t [textblock::class::table new]
$t configure -show_seps 0 -show_edge 0
for {set i 0} {$i <=15} {incr i} {
set cname [dict get $TERM_colour_map_reverse $i] ;#use term-$i etc instead of term-$name?
if {[llength $row]== 8} {
lappend rows $row
set row [list]
}
if {$i > 6} {
set fg "web-black"
}
#lappend row "[a+ {*}$fg Term-$cname][format %3s $i] $cname "
lappend row "[a+ {*}$fg Term-$i][format %3s $i] $cname "
}
lappend rows $row
foreach r $rows {
$t add_row $r
}
append out [$t print]
$t destroy
append out [a]
return [string trimleft $out \n]
}
#216 colours of 256 #216 colours of 256
proc colourblock_216 {} { proc colourblock_216 {} {
set out "" set out ""
@ -1437,22 +1469,21 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set t [textblock::class::table new] set t [textblock::class::table new]
$t configure -show_seps 0 -show_edge 0 $t configure -show_seps 0 -show_edge 0
for {set i 16} {$i <=231} {incr i} { for {set i 16} {$i <=231} {incr i} {
if {$i % 9 == 7} { set cname [dict get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option
if {[llength $row]== 8} {
lappend rows $row
set row [list]
}
if {$i % 18 == 16} {
if {$fg eq "web-black"} { if {$fg eq "web-black"} {
set fg "web-white" set fg "web-white"
} else { } else {
set fg "web-black" set fg "web-black"
} }
if {[llength $row]} {
lappend row "[a+ {*}$fg Term$i][format %3s $i] [dict get $TERM_colour_map_reverse $i]"
lappend rows $row
set row [list]
}
} else {
lappend row "[a+ {*}$fg Term$i][format %3s $i] [dict get $TERM_colour_map_reverse $i]"
} }
#append out "$br[a+ {*}$fg Term$i][format %3s $i] " lappend row "[a+ {*}$fg Term-$cname][format %3s $i] $cname "
} }
lappend rows $row
foreach r $rows { foreach r $rows {
$t add_row $r $t add_row $r
} }
@ -1473,6 +1504,34 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} }
return $out[a] return $out[a]
}
proc colourtable_24_names {} {
variable TERM_colour_map_reverse
set rows [list]
set row [list]
set fg "web-white"
set t [textblock::class::table new]
$t configure -show_hseps 0 -show_edge 0
for {set i 232} {$i <=255} {incr i} {
set cname [dict get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option
if {[llength $row]== 8} {
lappend rows $row
set row [list]
}
if {$i > 243} {
set fg "web-black"
}
lappend row "[a+ {*}$fg Term-$cname][format %3s $i] $cname "
}
lappend rows $row
foreach r $rows {
$t add_row $r
}
append out [$t print]
$t destroy
append out [a]
return [string trimleft $out \n]
} }
#set WEB_colour_map [dict merge\ #set WEB_colour_map [dict merge\
# $WEB_colour_map_basic\ # $WEB_colour_map_basic\
@ -1530,11 +1589,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} else { } else {
set fg "web-black" set fg "web-black"
} }
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ Rgb-$cdec $fg] #$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg Rgb-$cdec]
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg Web-$cname]
} }
$t configure_column 0 -headers [list "[string totitle $g] colours"] $t configure_column 0 -headers [list "[string totitle $g] colours"]
$t configure_column 0 -header_colspans [list all] $t configure_column 0 -header_colspans [list all]
$t configure -ansibase_header [a+ Web-white web-black] $t configure -ansibase_header [a+ web-black Web-white]
lappend grouptables [$t print] lappend grouptables [$t print]
$t destroy $t destroy
} }
@ -1546,6 +1606,53 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
$displaytable destroy $displaytable destroy
return $result return $result
} }
proc colourtable_x11diff {} {
variable X11_colour_map_diff
variable WEB_colour_map
set comparetables [list] ;# 2 side by side x11 and web
# -- --- ---
set t [textblock::class::table new]
$t configure -show_edge 0 -show_seps 0 -show_header 1
dict for {cname cdec} [set X11_colour_map_diff] {
$t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec]
set fg "web-white"
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg X11-$cname]
}
$t configure_column 0 -headers [list "X11"]
$t configure_column 0 -header_colspans [list all]
$t configure -ansibase_header [a+ web-black Web-white]
lappend comparetables [$t print]
$t destroy
# -- --- ---
set WEB_map_subset [dict create]
dict for {k v} $X11_colour_map_diff {
dict set WEB_map_subset $k [dict get $WEB_colour_map $k]
}
# -- --- ---
set t [textblock::class::table new]
$t configure -show_edge 0 -show_seps 0 -show_header 1
dict for {cname cdec} [set WEB_map_subset] {
$t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec]
set fg "web-white"
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg Web-$cname]
}
$t configure_column 0 -headers [list "Web"]
$t configure_column 0 -header_colspans [list all]
$t configure -ansibase_header [a+ web-black Web-white]
lappend comparetables [$t print]
$t destroy
# -- --- ---
set displaytable [textblock::list_as_table 2 $comparetables -return object]
$displaytable configure -show_header 0 -show_vseps 0
set result [$displaytable print]
$displaytable destroy
return $result
}
proc a? {args} { proc a? {args} {
#*** !doctools #*** !doctools
#[call [fun a?] [opt {ansicode...}]] #[call [fun a?] [opt {ansicode...}]]
@ -1565,14 +1672,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
bold - dim - italic - doubleunderline - blink - fastblink - strike - overline - framecircle { bold - dim - italic - doubleunderline - blink - fastblink - strike - overline - framecircle {
lappend strmap " $k " " [a+ $k]$k$RST " lappend strmap " $k " " [a+ $k]$k$RST "
} }
noreverse - nounderline {
#prefixed version will match before unprefixed - will not be subject to further replacement scanning
lappend strmap "$k" "[a+ $k]$k$RST" ;#could replace with self - but may as well put in punk::ansi::sgr_cache (can make cache a little neater to display)
}
underline - reverse - frame { underline - reverse - frame {
#1st coloumn - no leading space #1st coloumn - no leading space
lappend strmap "$k " "[a+ $k]$k$RST " lappend strmap "$k " "[a+ $k]$k$RST "
} }
noreverse {
#undo mapping of 'reverse' within this string
lappend strmap "$k" "noreverse"
}
} }
} }
set settings_applied [string trim $SGR_setting_map \n] set settings_applied [string trim $SGR_setting_map \n]
@ -1609,6 +1716,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append out [textblock::join $indent "Valid group names (can be listed in any order): basic pink red orange yellow brown purple blue cyan green white grey"] \n append out [textblock::join $indent "Valid group names (can be listed in any order): basic pink red orange yellow brown purple blue cyan green white grey"] \n
append out \n append out \n
append out [textblock::join $indent "Example: \[a+ Web-springgreen web-crimson\]text\[a] -> [a+ Web-springgreen web-coral]text[a]"] \n append out [textblock::join $indent "Example: \[a+ Web-springgreen web-crimson\]text\[a] -> [a+ Web-springgreen web-coral]text[a]"] \n
append out \n
append out "[a+ web-white]X11 colours[a] - mostly match Web colours" \n
append out [textblock::join $indent "To see differences: a? x11"] \n
} on error {result options} { } on error {result options} {
@ -1620,13 +1730,22 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} else { } else {
switch -- [lindex $args 0] { switch -- [lindex $args 0] {
term { term {
return [colourtable_216_names] set out "16 basic colours\n"
append out [colourtable_16_names] \n
append out "216 colours\n"
append out [colourtable_216_names] \n
append out "24 greyscale colours\n"
append out [colourtable_24_names]
return $out
} }
web { web {
return [colourtable_web [lrange $args 1 end]] return [colourtable_web [lrange $args 1 end]]
} }
x11 { x11 {
return "Display not implemented. Mostly same as web" set out ""
append out "Mostly same as web - known differences displayed" \n
append out [colourtable_x11diff]
return $out
} }
} }
set result [list] set result [list]
@ -1646,6 +1765,38 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
return $result return $result
} }
} }
#REVIEW! note that OSC 4 can change the 256 color pallette
#e.g \x1b\]4\;1\;#HHHHHH\x1b\\
# (or with colour name instead of rgb #HHHHHH on for example wezterm)
#Q: If we can't detect OSC 4 - how do we know when to invalidate/clear at least the 256 color portion of the cache?
#A: The cache values should still be valid - and the terminal should display the newly assigned colour.
# If in line mode - perhaps readline or something else is somehow storing the rgb values and replaying invalid colours?
# On wezterm - we can get cells changing colour as we scroll after a pallette change - so something appears to be caching colours
variable sgr_cache
set sgr_cache [dict create]
#sgr_cache clear called by punk::console::ansi when set to off
proc sgr_cache {{action ""}} {
variable sgr_cache
if {$action ni {"" clear}} {
error "sgr_cache action '$action' not understood. Valid actions: clear"
}
if {$action eq "clear"} {
set sgr_cache [dict create]
return "sgr_cache cleared"
}
set out ""
set RST [a]
#todo - terminal width? table?
dict for {key ansi} $sgr_cache {
append out "$ansi$key$RST "
}
return $out\n
}
proc a+ {args} { proc a+ {args} {
#*** !doctools #*** !doctools
#[call [fun a+] [opt {ansicode...}]] #[call [fun a+] [opt {ansicode...}]]
@ -1656,124 +1807,225 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
#[para]punk::ansi::a Red #[para]punk::ansi::a Red
#[para]see [cmd punk::ansi::a?] to display a list of codes #[para]see [cmd punk::ansi::a?] to display a list of codes
variable sgr_cache
if {[dict exists $sgr_cache $args]} {
return [dict get $sgr_cache $args]
}
#don't disable ansi here. #don't disable ansi here.
#we want this to be available to call even if ansi is off #we want this to be available to call even if ansi is off
variable SGR_map
variable WEB_colour_map variable WEB_colour_map
variable TERM_colour_map variable TERM_colour_map
variable X11_colour_map
set t [list] set t [list]
foreach i $args { foreach i $args {
if {[string is integer -strict $i]} { set f4 [string range $i 0 3]
lappend t $i switch -- $f4 {
} elseif {[string first ";" $i] >=0} { web- {
#literal with params #variable WEB_colour_map
lappend t $i #upvar ::punk::ansi::WEB_colour_map WEB_colour_map
} else { #foreground web colour
if {[dict exists $SGR_map $i]} { set cname [string tolower [string range $i 4 end]]
#SGR case must match exactly those in the map if {[dict exists $WEB_colour_map $cname]} {
lappend t [dict get $SGR_map $i] set rgbdash [dict get $WEB_colour_map $cname]
} else { set rgb [string map { - ;} $rgbdash]
#accept examples for foreground lappend t "38;2;$rgb"
# 256f-<int> or 256fg-<int> or 256f<int> } else {
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b> puts stderr "ansi web colour unmatched: '$i'"
switch -- [string range $i 0 3] { }
term { }
#256 colour foreground by Xterm name or by integer Web- - WEB- {
#name is xterm name or colour index from 0 - 255 #variable WEB_colour_map
set cc [string trim [string tolower [string range $i 4 end]] -] #upvar ::punk::ansi::WEB_colour_map WEB_colour_map
if {[string is integer -strict $cc]} { #background web colour
lappend t "38;5;$cc" set cname [string tolower [string range $i 4 end]]
} else { if {[dict exists $WEB_colour_map $cname]} {
if {[dict exists $TERM_colour_map $cc]} { lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]"
set cc [dict get $TERM_colour_map $cc] } else {
lappend t "38;5;$cc" puts stderr "ansi Web colour unmatched: '$i'"
}
}
rese {lappend t 0 ;#reset}
bold {lappend t 1}
dim {lappend t 2}
blin {
#blink
lappend t 5
} }
} fast {
} #fastblink
Term - TERM { lappend t 6
#256 colour background by Xterm name or by integer
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc]} {
lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
set cc [dict get $TERM_colour_map $cc]
lappend t "48;5;$cc"
} }
} nobl {
} #noblink
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 { lappend t 25
#decimal rgb foreground }
set rgbspec [string trim [string range $i 3 end] -] hide {lappend t 8}
set rgb [string map [list - {;} , {;}] $rgbspec] norm {lappend t 22 ;#normal}
lappend t "38;2;$rgb" unde {lappend t 4 ;#underline}
} doub {lappend t 21 ;#doubleunderline}
Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 { noun {lappend t 24 ;#nounderline}
#decimal rgb background stri {lappend t 9 ;#strike}
set rgbspec [string trim [string range $i 3 end] -] nost {lappend t 29 ;#nostrike}
set rgb [string map [list - {;} , {;}] $rgbspec] ital {lappend t 3 ;#italic}
lappend t "48;2;$rgb" noit {lappend t 23 ;#noitalic}
} reve {lappend t 7 ;#reverse}
"rgb#" { nore {lappend t 27 ;#noreverse}
#hex rgb foreground defa {
set hex6 [string trim [string range $i 4 end] -] if {$i eq "defaultfg"} {
set rgb [join [::scan $hex6 %2X%2X%2X] {;}] lappend t 39
lappend t "38;2;$rgb" } else {
} #defaultbg
"Rgb#" - "RGB#" { lappend t 49
#hex rgb background }
set hex6 [string trim [string range $i 4 end] -] }
set rgb [join [::scan $hex6 %2X%2X%2X] {;}] nohi {lappend t 28 ;#nohide}
lappend t "48;2;$rgb" over {lappend t 53 ;#overline}
} noov {lappend t 55 ;#nooverline}
web- { fram {
#foreground web colour if {$i eq "frame"} {
set cname [string tolower [string range $i 4 end]] lappend t 51 ;#frame
if {[dict exists $WEB_colour_map $cname]} { } else {
set rgbdash [dict get $WEB_colour_map $cname] lappend t 52 ;#framecircle
set rgb [string map [list - {;}] $rgbdash] }
lappend t "38;2;$rgb" }
} nofr {lappend t 54 ;#noframe}
} blac {lappend t 30 ;#black}
Web- - WEB- { red {lappend t 31}
#background web colour gree {lappend t 32 ;#green}
set cname [string tolower [string range $i 4 end]] yell {lappend t 33 ;#yellow}
if {[dict exists $WEB_colour_map $cname]} { blue {lappend t 34}
set rgbdash [dict get $WEB_colour_map $cname] purp {lappend t 35 ;#purple}
set rgb [string map [list - {;}] $rgbdash] cyan {lappend t 36}
lappend t "48;2;$rgb" whit {lappend t 37 ;#white}
} Blac {lappend t 40 ;#Black}
} Red {lappend t 41}
x11- { Gree {lappend t 42 ;#Green}
#foreground X11 names Yell {lappend t 43 ;#Yellow}
set cname [string tolower [string range $i 4 end]] Blue {lappend t 44}
if {[dict exists $X11_colour_map $cname]} { Purp {lappend t 45 ;#Purple}
set rgbdash [dict get $X11_colour_map $cname] Cyan {lappend t 46}
set rgb [string map [list - {;}] $rgbdash] Whit {lappend t 47 ;#White}
lappend t "38;2;$rgb" brig {
} switch -- $i {
brightblack {lappend t 90}
brightred {lappend t 91}
brightgreen {lappend t 92}
brightyellow {lappend t 93}
brightblue {lappend t 94}
brightpurple {lappend t 95}
brightcyan {lappend t 96}
brightwhite {lappend t 97}
}
}
Brig {
switch -- $i {
Brightblack {lappend t 100}
Brightred {lappend t 101}
Brightgreen {lappend t 101}
Brightyellow {lappend t 103}
Brightblue {lappend t 104}
Brightpurple {lappend t 105}
Brightcyan {lappend t 106}
Brightwhite {lappend t 107}
}
}
term {
#variable TERM_colour_map
#256 colour foreground 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 t "38;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "38;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi term colour unmatched: '$i'"
} }
X11- { }
#background X11 names }
set cname [string tolower [string range $i 4 end]] Term - TERM {
if {[dict exists $X11_colour_map $cname]} { #variable TERM_colour_map
set rgbdash [dict get $X11_colour_map $cname] #256 colour background by Xterm name or by integer
set rgb [string map [list - {;}] $rgbdash] set cc [string trim [string tolower [string range $i 4 end]] -]
lappend t "48;2;$rgb" if {[string is integer -strict $cc] && $cc < 256} {
} lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "48;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi Term colour unmatched: '$i'"
} }
} }
}
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 {
#decimal rgb foreground
#allow variants rgb-xxx-xxx-xxx and rgbxxx-xxx-xxx
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "38;2;$rgb"
}
Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 {
#decimal rgb background
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "48;2;$rgb"
}
"rgb#" {
#hex rgb foreground
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "38;2;$rgb"
}
"Rgb#" - "RGB#" {
#hex rgb background
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "48;2;$rgb"
}
x11- {
variable X11_colour_map
#foreground X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb"
} else {
puts stderr "ansi x11 colour unmatched: '$i'"
}
}
X11- {
variable X11_colour_map
#background X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "48;2;$rgb"
} else {
puts stderr "ansi X11 colour unmatched: '$i'"
}
}
default {
if {[string is integer -strict $i] || [string first ";" $i] > 0} {
lappend t $i
} else {
puts stderr "ansi name unmatched: '$i' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-"
}
} }
} }
} }
# \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]} {
return "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s)) 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 $t {;}]m"
} }
return "\x1b\[[join $t {;}]m" dict set sgr_cache $args $result
return $result
} }
proc a {args} { proc a {args} {
@ -1787,111 +2039,224 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
#[para]punk::ansi::a Red #[para]punk::ansi::a Red
#[para]see [cmd punk::ansi::a?] to display a list of codes #[para]see [cmd punk::ansi::a?] to display a list of codes
#variable SGR_setting_map { variable sgr_cache
# bold 1 dim 2 blink 5 fastblink 6 noblink 25 hide 8 normal 22 if {[dict exists $sgr_cache $args]} {
# underline 4 doubleunderline 21 nounderline 24 strike 9 nostrike 29 italic 3 noitalic 23 return [dict get $sgr_cache $args]
# reverse 7 noreverse 27 defaultfg 39 defaultbg 49 nohide 28 }
# overline 53 nooverline 55 frame 51 framecircle 52 noframe 54
#}
#variable SGR_colour_map {
# black 30 red 31 green 32 yellow 33 blue 34 purple 35 cyan 36 white 37
# Black 40 Red 41 Green 42 Yellow 43 Blue 44 Purple 45 Cyan 46 White 47
# BLACK 100 RED 101 GREEN 102 YELLOW 103 BLUE 104 PURPLE 105 CYAN 106 WHITE 107
#}
#don't disable ansi here. #don't disable ansi here.
#we want this to be available to call even if ansi is off #we want this to be available to call even if ansi is off
#variable SGR_map variable WEB_colour_map
set t [list] variable TERM_colour_map
set t [list]
foreach i $args { foreach i $args {
switch -- $i { set f4 [string range $i 0 3]
bold {lappend t 1} switch -- $f4 {
dim {lappend t 2} web- {
blink {lappend t 5} #variable WEB_colour_map
fastblink {lappend t 6} #upvar ::punk::ansi::WEB_colour_map WEB_colour_map
noblink {lappend t 25} #foreground web colour
hide {lappend t 8} set cname [string tolower [string range $i 4 end]]
normal {lappend t 22} if {[dict exists $WEB_colour_map $cname]} {
underline {lappend t 4} set rgbdash [dict get $WEB_colour_map $cname]
doubleunderline {lappend t 21} set rgb [string map { - ;} $rgbdash]
nounderline {lappend t 24} lappend t "38;2;$rgb"
strike {lappend t 9} } else {
nostrike {lappend t 29} puts stderr "ansi web colour unmatched: '$i'"
italic {lappend t 3} }
noitalic {lappend t 23} }
reverse {lappend t 7} Web- - WEB- {
noreverse {lappend t 27} #variable WEB_colour_map
defaultfb {lappend t 39} #upvar ::punk::ansi::WEB_colour_map WEB_colour_map
defaultbg {lappedn t 49} #background web colour
nohide {lappend t 28} set cname [string tolower [string range $i 4 end]]
overline {lappend t 53} if {[dict exists $WEB_colour_map $cname]} {
nooverline {lappend t 55} lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]"
frame {lappend t 51} } else {
framecircle {lappend t 52} puts stderr "ansi Web colour unmatched: '$i'"
noframe {lappend t 54} }
black {lappend t 30} }
red {lappend t 31} rese {lappend t 0 ;#reset}
green {lappend t 32} bold {lappend t 1}
yellow {lappend t 33} dim {lappend t 2}
blue {lappend t 34} blin {
purple {lappend t 35} #blink
cyan {lappend t 36} lappend t 5
white {lappend t 37} }
Black {lappend t 40} fast {
Red {lappend t 41} #fastblink
Green {lappend t 42} lappend t 6
Yellow {lappend t 43} }
Blue {lappend t 44} nobl {
Purple {lappend t 45} #noblink
Cyan {lappend t 46} lappend t 25
White {lappend t 47} }
BLACK {lappend t 100} hide {lappend t 8}
RED {lappend t 101} norm {lappend t 22 ;#normal}
GREEN {lappend t 101} unde {lappend t 4 ;#underline}
YELLOW {lappend t 103} doub {lappend t 21 ;#doubleunderline}
BLUE {lappend t 104} noun {lappend t 24 ;#nounderline}
PURPLE {lappend t 105} stri {lappend t 9 ;#strike}
CYAN {lappend t 106} nost {lappend t 29 ;#nostrike}
WHITE {lappend t 107} ital {lappend t 3 ;#italic}
noit {lappend t 23 ;#noitalic}
reve {lappend t 7 ;#reverse}
nore {lappend t 27 ;#noreverse}
defa {
if {$i eq "defaultfg"} {
lappend t 39
} else {
#defaultbg
lappend t 49
}
}
nohi {lappend t 28 ;#nohide}
over {lappend t 53 ;#overline}
noov {lappend t 55 ;#nooverline}
fram {
if {$i eq "frame"} {
lappend t 51 ;#frame
} else {
lappend t 52 ;#framecircle
}
}
nofr {lappend t 54 ;#noframe}
blac {lappend t 30 ;#black}
red {lappend t 31}
gree {lappend t 32 ;#green}
yell {lappend t 33 ;#yellow}
blue {lappend t 34}
purp {lappend t 35 ;#purple}
cyan {lappend t 36}
whit {lappend t 37 ;#white}
Blac {lappend t 40 ;#Black}
Red {lappend t 41}
Gree {lappend t 42 ;#Green}
Yell {lappend t 43 ;#Yellow}
Blue {lappend t 44}
Purp {lappend t 45 ;#Purple}
Cyan {lappend t 46}
Whit {lappend t 47 ;#White}
brig {
switch -- $i {
brightblack {lappend t 90}
brightred {lappend t 91}
brightgreen {lappend t 92}
brightyellow {lappend t 93}
brightblue {lappend t 94}
brightpurple {lappend t 95}
brightcyan {lappend t 96}
brightwhite {lappend t 97}
}
}
Brig {
switch -- $i {
Brightblack {lappend t 100}
Brightred {lappend t 101}
Brightgreen {lappend t 101}
Brightyellow {lappend t 103}
Brightblue {lappend t 104}
Brightpurple {lappend t 105}
Brightcyan {lappend t 106}
Brightwhite {lappend t 107}
}
}
term {
#variable TERM_colour_map
#256 colour foreground 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 t "38;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "38;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi term colour unmatched: '$i'"
}
}
}
Term - TERM {
#variable TERM_colour_map
#256 colour background by Xterm name or by integer
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc] && $cc < 256} {
lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "48;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi Term colour unmatched: '$i'"
}
}
}
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 {
#decimal rgb foreground
#allow variants rgb-xxx-xxx-xxx and rgbxxx-xxx-xxx
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "38;2;$rgb"
}
Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 {
#decimal rgb background
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "48;2;$rgb"
}
"rgb#" {
#hex rgb foreground
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "38;2;$rgb"
}
"Rgb#" - "RGB#" {
#hex rgb background
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "48;2;$rgb"
}
x11- {
variable X11_colour_map
#foreground X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb"
} else {
puts stderr "ansi x11 colour unmatched: '$i'"
}
}
X11- {
variable X11_colour_map
#background X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "48;2;$rgb"
} else {
puts stderr "ansi X11 colour unmatched: '$i'"
}
}
default { default {
if {[string is integer -strict $i]} { if {[string is integer -strict $i] || [string first ";" $i] > 0} {
lappend t $i
} elseif {[string first ";" $i] >=0} {
#literal with params
lappend t $i lappend t $i
} else { } else {
#accept examples for foreground puts stderr "ansi name unmatched: '$i' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-"
# 256f-# or 256fg-# or 256f#
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
switch -nocase -glob -- $i {
"256f*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "38;5;$cc"
}
"256b*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "48;5;$cc"
}
"rgbf*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "38;2;$r;$g;$b"
}
"rgbb*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "48;2;$r;$g;$b"
}
}
} }
} }
} }
} }
# \033 - octal. equivalently \x1b in hex which is more common in documentation # \033 - octal. equivalently \x1b in hex which is more common in documentation
# 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 0 0] set t [linsert $t[unset t] 0 0]
return "\x1b\[[join $t {;}]m" set result "\x1b\[[join $t {;}]m"
dict set sgr_cache $args $result
return $result
} }
proc ansiwrap {codes text} { proc ansiwrap {codes text} {

22
src/modules/punk/console-999999.0a1.0.tm
Unescape View File

@ -804,30 +804,33 @@ namespace eval punk::console {
} }
} }
proc code_a {args} { proc code_a+ {args} {
variable colour_disabled variable colour_disabled
variable ansi_wanted variable ansi_wanted
if {$colour_disabled || $ansi_wanted <= 0} { if {$colour_disabled || $ansi_wanted <= 0} {
return return
} }
tailcall punk::ansi::a {*}$args #a and a+ are called a *lot* - avoid even slight overhead of tailcall as it doesn't give us anything useful here
#tailcall punk::ansi::a+ {*}$args
::punk::ansi::a+ {*}$args
} }
proc code_a? {args} { proc code_a {args} {
variable colour_disabled variable colour_disabled
variable ansi_wanted variable ansi_wanted
if {$colour_disabled || $ansi_wanted <= 0} { if {$colour_disabled || $ansi_wanted <= 0} {
return [punk::ansi::stripansi [::punk::ansi::a? {*}$args]] return
} else {
tailcall ::punk::ansi::a? {*}$args
} }
#tailcall punk::ansi::a {*}$args
::punk::ansi::a {*}$args
} }
proc code_a+ {args} { proc code_a? {args} {
variable colour_disabled variable colour_disabled
variable ansi_wanted variable ansi_wanted
if {$colour_disabled || $ansi_wanted <= 0} { if {$colour_disabled || $ansi_wanted <= 0} {
return return [punk::ansi::stripansi [::punk::ansi::a? {*}$args]]
} else {
tailcall ::punk::ansi::a? {*}$args
} }
tailcall punk::ansi::a+ {*}$args
} }
proc ansi {{onoff {}}} { proc ansi {{onoff {}}} {
@ -846,6 +849,7 @@ namespace eval punk::console {
false - false -
no { no {
set ansi_wanted 0 set ansi_wanted 0
punk::ansi::sgr_cache clear
} }
default { default {
set ansi_wanted 2 set ansi_wanted 2

6
src/modules/punk/repl-0.1.tm
Unescape View File

@ -2458,12 +2458,12 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
doprompt "p% " doprompt "p% "
} }
} else { } else {
#doprompt "P% " "green nobold" #doprompt "P% " "green normal"
if {$linenum == 0} { if {$linenum == 0} {
doprompt "P% " "green nobold" doprompt "P% " "green normal"
screen_last_char_add " " empty empty screen_last_char_add " " empty empty
} else { } else {
doprompt "\nP% " "green nobold" doprompt "\nP% " "green normal"
screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required
} }
} }

61
src/modules/textblock-999999.0a1.0.tm
Unescape View File

@ -28,6 +28,9 @@ package require term::ansi::code::macros ;#required for frame if old ansi g0 use
package require textutil package require textutil
namespace eval textblock { namespace eval textblock {
#review - what about ansi off in punk::console?
namespace import ::punk::ansi::a ::punk::ansi::a+
namespace eval class { namespace eval class {
variable opts_table_defaults variable opts_table_defaults
set opts_table_defaults [dict create\ set opts_table_defaults [dict create\
@ -890,7 +893,10 @@ namespace eval textblock {
#*** !doctools #*** !doctools
#[call class::table [method add_row] [arg args]] #[call class::table [method add_row] [arg args]]
if {[dict size $o_columndefs] > 0 && ([llength $valuelist] && [llength $valuelist] != [dict size $o_columndefs])} { if {[dict size $o_columndefs] > 0 && ([llength $valuelist] && [llength $valuelist] != [dict size $o_columndefs])} {
error "add_row - invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" set msg ""
append msg "add_row - invalid number ([llength $valuelist]) of values in row - Must match existing column count: [dict size $o_columndefs]" \n
append msg "rowdata: $valuelist"
error $msg
} }
if {[dict size $o_columndefs] == 0 && ![llength $valuelist]} { if {[dict size $o_columndefs] == 0 && ![llength $valuelist]} {
error "add_row - no values supplied, and no columns defined, so cannot use default column values" error "add_row - no values supplied, and no columns defined, so cannot use default column values"
@ -1279,7 +1285,7 @@ namespace eval textblock {
set ansiborder_final $ansibase_header$ansiborder_header set ansiborder_final $ansibase_header$ansiborder_header
} }
set cidx [lindex [dict keys $o_columndefs] $index_expression] set cidx [lindex [dict keys $o_columndefs] $index_expression]
set RST [a] set RST [punk::ansi::a]
set colwidth [my column_width $cidx] set colwidth [my column_width $cidx]
set hcell_line_blank [string repeat " " $colwidth] set hcell_line_blank [string repeat " " $colwidth]
@ -2674,8 +2680,10 @@ namespace eval textblock {
} }
return [tcl::mathfunc::max {*}[lmap v $block {::punk::char::string_width [stripansi $v]}]] return [tcl::mathfunc::max {*}[lmap v $block {::punk::char::string_width [stripansi $v]}]]
} }
pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1| #we shouldn't make textblock depend on the punk pipeline system
#pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
#pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
proc ::textblock::pad {block args} { proc ::textblock::pad {block args} {
set defaults [dict create\ set defaults [dict create\
@ -2986,22 +2994,23 @@ namespace eval textblock {
#playing with syntax #playing with syntax
pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
/2,col1/1,col2/3
>} punk::lib::lines_as_list -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {| # pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
/2,col1/1,col2/3 # /2,col1/1,col2/3
>} .=> punk::lib::lines_as_list -- {| # >} punk::lib::lines_as_list -- {|
data2 # data2
>} .=lhs> punk::lib::lines_as_list -- {| # >} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {| # >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,rhs/1| # >} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
#
# pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
# /2,col1/1,col2/3
# >} .=> punk::lib::lines_as_list -- {|
# data2
# >} .=lhs> punk::lib::lines_as_list -- {|
# >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
# >} punk::lib::list_as_lines -- <lhs/0,rhs/1|
proc ::textblock::join1 {args} { proc ::textblock::join1 {args} {
@ -3081,13 +3090,13 @@ namespace eval textblock {
set trimlines "" set trimlines ""
} }
pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {| #pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3 # /2,col1/1,col2/3
>} .=> punk::lib::lines_as_list -- {| # >} .=> punk::lib::lines_as_list -- {|
data2 # data2
>} .=lhs> punk::lib::lines_as_list -- {| # >} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {| # >} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {|
>} punk::lib::list_as_lines <lhs/0,rhs/1| # >} punk::lib::list_as_lines <lhs/0,rhs/1|
proc example {} { proc example {} {
set pleft [>punk . rhs] set pleft [>punk . rhs]

Write Preview
Loading…
Cancel
Save