Browse Source

ansi colour,textblock::table,textblock::frame, and repl fixes

master
Julian Noble 6 months ago
parent
commit
7fd49bb2e2
  1. 67
      src/modules/oolib-0.1.2.tm
  2. 412
      src/modules/punk/ansi-999999.0a1.0.tm
  3. 4
      src/modules/punk/basictelnet-999999.0a1.0.tm
  4. 50
      src/modules/punk/repl-0.1.tm
  5. 1083
      src/modules/textblock-999999.0a1.0.tm

67
src/modules/oolib-0.1.1.tm → src/modules/oolib-0.1.2.tm

@ -2,13 +2,13 @@
# #
package provide oolib [namespace eval oolib { package provide oolib [namespace eval oolib {
variable version variable version
set version 0.1.1 set version 0.1.2
}] }]
namespace eval oolib { namespace eval oolib {
oo::class create collection { oo::class create collection {
variable o_data ;#dict variable o_data ;#dict
variable o_alias #variable o_alias
constructor {} { constructor {} {
set o_data [dict create] set o_data [dict create]
} }
@ -103,37 +103,38 @@ namespace eval oolib {
} }
} }
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists? #review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} { #review - what is the point of alias anyway? - why slow down other operations when a variable can hold a keyname perfectly well?
if {[string is integer -strict $newAlias]} { #method alias {newAlias existingKeyOrAlias} {
error "[self object] collection key alias cannot be integer" # if {[string is integer -strict $newAlias]} {
} # error "[self object] collection key alias cannot be integer"
if {[string length $existingKeyOrAlias]} { # }
set o_alias($newAlias) $existingKeyOrAlias # if {[string length $existingKeyOrAlias]} {
} else { # set o_alias($newAlias) $existingKeyOrAlias
unset o_alias($newAlias) # } else {
} # unset o_alias($newAlias)
} # }
method aliases {{key ""}} { #}
if {[string length $key]} { #method aliases {{key ""}} {
set result [list] # if {[string length $key]} {
foreach {n v} [array get o_alias] { # set result [list]
if {$v eq $key} { # foreach {n v} [array get o_alias] {
lappend result $n $v # if {$v eq $key} {
} # lappend result $n $v
} # }
return $result # }
} else { # return $result
return [array get o_alias] # } else {
} # return [array get o_alias]
} # }
#if the supplied index is an alias, return the underlying key; else return the index supplied. #}
method realKey {idx} { ##if the supplied index is an alias, return the underlying key; else return the index supplied.
if {[catch {set o_alias($idx)} key]} { #method realKey {idx} {
return $idx # if {[catch {set o_alias($idx)} key]} {
} else { # return $idx
return $key # } else {
} # return $key
} # }
#}
method add {value key} { method add {value key} {
if {[string is integer -strict $key]} { if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required" error "[self object] collection key must not be an integer. Use another structure if integer keys required"

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

@ -106,7 +106,7 @@ namespace eval punk::ansi::class {
#overflow is a different concept - perhaps not particularly congruent with the idea of the textblock as a mini terminal emulator. #overflow is a different concept - perhaps not particularly congruent with the idea of the textblock as a mini terminal emulator.
#overflow effectively auto-expands the block(terminal?) width #overflow effectively auto-expands the block(terminal?) width
#overflow and wrap both being true won't make sense unless we implement a max_overflow concept #overflow and wrap both being true won't make sense unless we implement a max_overflow concept
set o_rendered [overtype::left -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] set o_rendered [overtype::renderspace -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]]
if {$cksum eq "not-done"} { if {$cksum eq "not-done"} {
#if dimensions changed - the checksum won't have been done #if dimensions changed - the checksum won't have been done
set o_rendered_what [$o_ansistringobj checksum] set o_rendered_what [$o_ansistringobj checksum]
@ -129,7 +129,7 @@ namespace eval punk::ansi::class {
set o_dimensions $dimensions set o_dimensions $dimensions
set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] set rendered [overtype::renderspace -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]]
return $rendered return $rendered
} }
method render_to_input_line {args} { method render_to_input_line {args} {
@ -175,7 +175,7 @@ namespace eval punk::ansi::class {
if {$opt_minus ne "0"} { if {$opt_minus ne "0"} {
set chunk [string range $chunk 0 end-$opt_minus] set chunk [string range $chunk 0 end-$opt_minus]
} }
set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" $chunk] set rendered [overtype::renderspace -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" $chunk]
set marker "" set marker ""
for {set i 1} {$i <= $w} {incr i} { for {set i 1} {$i <= $w} {incr i} {
if {$i % 10 == 0} { if {$i % 10 == 0} {
@ -190,13 +190,13 @@ namespace eval punk::ansi::class {
set xline [lindex $rlines $x]\n set xline [lindex $rlines $x]\n
set xlinev [ansistring VIEWSTYLE $xline] set xlinev [ansistring VIEWSTYLE $xline]
set xlinev [string map $maplf $xlinev] set xlinev [string map $maplf $xlinev]
set xlinedisplay [overtype::left -wrap 1 -width $w -height 1 "" $xlinev] set xlinedisplay [overtype::renderspace -wrap 1 -width $w -height 1 "" $xlinev]
::append rendered \n $xlinedisplay ::append rendered \n $xlinedisplay
set chunk [ansistring VIEWSTYLE $chunk] set chunk [ansistring VIEWSTYLE $chunk]
set chunk [string map $maplf $chunk] set chunk [string map $maplf $chunk]
#keep chunkdisplay narrower - leave at 80 or it will get unwieldy for larger image widths #keep chunkdisplay narrower - leave at 80 or it will get unwieldy for larger image widths
set chunkdisplay [overtype::left -wrap 1 -width 80 -height 1 "" $chunk] set chunkdisplay [overtype::renderspace -wrap 1 -width 80 -height 1 "" $chunk]
set renderheight [llength [split $rendered \n]] set renderheight [llength [split $rendered \n]]
set chunkdisplay_lines [split $chunkdisplay \n] set chunkdisplay_lines [split $chunkdisplay \n]
set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end] set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end]
@ -215,14 +215,87 @@ namespace eval punk::ansi::class {
method viewlines {} { method viewlines {} {
return [ansistring VIEW [$o_ansistringobj get]] return [ansistring VIEW [$o_ansistringobj get]]
} }
method viewcodes {} { method viewcodes {args} {
return [ansistring VIEWCODES [$o_ansistringobj get]] set defaults [list\
-lf 0\
-vt 0\
-width "auto"\
]
foreach {k v} $args {
switch -- $k {
-lf - -vt - -width {}
default {
error "viewcodes unrecognised option '$k'. Known options [dict keys $defaults]"
}
}
}
set opts [dict merge $defaults $args]
set opts_lf [dict get $opts -lf]
set opts_vt [dict get $opts -vt]
set opts_width [dict get $opts -width]
if {$opts_width eq ""} {
return [ansistring VIEWCODES -lf $opts_lf -vt $opts_vt [$o_ansistringobj get]]
} elseif {$opts_width eq "auto"} {
lassign [punk::console::get_size] _cols columns _rows rows
set displaycols [expr {$columns -4}] ;#review
return [overtype::renderspace -width $displaycols -wrap 1 "" [ansistring VIEWCODES -lf $opts_lf -vt $opts_vt [$o_ansistringobj get]]]
} elseif {[string is integer -strict $opts_width] && $opts_width > 0} {
return [overtype::renderspace -width $opts_width -wrap 1 "" [ansistring VIEWCODES -lf $opts_lf -vt $opts_vt [$o_ansistringobj get]]]
} else {
error "viewcodes unrecognised value for -width. Try auto or a positive integer"
}
} }
method viewchars {} { method viewchars {args} {
return [punk::ansi::stripansiraw [$o_ansistringobj get]] set defaults [list\
-width "auto"\
]
foreach {k v} $args {
switch -- $k {
-width {}
default {
error "viewchars unrecognised option '$k'. Known options [dict keys $defaults]"
}
}
}
set opts [dict merge $defaults $args]
set opts_width [dict get $opts -width]
if {$opts_width eq ""} {
return [punk::ansi::stripansiraw [$o_ansistringobj get]]
} elseif {$opts_width eq "auto"} {
lassign [punk::console::get_size] _cols columns _rows rows
set displaycols [expr {$columns -4}] ;#review
return [overtype::renderspace -width $displaycols -wrap 1 "" [punk::ansi::stripansiraw [$o_ansistringobj get]]]
} elseif {[string is integer -strict $opts_width] && $opts_width > 0} {
return [overtype::renderspace -width $opts_width -wrap 1 "" [punk::ansi::stripansiraw [$o_ansistringobj get]]]
} else {
error "viewchars unrecognised value for -width. Try auto or a positive integer"
}
} }
method viewstyle {} { method viewstyle {args} {
return [ansistring VIEWSTYLE [$o_ansistringobj get]] set defaults [list\
-width "auto"\
]
foreach {k v} $args {
switch -- $k {
-width {}
default {
error "viewstyle unrecognised option '$k'. Known options [dict keys $defaults]"
}
}
}
set opts [dict merge $defaults $args]
set opts_width [dict get $opts -width]
if {$opts_width eq ""} {
return [ansistring VIEWSTYLE [$o_ansistringobj get]]
} elseif {$opts_width eq "auto"} {
lassign [punk::console::get_size] _cols columns _rows rows
set displaycols [expr {$columns -4}] ;#review
return [overtype::renderspace -width $displaycols -wrap 1 "" [ansistring VIEWSTYLE [$o_ansistringobj get]]]
} elseif {[string is integer -strict $opts_width] && $opts_width > 0} {
return [overtype::renderspace -width $opts_width -wrap 1 "" [ansistring VIEWSTYLE [$o_ansistringobj get]]]
} else {
error "viewstyle unrecognised value for -width. Try auto or a positive integer"
}
} }
method append_noreturn {ansistring} { method append_noreturn {ansistring} {
$o_ansistringobj append $ansistring $o_ansistringobj append $ansistring
@ -456,7 +529,7 @@ namespace eval punk::ansi {
set ansidata [fcat -encoding $encoding $fname] set ansidata [fcat -encoding $encoding $fname]
set obj [punk::ansi::class::class_ansi new $ansidata] set obj [punk::ansi::class::class_ansi new $ansidata]
if {$test_mode} { if {$encoding eq "cp437"} {
set result [$obj rendertest $dimensions] set result [$obj rendertest $dimensions]
} else { } else {
set result [$obj render $dimensions] set result [$obj render $dimensions]
@ -600,7 +673,6 @@ namespace eval punk::ansi {
#[para]Alternate graphics modes will be stripped - exposing the raw characters as they appear without graphics mode. #[para]Alternate graphics modes will be stripped - exposing the raw characters as they appear without graphics mode.
#[para]ie instead of a horizontal line you may see: qqqqqq #[para]ie instead of a horizontal line you may see: qqqqqq
join [::punk::ansi::ta::split_at_codes $text] "" join [::punk::ansi::ta::split_at_codes $text] ""
} }
proc stripansi1 {text} { proc stripansi1 {text} {
@ -1061,7 +1133,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
dodgerblue2\ dodgerblue2\
green4\ green4\
springgreen4\ springgreen4\
turquise4\ turquoise4\
deepskyblue3\ deepskyblue3\
deepskyblue3\ deepskyblue3\
dodgerblue1\ dodgerblue1\
@ -1459,7 +1531,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append out [a] append out [a]
return [string trimleft $out \n] return [string trimleft $out \n]
} }
proc colourtable_216_names {} {
#x6 is reasonable from a width (124 screen cols) and colour viewing perspective
proc colourtable_216_names {{cols 6}} {
set out "" set out ""
#use the reverse lookup dict - the original xterm_names list has duplicates - we want the disambiguated (potentially suffixed) names #use the reverse lookup dict - the original xterm_names list has duplicates - we want the disambiguated (potentially suffixed) names
variable TERM_colour_map_reverse variable TERM_colour_map_reverse
@ -1470,7 +1544,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
$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} {
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 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} { if {[llength $row]== $cols} {
lappend rows $row lappend rows $row
set row [list] set row [list]
} }
@ -1492,6 +1566,112 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append out [a] append out [a]
return [string trimleft $out \n] return [string trimleft $out \n]
} }
proc colourtable_term_pastel {} {
set out ""
set rows [list]
#see https://www.hackitu.de/termcolor256/
lappend rows {59 95 131 167 174 181 188}
lappend rows {59 95 131 173 180 187 188}
lappend rows {59 95 137 179 186 187 188}
lappend rows {59 101 143 185 186 187 188}
lappend rows {59 65 107 149 186 187 188}
lappend rows {59 65 71 113 150 187 188}
lappend rows {59 65 71 77 114 151 188}
lappend rows {59 65 71 78 115 152 188}
lappend rows {59 65 72 79 116 152 188}
lappend rows {59 66 73 80 116 152 188}
lappend rows {59 60 67 74 116 152 188}
lappend rows {59 60 61 68 110 152 188}
lappend rows {59 60 61 62 104 146 188}
lappend rows {59 60 61 98 140 182 188}
lappend rows {59 60 97 134 176 182 188}
lappend rows {59 96 133 170 176 182 188}
lappend rows {59 95 132 169 176 182 188}
lappend rows {59 95 131 168 175 182 188}
set t [textblock::class::table new]
$t configure -show_seps 0 -show_edge 0
set fg "web-black"
foreach r $rows {
set rowcells [list]
foreach cnum $r {
lappend rowcells "[a+ $fg Term-$cnum][format %3s $cnum] "
}
$t add_row $rowcells
}
append out [$t print]
$t destroy
set pastel8 [list 102 138 144 108 109 103 139 145]
set p8 ""
foreach cnum $pastel8 {
append p8 "[a+ $fg Term-$cnum][format %3s $cnum] "
}
append p8 [a]\n
append out \n $p8
return $out
}
proc colourtable_term_rainbow {} {
set out ""
set rows [list]
set fgwhite [list 16 52 88 124 160 22 17 18 19 20 21 57 56 93 55 92 54 91 53 90 89 126 88 125 124 160]
#see https://www.hackitu.de/termcolor256/
lappend rows {16 52 88 124 160 196 203 210 217 224 231}
lappend rows {16 52 88 124 160 202 209 216 223 230 231}
lappend rows {16 52 88 124 166 208 215 222 229 230 231}
lappend rows {16 52 88 130 172 214 221 228 229 230 231}
lappend rows {16 52 94 136 178 220 227 227 228 230 231}
lappend rows {16 58 100 142 184 226 227 228 228 230 231}
lappend rows {16 22 64 106 148 190 227 228 229 230 231}
lappend rows {16 22 28 70 112 154 191 228 229 230 231}
lappend rows {16 22 28 34 76 118 155 192 229 230 231}
lappend rows {16 22 28 34 40 82 119 156 193 230 231}
lappend rows {16 22 28 34 40 46 83 120 157 194 231}
lappend rows {16 22 28 34 40 47 84 121 158 195 231}
lappend rows {16 22 28 34 41 48 85 122 158 195 231}
lappend rows {16 22 28 35 42 49 86 123 159 195 231}
lappend rows {16 22 29 36 43 50 87 123 159 195 231}
lappend rows {16 23 30 37 44 51 87 123 159 195 231}
lappend rows {16 17 24 31 38 45 87 123 159 195 231}
lappend rows {16 17 18 25 32 39 81 123 159 195 231}
lappend rows {16 17 18 19 26 33 75 117 159 195 231}
lappend rows {16 17 18 19 20 27 69 111 153 195 231}
lappend rows {16 17 18 19 20 21 63 105 147 189 231}
lappend rows {16 17 18 19 20 57 99 141 183 225 231}
lappend rows {16 17 18 19 56 93 135 177 219 225 231}
lappend rows {16 17 18 55 92 129 171 213 219 225 231}
lappend rows {16 17 54 91 128 165 207 213 219 225 231}
lappend rows {16 53 90 127 164 201 207 213 219 225 231}
lappend rows {16 52 89 126 163 200 207 213 219 225 231}
lappend rows {16 52 88 125 162 199 206 213 219 225 231}
lappend rows {16 52 88 124 161 198 205 212 219 225 231}
lappend rows {16 52 88 124 160 197 204 211 218 225 231}
set t [textblock::class::table new]
$t configure -show_seps 0 -show_edge 0
foreach r $rows {
set rowcells [list]
foreach cnum $r {
if {$cnum in $fgwhite} {
set fg "web-white"
} else {
set fg "web-black"
}
lappend rowcells "[a+ $fg Term-$cnum][format %3s $cnum] "
}
$t add_row $rowcells
}
append out [$t print]
$t destroy
return $out
}
#24 greys of 256 #24 greys of 256
proc colourblock_24 {} { proc colourblock_24 {} {
set out "" set out ""
@ -1548,7 +1728,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# $WEB_colour_map_gray\ # $WEB_colour_map_gray\
#] #]
proc colourtable_web {{groups *}} { proc colourtable_web {{groups *}} {
set all_groupnames [list basic pink red orange yellow brown purple blue cyan green white gray] #set all_groupnames [list basic pink red orange yellow brown purple blue cyan green white gray]
set all_groupnames [list basic brown yellow red pink orange purple blue cyan green white gray]
switch -- $groups { switch -- $groups {
"" - * { "" - * {
set show_groups $all_groupnames set show_groups $all_groupnames
@ -1696,7 +1877,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set map2 [colourmap2 $bgname] set map2 [colourmap2 $bgname]
set map2 [overtype::centre -transparent 1 $map2 "[a black $bgname]High-intensity colours[a]"] set map2 [overtype::centre -transparent 1 $map2 "[a black $bgname]High-intensity colours[a]"]
append out [textblock::join $indent [textblock::join $map1 $map2]] \n append out [textblock::join $indent [textblock::join $map1 $map2]] \n
append out "[a+ web-white]216 colours of 256 terminal colours (To see names, use: a? term)[a]" \n append out "[a+ web-white]216 colours of 256 terminal colours (To see names, use: a? term ?pastel? ?rainbow?)[a]" \n
append out [textblock::join $indent [colourblock_216]] \n append out [textblock::join $indent [colourblock_216]] \n
append out "[a+ web-white]24 Greyscale colours[a]" \n append out "[a+ web-white]24 Greyscale colours[a]" \n
append out [textblock::join $indent [colourblock_24]] \n append out [textblock::join $indent [colourblock_24]] \n
@ -1709,6 +1890,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
#dict set WEB_colour_map mediumvioletred 199-21-133 ;# #C71585 #dict set WEB_colour_map mediumvioletred 199-21-133 ;# #C71585
append out [textblock::join $indent "Example: \[a+ rgb-199-21-133\]text\[a] -> [a+ rgb-199-21-133]text[a]"] \n append out [textblock::join $indent "Example: \[a+ rgb-199-21-133\]text\[a] -> [a+ rgb-199-21-133]text[a]"] \n
append out [textblock::join $indent "Example: \[a+ Rgb#C71585\]text\[a] -> [a+ Rgb#C71585]text[a]"] \n append out [textblock::join $indent "Example: \[a+ Rgb#C71585\]text\[a] -> [a+ Rgb#C71585]text[a]"] \n
append out [textblock::join $indent "Examine a sequence: a? bold rgb-46-139-87 Rgb#C71585 "] \n
append out \n append out \n
append out "[a+ web-white]Web colours[a]" \n append out "[a+ web-white]Web colours[a]" \n
append out [textblock::join $indent "To see all names use: a? web"] \n append out [textblock::join $indent "To see all names use: a? web"] \n
@ -1730,12 +1912,34 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} else { } else {
switch -- [lindex $args 0] { switch -- [lindex $args 0] {
term { term {
set termargs [lrange $args 1 end]
foreach ta $termargs {
switch -- $ta {
pastel - rainbow {}
default {error "unrecognised term option '$ta'. Known values: pastel rainbow"}
}
}
set out "16 basic colours\n" set out "16 basic colours\n"
append out [colourtable_16_names] \n append out [colourtable_16_names] \n
append out "216 colours\n" append out "216 colours\n"
append out [colourtable_216_names] \n append out [colourtable_216_names] \n
append out "24 greyscale colours\n" append out "24 greyscale colours\n"
append out [colourtable_24_names] append out [colourtable_24_names]
foreach ta $termargs {
switch -- $ta {
pastel {
append out \n
append out "Pastel Colour Space (punk::ansi::colourtable_term_pastel)\n"
append out [colourtable_term_pastel]
}
rainbow {
append out \n
append out "Rainbow Colours (punk::ansi::colourtable_term_rainbow)\n"
append out [colourtable_term_rainbow]
}
}
}
append out "\nNote: The 256 term colours especially 0-15 may be altered by terminal pallette settings or ansi OSC 4 codes, so specific RGB values are unavailable"
return $out return $out
} }
web { web {
@ -1748,20 +1952,130 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
return $out return $out
} }
} }
set result [list]
set map [dict merge $SGR_setting_map $SGR_colour_map] variable WEB_colour_map
set rmap [lreverse $map] variable X11_colour_map
variable TERM_colour_map
variable TERM_colour_map_reverse
variable SGR_map
set t [textblock::class::table new]
$t configure -show_edge 0 -show_seps 1 -show_header 0
set resultlist [list]
foreach i $args { foreach i $args {
if {[string is integer -strict $i]} { set f4 [string range $i 0 3]
if {[dict exists $rmap $i]} { set s [a+ $i]sample
lappend result $i [dict get $rmap $i] switch -- $f4 {
web- - Web- - WEB- {
set tail [string tolower [string trim [string range $i 4 end] -]]
if {[dict exists $WEB_colour_map $tail]} {
set dec [dict get $WEB_colour_map $tail]
set hex [colour_dec2hex $dec]
set descr "$hex $dec"
} else {
set descr "UNKNOWN colour for web"
}
$t add_row [list $i $descr $s [ansistring VIEW $s]]
} }
} else { term - Term {
if {[dict exists $map $i]} { set tail [string trim [string range $i 4 end] -]
lappend result $i [dict get $map $i] if {[string is integer -strict $tail]} {
if {$tail < 256} {
set descr "[dict get $TERM_colour_map_reverse $tail]"
} else {
set descr "Invalid (> 255)"
}
} else {
set tail [string tolower $tail]
if {[dict exists $TERM_colour_map $tail]} {
set descr [dict get $TERM_colour_map $tail]
} else {
set descr "UNKNOWN colour for term"
}
}
$t add_row [list $i $descr $s [ansistring VIEW $s]]
}
x11- - X11- {
set tail [string tolower [string trim [string range $i 4 end] -]]
if {[dict exists $X11_colour_map $tail]} {
set dec [dict get $X11_colour_map $tail]
set hex [colour_dec2hex $dec]
set descr "$hex $dec"
} else {
set descr "UNKNOWN colour for x11"
}
$t add_row [list $i $descr $s [ansistring VIEW $s]]
} }
rgb- - Rgb- - RGB- -
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# {
if {[string index $i 3] eq "#"} {
set tail [string range $i 4 end]
set hex $tail
set dec [colour_hex2dec $hex]
set info $dec ;#show opposite type as first line of info col
} else {
set tail [string trim [string range $i 3 end] -]
set dec $tail
set hex [colour_dec2hex $dec]
set info $hex
}
set webcolours_i [lsearch -all $WEB_colour_map $dec]
set webcolours [list]
foreach ci $webcolours_i {
lappend webcolours [lindex $WEB_colour_map $ci-1]
}
set x11colours [list]
set x11colours_i [lsearch -all $X11_colour_map $dec]
foreach ci $x11colours_i {
set c [lindex $X11_colour_map $ci-1]
if {$c ni $webcolours} {
lappend x11colours $c
}
}
foreach c $webcolours {
append info \n web-$c
}
foreach c $x11colours {
append info \n x11-$c
}
$t add_row [list $i "$info" $s [ansistring VIEW $s]]
}
default {
if {[string is integer -strict $i]} {
set rmap [lreverse $SGR_map]
$t add_row [list $i "SGR [dict get $rmap $i]" $s [ansistring VIEW $s]]
} else {
if {[dict exists $SGR_map $i]} {
$t add_row [list $i "SGR [dict get $SGR_map $i]" $s [ansistring VIEW $s]]
} else {
$t add_row [list $i UNKNOWN $s [ansistring VIEW $s]]
}
}
}
}
}
set ansi [a+ {*}$args]
set s ${ansi}sample
set merged [punk::ansi::codetype::sgr_merge_singles [list $ansi]]
set s2 ${merged}sample
#lappend resultlist "RESULT: [a+ {*}$args]sample[a]"
$t add_row [list RESULT "" $s [ansistring VIEW $s]]
if {$ansi ne $merged} {
if {[string length $merged] < [string length $ansi]} {
#only refer to redundancies if shorter - merge may reorder - REVIEW
set warning "[a+ web-red Web-yellow]REDUNDANCIES FOUND"
} else {
set warning ""
} }
$t add_row [list MERGED $warning $s2 [ansistring VIEW $s2]]
} }
set result [$t print]
$t destroy
return $result return $result
} }
} }
@ -1788,13 +2102,33 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set sgr_cache [dict create] set sgr_cache [dict create]
return "sgr_cache cleared" return "sgr_cache cleared"
} }
if {[catch {
set termwidth [dict get [punk::console::get_size] columns]
} errM]} {
set termwidth 80
}
set termwidth [expr [$termwidth -3]]
set out "" set out ""
set linelen 0
set RST [a] set RST [a]
set lines [list]
set line ""
#todo - terminal width? table? #todo - terminal width? table?
dict for {key ansi} $sgr_cache { dict for {key ansi} $sgr_cache {
append out "$ansi$key$RST " set thislen [expr {[string length $key]+1}]
if {$linelen + $thislen >= $termwidth-1} {
lappend lines $line
set line "$ansi$key$RST "
set linelen $thislen
} else {
append line "$ansi$key$RST "
incr linelen $thislen
}
} }
return $out\n if {[string length $line]} {
lappend lines $line
}
return [join $lines \n]
} }
proc a+ {args} { proc a+ {args} {
@ -1922,7 +2256,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
switch -- $i { switch -- $i {
Brightblack {lappend t 100} Brightblack {lappend t 100}
Brightred {lappend t 101} Brightred {lappend t 101}
Brightgreen {lappend t 101} Brightgreen {lappend t 102}
Brightyellow {lappend t 103} Brightyellow {lappend t 103}
Brightblue {lappend t 104} Brightblue {lappend t 104}
Brightpurple {lappend t 105} Brightpurple {lappend t 105}
@ -2154,7 +2488,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
switch -- $i { switch -- $i {
Brightblack {lappend t 100} Brightblack {lappend t 100}
Brightred {lappend t 101} Brightred {lappend t 101}
Brightgreen {lappend t 101} Brightgreen {lappend t 102}
Brightyellow {lappend t 103} Brightyellow {lappend t 103}
Brightblue {lappend t 104} Brightblue {lappend t 104}
Brightpurple {lappend t 105} Brightpurple {lappend t 105}
@ -2953,10 +3287,11 @@ namespace eval punk::ansi {
set defaults [dict create\ set defaults [dict create\
-filter_fg 0\ -filter_fg 0\
-filter_bg 0\ -filter_bg 0\
-filter_reset 0\
] ]
dict for {k v} $args { dict for {k v} $args {
switch -- $k { switch -- $k {
-filter_fg - -filter_bg {} -filter_fg - -filter_bg - -filter_reset {}
default { default {
error "sgr_merge unknown option '$k'. Known options [dict keys $defaults]" error "sgr_merge unknown option '$k'. Known options [dict keys $defaults]"
} }
@ -3015,8 +3350,10 @@ namespace eval punk::ansi {
set codeint [string trimleft [lindex $paramsplit 0] 0] set codeint [string trimleft [lindex $paramsplit 0] 0]
switch -- $codeint { switch -- $codeint {
"" - 0 { "" - 0 {
set codestate $codestate_initial if {![dict get $opts -filter_reset]} {
set did_reset 1 set codestate $codestate_initial
set did_reset 1
}
} }
1 { 1 {
#bold #bold
@ -3086,7 +3423,7 @@ namespace eval punk::ansi {
} }
21 { 21 {
#ECMA-48 double underline - some terminals use as not-bold. For now we won't support that. #ECMA-48 double underline - some terminals use as not-bold. For now we won't support that.
dict set doubleunderline 21 dict set codestate doubleunderline 21
} }
22 { 22 {
#normal intensity #normal intensity
@ -4866,9 +5203,12 @@ namespace eval punk::ansi::ansistring {
if {$opt_cr} { if {$opt_cr} {
dict set visuals_opt CR [list \x0d \u240d] dict set visuals_opt CR [list \x0d \u240d]
} }
if {$opt_lf} { if {$opt_lf == 1} {
dict set visuals_opt LF [list \x0a \u240a] dict set visuals_opt LF [list \x0a \u240a]
} }
if {$opt_lf == 2} {
dict set visuals_opt LF [list \x0a \u240a\n]
}
if {$opt_vt} { if {$opt_vt} {
dict set visuals_opt VT [list \x0b \u240b] dict set visuals_opt VT [list \x0b \u240b]
} }

4
src/modules/punk/basictelnet-999999.0a1.0.tm

@ -528,7 +528,7 @@ namespace eval punk::basictelnet {
# -- --- --- --- # -- --- --- ---
set tailinfo "" set tailinfo ""
if {[string length $nextwaiting]} { if {[string length $nextwaiting]} {
set waitingdisplay [overtype::left -wrap 1 -width 77 -height 1 "" [ansistring VIEW -lf 1 -vt 1 $nextwaiting]] set waitingdisplay [overtype::renderspace -wrap 1 -width 77 -height 1 "" [ansistring VIEW -lf 1 -vt 1 $nextwaiting]]
set tailinfo "[a+ red]from waiting:\n $waitingdisplay[a]" set tailinfo "[a+ red]from waiting:\n $waitingdisplay[a]"
} }
::punk::basictelnet::add_debug "[a+ Yellow black]from stdin sending: [ansistring VIEW -lf 1 -vt 1 $chunk][a]\n$tailinfo\n" stdin $sock ::punk::basictelnet::add_debug "[a+ Yellow black]from stdin sending: [ansistring VIEW -lf 1 -vt 1 $chunk][a]\n$tailinfo\n" stdin $sock
@ -626,7 +626,7 @@ namespace eval punk::basictelnet {
#set rawview [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom $encoding_guess $data]] #set rawview [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom $encoding_guess $data]]
set rawview [ansistring VIEW -lf 1 -vt 1 $data] set rawview [ansistring VIEW -lf 1 -vt 1 $data]
#set viewblock [overtype::left -wrap 1 -width 78 -height 4 "" $rawview] #set viewblock [overtype::left -wrap 1 -width 78 -height 4 "" $rawview]
set viewblock [overtype::left -experimental test_mode -wrap 1 -width 78 -height 4 "" $rawview] set viewblock [overtype::renderspace -experimental test_mode -wrap 1 -width 78 -height 4 "" $rawview]
set lines [split $viewblock \n] set lines [split $viewblock \n]
if {[llength $lines] > 4} { if {[llength $lines] > 4} {
append debug_info [join [list {*}[lrange $lines 0 1] "...<[expr {[llength $lines] -4}] lines undisplayed>..." {*}[lrange $lines end-1 end]] \n] append debug_info [join [list {*}[lrange $lines 0 1] "...<[expr {[llength $lines] -4}] lines undisplayed>..." {*}[lrange $lines end-1 end]] \n]

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

@ -658,6 +658,7 @@ proc repl::start {inchan args} {
variable editbuf variable editbuf
variable editbuf_list ;#command history variable editbuf_list ;#command history
variable editbuf_linenum_submitted variable editbuf_linenum_submitted
variable editbuf_active_index
# --- # ---
variable running variable running
@ -681,6 +682,7 @@ proc repl::start {inchan args} {
set editbuf [punk::repl::class::class_editbuf new {}] set editbuf [punk::repl::class::class_editbuf new {}]
lappend editbuf_list $editbuf ;#current editbuf is always in the history lappend editbuf_list $editbuf ;#current editbuf is always in the history
set editbuf_linenum_submitted 0 set editbuf_linenum_submitted 0
set editbuf_active_index 0
# --- # ---
if {$::punk::console::ansi_wanted == 2} { if {$::punk::console::ansi_wanted == 2} {
@ -1050,6 +1052,11 @@ namespace eval repl {
} }
namespace eval punk::repl::class { namespace eval punk::repl::class {
oo::class create class_bufman {
}
#multiline editing buffer #multiline editing buffer
oo::class create class_editbuf { oo::class create class_editbuf {
variable o_context variable o_context
@ -1157,7 +1164,7 @@ namespace eval punk::repl::class {
append debug \n $mergedinfo append debug \n $mergedinfo
append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $result_row before col:$o_cursor_col after col:$result_col" append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $result_row before col:$o_cursor_col after col:$result_col"
package require textblock package require textblock
set debug [textblock::frame $debug] set debug [textblock::frame -buildcache 0 $debug]
catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} catch {punk::console::move_emitblock_return $debug_first_row 1 $debug}
# -- --- --- --- --- --- # -- --- --- --- --- ---
@ -1222,7 +1229,7 @@ namespace eval punk::repl::class {
append debug \n $mergedinfo append debug \n $mergedinfo
append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $p]" append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $p]"
package require textblock package require textblock
set debug [textblock::frame $debug] set debug [textblock::frame -buildcache 0 $debug]
#catch {punk::console::move_emitblock_return [expr {$debug_first_row + ($i * 6)}] 1 $debug} #catch {punk::console::move_emitblock_return [expr {$debug_first_row + ($i * 6)}] 1 $debug}
set result [dict get $mergedinfo result] set result [dict get $mergedinfo result]
@ -1682,9 +1689,14 @@ proc repl::repl_handler {inputchan prompt_config} {
} }
set in_repl_handler [list] set in_repl_handler [list]
} }
proc repl::editbuf {args} { proc repl::editbuf {index args} {
variable editbuf variable editbuf_list
$editbuf {*}$args set editbuf [lindex $editbuf_list $index]
if {$editbuf ne ""} {
$editbuf {*}$args
} else {
return "No such index in editbuf list"
}
} }
interp alias {} editbuf {} ::repl::editbuf interp alias {} editbuf {} ::repl::editbuf
proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
@ -1873,11 +1885,11 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
set info [list_as_lines $lines] set info [list_as_lines $lines]
} }
} errM]} { } errM]} {
set info [textblock::frame -title "[a red]error[a]" $errM] set info [textblock::frame -buildcache 0 -title "[a red]error[a]" $errM]
} else { } else {
set info [textblock::frame -ansiborder [a+ green bold] -title "[a cyan]debugview_raw[a]" $info] set info [textblock::frame -buildcache 0 -ansiborder [a+ green bold] -title "[a cyan]debugview_raw[a]" $info]
} }
set debug_width [textblock::width $info] set debug_width [textblock::widthtopline $info]
set spacepatch [textblock::block $debug_width 2 " "] set spacepatch [textblock::block $debug_width 2 " "]
puts -nonewline [punk::ansi::cursor_off] puts -nonewline [punk::ansi::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.
@ -1895,16 +1907,16 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
set info [list_as_lines $lines] set info [list_as_lines $lines]
} }
} editbuf_error]} { } editbuf_error]} {
set info [textblock::frame -title "[a red]error[a]" "$editbuf_error\n$::errorInfo"] set info [textblock::frame -buildcache 0 -title "[a red]error[a]" "$editbuf_error\n$::errorInfo"]
} else { } else {
set title "[a cyan]editbuf lines [$editbuf linecount][a]" set title "[a cyan]editbuf [expr {[llength $editbuf_list]-1}] lines [$editbuf linecount][a]"
append title "[a+ yellow bold] col:[format %3s [$editbuf cursor_column]] row:[$editbuf cursor_row][a]" append title "[a+ yellow bold] col:[format %3s [$editbuf cursor_column]] row:[$editbuf cursor_row][a]"
set row1 " lastchar:[ansistring VIEW -lf 1 [$editbuf last_char]] lastgrapheme:[ansistring VIEW -lf 1 [$editbuf last_grapheme]]" set row1 " lastchar:[ansistring VIEW -lf 1 [$editbuf last_char]] lastgrapheme:[ansistring VIEW -lf 1 [$editbuf last_grapheme]]"
set row2 " lastansi:[ansistring VIEW -lf 1 [$editbuf last_ansi]]" set row2 " lastansi:[ansistring VIEW -lf 1 [$editbuf last_ansi]]"
set info [a+ green bold]$row1\n$row2[a]\n$info set info [a+ green bold]$row1\n$row2[a]\n$info
set info [textblock::frame -ansiborder [a+ green bold] -title $title $info] set info [textblock::frame -buildcache 0 -ansiborder [a+ green bold] -title $title $info]
} }
set editbuf_width [textblock::width $info] set editbuf_width [textblock::widthtopline $info]
set spacepatch [textblock::block $editbuf_width 2 " "] set spacepatch [textblock::block $editbuf_width 2 " "]
set editbuf_offset [expr {$consolewidth - $debug_width - $editbuf_width - 2}] set editbuf_offset [expr {$consolewidth - $debug_width - $editbuf_width - 2}]
@ -2475,7 +2487,19 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
set commandstr "" set commandstr ""
#catch {puts stderr "zz2---->[rep $::arglej]"} #catch {puts stderr "zz2---->[rep $::arglej]"}
set lines [$editbuf lines]
set buf_has_data 0
foreach ln $lines {
if {[string trim $ln] ne ""} {
set buf_has_data 1
}
}
if {$buf_has_data} {
set editbufnext [punk::repl::class::class_editbuf new {}]
lappend editbuf_list $editbufnext
set editbuf_linenum_submitted 0
set editbuf $editbufnext
}
#editbuf #editbuf
} else { } else {

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

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save