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

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

master
Julian Noble 6 months ago
parent
e9644754a3
commit
7fd49bb2e2
5 changed files with 1107 additions and 509 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  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
Unescape View File

@ -2,13 +2,13 @@
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1.1
set version 0.1.2
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
#variable o_alias
constructor {} {
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?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} 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 {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
#review - what is the point of alias anyway? - why slow down other operations when a variable can hold a keyname perfectly well?
#method alias {newAlias existingKeyOrAlias} {
# if {[string is integer -strict $newAlias]} {
# error "[self object] collection key alias cannot be integer"
# }
# if {[string length $existingKeyOrAlias]} {
# set o_alias($newAlias) $existingKeyOrAlias
# } else {
# unset o_alias($newAlias)
# }
#}
#method aliases {{key ""}} {
# if {[string length $key]} {
# set result [list]
# foreach {n v} [array get o_alias] {
# if {$v eq $key} {
# lappend result $n $v
# }
# }
# return $result
# } 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 {[catch {set o_alias($idx)} key]} {
# return $idx
# } else {
# return $key
# }
#}
method add {value key} {
if {[string is integer -strict $key]} {
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
Unescape View File

@ -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 effectively auto-expands the block(terminal?) width
#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 dimensions changed - the checksum won't have been done
set o_rendered_what [$o_ansistringobj checksum]
@ -129,7 +129,7 @@ namespace eval punk::ansi::class {
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
}
method render_to_input_line {args} {
@ -175,7 +175,7 @@ namespace eval punk::ansi::class {
if {$opt_minus ne "0"} {
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 ""
for {set i 1} {$i <= $w} {incr i} {
if {$i % 10 == 0} {
@ -190,13 +190,13 @@ namespace eval punk::ansi::class {
set xline [lindex $rlines $x]\n
set xlinev [ansistring VIEWSTYLE $xline]
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
set chunk [ansistring VIEWSTYLE $chunk]
set chunk [string map $maplf $chunk]
#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 chunkdisplay_lines [split $chunkdisplay \n]
set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end]
@ -215,14 +215,87 @@ namespace eval punk::ansi::class {
method viewlines {} {
return [ansistring VIEW [$o_ansistringobj get]]
}
method viewcodes {} {
return [ansistring VIEWCODES [$o_ansistringobj get]]
method viewcodes {args} {
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 {} {
return [punk::ansi::stripansiraw [$o_ansistringobj get]]
method viewchars {args} {
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 {} {
return [ansistring VIEWSTYLE [$o_ansistringobj get]]
method viewstyle {args} {
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} {
$o_ansistringobj append $ansistring
@ -456,7 +529,7 @@ namespace eval punk::ansi {
set ansidata [fcat -encoding $encoding $fname]
set obj [punk::ansi::class::class_ansi new $ansidata]
if {$test_mode} {
if {$encoding eq "cp437"} {
set result [$obj rendertest $dimensions]
} else {
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]ie instead of a horizontal line you may see: qqqqqq
join [::punk::ansi::ta::split_at_codes $text] ""
}
proc stripansi1 {text} {
@ -1061,7 +1133,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
dodgerblue2\
green4\
springgreen4\
turquise4\
turquoise4\
deepskyblue3\
deepskyblue3\
dodgerblue1\
@ -1459,7 +1531,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append out [a]
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 ""
#use the reverse lookup dict - the original xterm_names list has duplicates - we want the disambiguated (potentially suffixed) names
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
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
if {[llength $row]== 8} {
if {[llength $row]== $cols} {
lappend rows $row
set row [list]
}
@ -1492,6 +1566,112 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append out [a]
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
proc colourblock_24 {} {
set out ""
@ -1548,7 +1728,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# $WEB_colour_map_gray\
#]
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 {
"" - * {
set show_groups $all_groupnames
@ -1696,7 +1877,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set map2 [colourmap2 $bgname]
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 "[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 "[a+ web-white]24 Greyscale colours[a]" \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
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 "Examine a sequence: a? bold rgb-46-139-87 Rgb#C71585 "] \n
append out \n
append out "[a+ web-white]Web colours[a]" \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 {
switch -- [lindex $args 0] {
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"
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]
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
}
web {
@ -1748,20 +1952,130 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
return $out
}
}
set result [list]
set map [dict merge $SGR_setting_map $SGR_colour_map]
set rmap [lreverse $map]
variable WEB_colour_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 {
if {[string is integer -strict $i]} {
if {[dict exists $rmap $i]} {
lappend result $i [dict get $rmap $i]
set f4 [string range $i 0 3]
set s [a+ $i]sample
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 {
if {[dict exists $map $i]} {
lappend result $i [dict get $map $i]
term - Term {
set tail [string trim [string range $i 4 end] -]
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
}
}
@ -1788,13 +2102,33 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set sgr_cache [dict create]
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 linelen 0
set RST [a]
set lines [list]
set line ""
#todo - terminal width? table?
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} {
@ -1922,7 +2256,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
switch -- $i {
Brightblack {lappend t 100}
Brightred {lappend t 101}
Brightgreen {lappend t 101}
Brightgreen {lappend t 102}
Brightyellow {lappend t 103}
Brightblue {lappend t 104}
Brightpurple {lappend t 105}
@ -2154,7 +2488,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
switch -- $i {
Brightblack {lappend t 100}
Brightred {lappend t 101}
Brightgreen {lappend t 101}
Brightgreen {lappend t 102}
Brightyellow {lappend t 103}
Brightblue {lappend t 104}
Brightpurple {lappend t 105}
@ -2953,10 +3287,11 @@ namespace eval punk::ansi {
set defaults [dict create\
-filter_fg 0\
-filter_bg 0\
-filter_reset 0\
]
dict for {k v} $args {
switch -- $k {
-filter_fg - -filter_bg {}
-filter_fg - -filter_bg - -filter_reset {}
default {
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]
switch -- $codeint {
"" - 0 {
set codestate $codestate_initial
set did_reset 1
if {![dict get $opts -filter_reset]} {
set codestate $codestate_initial
set did_reset 1
}
}
1 {
#bold
@ -3086,7 +3423,7 @@ namespace eval punk::ansi {
}
21 {
#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 {
#normal intensity
@ -4866,9 +5203,12 @@ namespace eval punk::ansi::ansistring {
if {$opt_cr} {
dict set visuals_opt CR [list \x0d \u240d]
}
if {$opt_lf} {
if {$opt_lf == 1} {
dict set visuals_opt LF [list \x0a \u240a]
}
if {$opt_lf == 2} {
dict set visuals_opt LF [list \x0a \u240a\n]
}
if {$opt_vt} {
dict set visuals_opt VT [list \x0b \u240b]
}

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

@ -528,7 +528,7 @@ namespace eval punk::basictelnet {
# -- --- --- ---
set tailinfo ""
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]"
}
::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 $data]
#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]
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]

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

@ -658,6 +658,7 @@ proc repl::start {inchan args} {
variable editbuf
variable editbuf_list ;#command history
variable editbuf_linenum_submitted
variable editbuf_active_index
# ---
variable running
@ -681,6 +682,7 @@ proc repl::start {inchan args} {
set editbuf [punk::repl::class::class_editbuf new {}]
lappend editbuf_list $editbuf ;#current editbuf is always in the history
set editbuf_linenum_submitted 0
set editbuf_active_index 0
# ---
if {$::punk::console::ansi_wanted == 2} {
@ -1050,6 +1052,11 @@ namespace eval repl {
}
namespace eval punk::repl::class {
oo::class create class_bufman {
}
#multiline editing buffer
oo::class create class_editbuf {
variable o_context
@ -1157,7 +1164,7 @@ namespace eval punk::repl::class {
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"
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}
# -- --- --- --- --- ---
@ -1222,7 +1229,7 @@ namespace eval punk::repl::class {
append debug \n $mergedinfo
append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $p]"
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}
set result [dict get $mergedinfo result]
@ -1682,9 +1689,14 @@ proc repl::repl_handler {inputchan prompt_config} {
}
set in_repl_handler [list]
}
proc repl::editbuf {args} {
variable editbuf
$editbuf {*}$args
proc repl::editbuf {index args} {
variable editbuf_list
set editbuf [lindex $editbuf_list $index]
if {$editbuf ne ""} {
$editbuf {*}$args
} else {
return "No such index in editbuf list"
}
}
interp alias {} editbuf {} ::repl::editbuf
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]
}
} errM]} {
set info [textblock::frame -title "[a red]error[a]" $errM]
set info [textblock::frame -buildcache 0 -title "[a red]error[a]" $errM]
} 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 " "]
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.
@ -1895,16 +1907,16 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
set info [list_as_lines $lines]
}
} 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 {
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]"
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 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 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 ""
#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
} else {

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

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