|
|
|
|
@ -129,6 +129,17 @@ namespace eval punk::console {
|
|
|
|
|
#e.g external utils system API's. |
|
|
|
|
namespace export * |
|
|
|
|
} |
|
|
|
|
namespace eval argdoc { |
|
|
|
|
variable PUNKARGS |
|
|
|
|
#non-colour SGR codes |
|
|
|
|
set I "\x1b\[3m" ;# [a+ italic] |
|
|
|
|
set NI "\x1b\[23m" ;# [a+ noitalic] |
|
|
|
|
set B "\x1b\[1m" ;# [a+ bold] |
|
|
|
|
set N "\x1b\[22m" ;# [a+ normal] |
|
|
|
|
set T "\x1b\[1\;4m" ;# [a+ bold underline] |
|
|
|
|
set NT "\x1b\[22\;24m\x1b\[4:0m" ;# [a+ normal nounderline] |
|
|
|
|
interp alias "" ::overtype::example "" ::punk::args::helpers::example |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
if {"windows" eq $::tcl_platform(platform)} { |
|
|
|
|
#accept args for all dummy/load functions so we don't have to match/update argument signatures here |
|
|
|
|
@ -1236,7 +1247,7 @@ namespace eval punk::console {
|
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
if {$onoff} { |
|
|
|
|
unset_mode DECANM |
|
|
|
|
dec_unset_mode DECANM |
|
|
|
|
set is_vt52 1 |
|
|
|
|
colour off |
|
|
|
|
} else { |
|
|
|
|
@ -1708,55 +1719,218 @@ namespace eval punk::console {
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} { |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc dec_get_mode_line_wrap {{inoutchannels {stdin stdout}}} { |
|
|
|
|
set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[?7\$p" |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] |
|
|
|
|
return $payload |
|
|
|
|
} |
|
|
|
|
#Terminals generally default to LNM being reset (off) ie enter key sends a lone <cr> |
|
|
|
|
#Terminals tested on windows either don't respond to this query, or respond with 0 (meaning mode not understood) |
|
|
|
|
#I presume from this that almost nobody is using LNM 1 (which sends both <cr> and <lf>) |
|
|
|
|
proc get_mode_LNM {{inoutchannels {stdin stdout}}} { |
|
|
|
|
set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[?20\$p" |
|
|
|
|
#windows terminal defaults to LNM on, but wezterm on windows default to LNM off |
|
|
|
|
#LNM on sends both <cr> and <lf> ?? |
|
|
|
|
proc ansi_get_mode_LNM {{inoutchannels {stdin stdout}}} { |
|
|
|
|
set capturingregex {(.*)(\x1b\[20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[20\$p" |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] |
|
|
|
|
return $payload |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::dec_get_mode |
|
|
|
|
@cmd -name punk::console::dec_get_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Get DEC mode}\ |
|
|
|
|
-help\ |
|
|
|
|
{Get DEC mode by sending to the console |
|
|
|
|
the sequence: |
|
|
|
|
ESC [ ? <code> $ p |
|
|
|
|
Where <code> is an integer |
|
|
|
|
formed from the supplied ${$I}mode${$NI} value. |
|
|
|
|
|
|
|
|
|
The terminal should respond with a sequence of the form: |
|
|
|
|
ESC [ ? <code> ; <s> $ y |
|
|
|
|
where <s> is one of the statuses: |
|
|
|
|
0 - mode not recognised |
|
|
|
|
1 - mode is set |
|
|
|
|
2 - mode is unset |
|
|
|
|
3 - mode is permanently set |
|
|
|
|
4 - mode is permanently unset |
|
|
|
|
|
|
|
|
|
The response is automatically retrieved from the terminal |
|
|
|
|
and so should not be displayed unless there is such a |
|
|
|
|
significant delay that the request times out. |
|
|
|
|
|
|
|
|
|
The value of <s> is returned by the dec_get_mode function. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
@values -min 1 -max 1 |
|
|
|
|
mode -type {int|string} -multiple 0 -help\ |
|
|
|
|
"integer for DEC mode, or name as in the dict: |
|
|
|
|
::punk::ansi::decmode_names |
|
|
|
|
See also the command: ${$B}dec_modes${$N}" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
#DECRPM responses e.g: |
|
|
|
|
# \x1b\[?7\;1\$y |
|
|
|
|
# \x1b\[?7\;2\$y |
|
|
|
|
#where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) |
|
|
|
|
proc get_mode {num_or_name {inoutchannels {stdin stdout}}} { |
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
proc dec_get_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::dec_get_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
set mode [dict get $values mode] |
|
|
|
|
|
|
|
|
|
if {[string is integer -strict $mode]} { |
|
|
|
|
set m $mode |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::decmode_names decmode_names |
|
|
|
|
if {[dict exists $decmode_names $num_or_name]} { |
|
|
|
|
set m [dict get $decmode_names $num_or_name] |
|
|
|
|
if {[dict exists $decmode_names $mode]} { |
|
|
|
|
set m [dict get $decmode_names $mode] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
error "punk::console::dec_get_mode unrecognised mode '$mode'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[?$m\$p" |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $terminal $request $capturingregex] |
|
|
|
|
return $payload |
|
|
|
|
} |
|
|
|
|
proc set_mode {num_or_name {inoutchannels {stdin stdout}}} { |
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::decmode_names decmode_names |
|
|
|
|
if {[dict exists $decmode_names $num_or_name]} { |
|
|
|
|
set m [dict get $decmode_names $num_or_name] |
|
|
|
|
|
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::dec_set_mode |
|
|
|
|
@cmd -name punk::console::dec_set_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Set DEC mode(s) (DECSET)}\ |
|
|
|
|
-help\ |
|
|
|
|
{Set DEC mode(s) by sending to the console |
|
|
|
|
the DECSET sequence: |
|
|
|
|
ESC [ ? <codes> h |
|
|
|
|
Where <codes> is a colon delimited set of integers |
|
|
|
|
formed from the supplied ${$I}mode${$NI} values. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
@values -min 1 -max -1 |
|
|
|
|
mode -type {int|string} -multiple 1 -help\ |
|
|
|
|
"integer for DEC mode, or name as in the dict: |
|
|
|
|
::punk::ansi::decmode_names |
|
|
|
|
See also the command: ${$B}dec_modes${$N}" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
#todo - should accept multiple mode nums/names at once |
|
|
|
|
proc dec_set_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::dec_set_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
set modes [dict get $values mode] ;#multiple |
|
|
|
|
|
|
|
|
|
set modelist [list] |
|
|
|
|
foreach num_or_name $modes { |
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::decmode_names decmode_names |
|
|
|
|
if {[dict exists $decmode_names $num_or_name]} { |
|
|
|
|
set m [dict get $decmode_names $num_or_name] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::dec_set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
lappend modelist $m |
|
|
|
|
} |
|
|
|
|
set modes_string [join $modelist {;}] |
|
|
|
|
set term_out [lindex $terminal 1] |
|
|
|
|
puts -nonewline $term_out "\x1b\[?${modes_string}h" |
|
|
|
|
} |
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::dec_unset_mode |
|
|
|
|
@cmd -name punk::console::dec_unset_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Unset DEC mode(s) (DECRST)}\ |
|
|
|
|
-help\ |
|
|
|
|
{Unset DEC mode(s) by sending to the console |
|
|
|
|
the DECRST sequence: |
|
|
|
|
ESC [ ? <codes> l |
|
|
|
|
Where <codes> is a colon delimited set of integers |
|
|
|
|
formed from the supplied ${$I}mode${$NI} values. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
@values -min 1 -max -1 |
|
|
|
|
mode -type {int|string} -multiple 1 -help\ |
|
|
|
|
"integer for DEC mode, or name as in the dict: |
|
|
|
|
::punk::ansi::decmode_names |
|
|
|
|
See also the command: ${$B}dec_modes${$N}" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
proc dec_unset_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::dec_unset_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
set modes [dict get $values mode] ;#multiple |
|
|
|
|
|
|
|
|
|
set modelist [list] |
|
|
|
|
foreach num_or_name $modes { |
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
upvar ::punk::ansi::decmode_names decmode_names |
|
|
|
|
if {[dict exists $decmode_names $num_or_name]} { |
|
|
|
|
set m [dict get $decmode_names $num_or_name] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::dec_unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
lappend modelist $m |
|
|
|
|
} |
|
|
|
|
puts -nonewline "\x1b\[?${m}h" |
|
|
|
|
set modes_string [join $modelist {;}] |
|
|
|
|
set term_out [lindex $terminal 1] |
|
|
|
|
puts -nonewline $term_out "\x1b\[?${modes_string}l" |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
variable dec_has_mode_cache |
|
|
|
|
set dec_has_mode_cache [dict create] |
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::dec_has_mode |
|
|
|
|
@cmd -name punk::console::dec_has_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Check if console supports a particular DEC mode}\ |
|
|
|
|
-help\ |
|
|
|
|
{Check if console supports a particular DEC mode by emitting query to the console using |
|
|
|
|
the sequence: |
|
|
|
|
ESC [ ? <n> $ p |
|
|
|
|
Where <n> is an integer identifier. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
-refresh -type none |
|
|
|
|
@values -min 1 -max 1 |
|
|
|
|
mode -type {int|string} -help\ |
|
|
|
|
"integer for DEC mode, or name as in the dict: |
|
|
|
|
::punk::ansi::decmode_names" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
proc unset_mode {num_or_name {inoutchannels {stdin stdout}}} { |
|
|
|
|
proc dec_has_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::dec_has_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values received |
|
|
|
|
set console [dict get $opts -console] |
|
|
|
|
set num_or_name [dict get $values mode] |
|
|
|
|
if {[dict exists $received -refresh]} { |
|
|
|
|
set do_refresh 1 |
|
|
|
|
} else { |
|
|
|
|
set do_refresh 0 |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
@ -1764,35 +1938,135 @@ namespace eval punk::console {
|
|
|
|
|
if {[dict exists $decmode_names $num_or_name]} { |
|
|
|
|
set m [dict get $decmode_names $num_or_name] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
error "punk::console::dec_get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
puts -nonewline "\x1b\[?${m}l" |
|
|
|
|
variable dec_has_mode_cache |
|
|
|
|
if {$do_refresh} { |
|
|
|
|
if {[dict exists $dec_has_mode_cache $console $m]} { |
|
|
|
|
dict unset dec_has_mode_cache $console $m |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
if {![dict exists $dec_has_mode_cache $console $m]} { |
|
|
|
|
set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[?$m\$p" |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] |
|
|
|
|
set has_mode [expr {$payload != 0}] |
|
|
|
|
dict set dec_has_mode_cache $console $m $has_mode |
|
|
|
|
} else { |
|
|
|
|
set has_mode [dict get $dec_has_mode_cache $console $m] |
|
|
|
|
} |
|
|
|
|
return $has_mode |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
variable has_mode_cache |
|
|
|
|
set has_mode_cache [dict create] |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::has_mode |
|
|
|
|
@cmd -name punk::console::has_mode\ |
|
|
|
|
@id -id ::punk::console::dec_modes |
|
|
|
|
@cmd -name punk::console::dec_modes\ |
|
|
|
|
-summary\ |
|
|
|
|
{Check if console supports DEC mode}\ |
|
|
|
|
{Show table of DEC modes}\ |
|
|
|
|
-help\ |
|
|
|
|
{Check if console supports DEC mode by emitting query to the console using |
|
|
|
|
the sequence: |
|
|
|
|
ESC [ ? <n> $ p |
|
|
|
|
Where <n> is an integer identifier. |
|
|
|
|
} |
|
|
|
|
{Show table of DEC modes with basic information.} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
-refresh -type none |
|
|
|
|
@values -min 1 -max 1 |
|
|
|
|
mode -type {int|string} -help\ |
|
|
|
|
"integer for DEC mode, or name as in the dict: |
|
|
|
|
::punk::ansi::decmode_names" |
|
|
|
|
-test -type none -help\ |
|
|
|
|
"Test current value/support for each mode" |
|
|
|
|
@values -min 0 -max 0 |
|
|
|
|
}] |
|
|
|
|
proc has_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::has_mode] |
|
|
|
|
proc dec_modes {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::dec_modes] |
|
|
|
|
lassign [dict values $argd] leaders opts values received |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
if {[dict exists $received -test]} { |
|
|
|
|
set do_test 1 |
|
|
|
|
} else { |
|
|
|
|
set do_test 0 |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
upvar ::punk::ansi::decmode_data decmode_data |
|
|
|
|
set t [textblock::class::table new "Dec Modes"] |
|
|
|
|
$t configure -show_header 1 -show_hseps 1 |
|
|
|
|
$t add_column -headers Code |
|
|
|
|
$t add_column -headers Names |
|
|
|
|
$t add_column -headers Origin |
|
|
|
|
$t add_column -headers Description |
|
|
|
|
if {$do_test} { |
|
|
|
|
$t add_column -headers Status |
|
|
|
|
} |
|
|
|
|
dict for {code items} $decmode_data { |
|
|
|
|
set colour "" |
|
|
|
|
set RST "" |
|
|
|
|
if {$do_test} { |
|
|
|
|
set testresult [dec_get_mode $code] |
|
|
|
|
switch -- $testresult { |
|
|
|
|
0 { |
|
|
|
|
set colour [punk::ansi::a+ red bold] |
|
|
|
|
} |
|
|
|
|
1 { |
|
|
|
|
set colour [punk::ansi::a+ green] |
|
|
|
|
} |
|
|
|
|
2 { |
|
|
|
|
set colour [punk::ansi::a+ yellow bold] |
|
|
|
|
} |
|
|
|
|
3 { |
|
|
|
|
set colour [punk::ansi::a+ green] |
|
|
|
|
} |
|
|
|
|
4 { |
|
|
|
|
set colour [punk::ansi::a+ yellow bold] |
|
|
|
|
} |
|
|
|
|
default { |
|
|
|
|
#unexpected |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {$colour ne ""} { |
|
|
|
|
set RST "\x1b\[m" |
|
|
|
|
} |
|
|
|
|
set testdisplay $colour$testresult$RST |
|
|
|
|
} |
|
|
|
|
foreach itm $items { |
|
|
|
|
set code $colour$code$RST |
|
|
|
|
set names $colour[dict get $itm names]$RST |
|
|
|
|
set origin [dict get $itm origin] |
|
|
|
|
set desc [dict get $itm description] |
|
|
|
|
set row [list $code [join $names \n] $origin $desc] |
|
|
|
|
if {$do_test} { |
|
|
|
|
lappend row $testdisplay |
|
|
|
|
} |
|
|
|
|
$t add_row $row |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
set out [$t print] |
|
|
|
|
$t destroy |
|
|
|
|
return $out |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
variable ansi_has_mode_cache |
|
|
|
|
set ansi_has_mode_cache [dict create] |
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::ansi_has_mode |
|
|
|
|
@cmd -name punk::console::ansi_has_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Check if console supports a particular ANSI mode}\ |
|
|
|
|
-help\ |
|
|
|
|
{Check if console supports a particular ANSI mode by emitting query to the console using |
|
|
|
|
the sequence: |
|
|
|
|
${$B}ESC [ <n> $ p${$N} |
|
|
|
|
Where ${$B}<n>${$N} is an integer identifier. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
#review - problem with 's ansi_has_mode' |
|
|
|
|
#-console -type list -typesynopsis {{${$I}inputchan${$NI} ${$I}outputchan${$NI}}} -minsize 2 -default {stdin stdout} |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
-refresh -type none |
|
|
|
|
@values -min 1 -max 1 |
|
|
|
|
mode -type {int|string} -help\ |
|
|
|
|
"integer for ANSI mode, or name as in the dict: |
|
|
|
|
::punk::ansi::ansimode_names" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
proc ansi_has_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::ansi_has_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values received |
|
|
|
|
set console [dict get $opts -console] |
|
|
|
|
set num_or_name [dict get $values mode] |
|
|
|
|
@ -1805,31 +2079,307 @@ namespace eval punk::console {
|
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::decmode_names decmode_names |
|
|
|
|
if {[dict exists $decmode_names $num_or_name]} { |
|
|
|
|
set m [dict get $decmode_names $num_or_name] |
|
|
|
|
upvar ::punk::ansi::ansimode_names ansimode_names |
|
|
|
|
if {[dict exists $ansimode_names $num_or_name]} { |
|
|
|
|
set m [dict get $ansimode_names $num_or_name] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" |
|
|
|
|
error "punk::console::ansi_has_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $ansimode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
variable has_mode_cache |
|
|
|
|
variable ansi_has_mode_cache |
|
|
|
|
if {$do_refresh} { |
|
|
|
|
if {[dict exists $has_mode_cache $console $m]} { |
|
|
|
|
dict unset has_mode_cache $console $m |
|
|
|
|
if {[dict exists $ansi_has_mode_cache $console $m]} { |
|
|
|
|
dict unset ansi_has_mode_cache $console $m |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
if {![dict exists $has_mode_cache $console $m]} { |
|
|
|
|
set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[?$m\$p" |
|
|
|
|
if {![dict exists $ansi_has_mode_cache $console $m]} { |
|
|
|
|
set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[$m\$p" |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] |
|
|
|
|
set has_mode [expr {$payload != 0}] |
|
|
|
|
dict set has_mode_cache $console $m $has_mode |
|
|
|
|
dict set ansi_has_mode_cache $console $m $has_mode |
|
|
|
|
} else { |
|
|
|
|
set has_mode [dict get $has_mode_cache $console $m] |
|
|
|
|
set has_mode [dict get $ansi_has_mode_cache $console $m] |
|
|
|
|
} |
|
|
|
|
return $has_mode |
|
|
|
|
} |
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::ansi_set_mode |
|
|
|
|
@cmd -name punk::console::ansi_set_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Set ANSI mode(s) (SM)}\ |
|
|
|
|
-help\ |
|
|
|
|
{Set ANSI mode(s) by sending to the console |
|
|
|
|
the SM sequence: |
|
|
|
|
ESC [ <codes> h |
|
|
|
|
Where <codes> is a colon delimited set of integers |
|
|
|
|
formed from the supplied ${$I}mode${$NI} values. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
@values -min 1 -max -1 |
|
|
|
|
mode -type {int|string} -multiple 1 -help\ |
|
|
|
|
"integer for ANSI mode, or name as in the dict: |
|
|
|
|
::punk::ansi::ansimode_names |
|
|
|
|
See also the command: ${$B}ansi_modes${$N}" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
proc ansi_set_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::ansi_set_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
set modes [dict get $values mode] ;#multiple |
|
|
|
|
|
|
|
|
|
set modelist [list] |
|
|
|
|
foreach num_or_name $modes { |
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::ansimode_names ansimode_names |
|
|
|
|
if {[dict exists $ansimode_names $num_or_name]} { |
|
|
|
|
set m [dict get $ansimode_names $num_or_name] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::ansi_set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $ansimode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
lappend modelist $m |
|
|
|
|
} |
|
|
|
|
set modes_string [join $modelist {;}] |
|
|
|
|
set term_out [lindex $terminal 1] |
|
|
|
|
puts -nonewline $term_out "\x1b\[${modes_string}h" |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::ansi_unset_mode |
|
|
|
|
@cmd -name punk::console::ansi_unset_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Unset ANSI mode(s) (RM)}\ |
|
|
|
|
-help\ |
|
|
|
|
{Unset ANSI mode(s) by sending to the console |
|
|
|
|
the RM sequence: |
|
|
|
|
ESC [ <codes> l |
|
|
|
|
Where <codes> is a colon delimited set of integers |
|
|
|
|
formed from the supplied ${$I}mode${$NI} values. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
@values -min 1 -max -1 |
|
|
|
|
mode -type {int|string} -multiple 1 -help\ |
|
|
|
|
"integer for ANSI mode, or name as in the dict: |
|
|
|
|
::punk::ansi::ansimode_names |
|
|
|
|
See also the command: ${$B}ansi_modes${$N}" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
proc ansi_unset_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::ansi_unset_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
set modes [dict get $values mode] ;#multiple |
|
|
|
|
|
|
|
|
|
set modelist [list] |
|
|
|
|
foreach num_or_name $modes { |
|
|
|
|
if {[string is integer -strict $num_or_name]} { |
|
|
|
|
set m $num_or_name |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::ansimode_names ansimode_names |
|
|
|
|
if {[dict exists $ansimode_names $num_or_name]} { |
|
|
|
|
set m [dict get $ansimode_names $num_or_name] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::ansi_unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $ansimode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
lappend modelist $m |
|
|
|
|
} |
|
|
|
|
set modes_string [join $modelist {;}] |
|
|
|
|
set term_out [lindex $terminal 1] |
|
|
|
|
puts -nonewline $term_out "\x1b\[${modes_string}l" |
|
|
|
|
} |
|
|
|
|
namespace eval argdoc { |
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::ansi_get_mode |
|
|
|
|
@cmd -name punk::console::ansi_get_mode\ |
|
|
|
|
-summary\ |
|
|
|
|
{Get ANSI mode}\ |
|
|
|
|
-help\ |
|
|
|
|
{Get ANSI mode by sending to the console |
|
|
|
|
the sequence: |
|
|
|
|
ESC [ <code> $ p |
|
|
|
|
Where <code> is an integer |
|
|
|
|
formed from the supplied ${$I}mode${$NI} value. |
|
|
|
|
|
|
|
|
|
The terminal should respond with a sequence of the form: |
|
|
|
|
ESC [ <code> ; <s> $ y |
|
|
|
|
where <s> is one of the statuses: |
|
|
|
|
0 - mode not recognised |
|
|
|
|
1 - mode is set |
|
|
|
|
2 - mode is unset |
|
|
|
|
3 - mode is permanently set |
|
|
|
|
4 - mode is permanently unset |
|
|
|
|
|
|
|
|
|
The response is automatically retrieved from the terminal |
|
|
|
|
and so should not be displayed unless there is such a |
|
|
|
|
significant delay that the request times out. |
|
|
|
|
|
|
|
|
|
The value of <s> is returned by the ansi_get_mode function. |
|
|
|
|
} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
@values -min 1 -max 1 |
|
|
|
|
mode -type {int|string} -multiple 0 -help\ |
|
|
|
|
"integer for ANSI mode, or name as in the dict: |
|
|
|
|
::punk::ansi::ansimode_names |
|
|
|
|
See also the command: ${$B}ansi_modes${$N}" |
|
|
|
|
}] |
|
|
|
|
} |
|
|
|
|
#DECRPM responses e.g: |
|
|
|
|
# \x1b\[12\;1\$y |
|
|
|
|
# \x1b\[?7\;2\$y |
|
|
|
|
#where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) |
|
|
|
|
proc ansi_get_mode {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::ansi_get_mode] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
set mode [dict get $values mode] |
|
|
|
|
|
|
|
|
|
if {[string is integer -strict $mode]} { |
|
|
|
|
set m $mode |
|
|
|
|
} else { |
|
|
|
|
upvar ::punk::ansi::ansimode_names ansimode_names |
|
|
|
|
if {[dict exists $ansimode_names $mode]} { |
|
|
|
|
set m [dict get $ansimode_names $mode] |
|
|
|
|
} else { |
|
|
|
|
error "punk::console::ansi_get_mode unrecognised mode '$mode'. Known mode names: [dict keys $ansimode_names]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload |
|
|
|
|
set request "\x1b\[$m\$p" |
|
|
|
|
set payload [punk::console::internal::get_ansi_response_payload -terminal $terminal $request $capturingregex] |
|
|
|
|
return $payload |
|
|
|
|
} |
|
|
|
|
#todo ansi_unset_mode |
|
|
|
|
|
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::ansi_modes |
|
|
|
|
@cmd -name punk::console::ansi_modes\ |
|
|
|
|
-summary\ |
|
|
|
|
{Show table of ANSI modes}\ |
|
|
|
|
-help\ |
|
|
|
|
{Show table of ANSI modes with basic information.} |
|
|
|
|
@opts |
|
|
|
|
-console -type list -minsize 2 -default {stdin stdout} |
|
|
|
|
-test -type none -help\ |
|
|
|
|
"Test current value/support for each mode" |
|
|
|
|
@values -min 0 -max -1 |
|
|
|
|
match -type indexset|string -multiple 1 -optional 1 |
|
|
|
|
}] |
|
|
|
|
proc ansi_modes {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::ansi_modes] |
|
|
|
|
lassign [dict values $argd] leaders opts values received |
|
|
|
|
set terminal [dict get $opts -console] |
|
|
|
|
if {[dict exists $received -test]} { |
|
|
|
|
set do_test 1 |
|
|
|
|
} else { |
|
|
|
|
set do_test 0 |
|
|
|
|
} |
|
|
|
|
if {[dict exists $values match]} { |
|
|
|
|
set matches [dict get $values match] |
|
|
|
|
} else { |
|
|
|
|
set matches {} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
upvar ::punk::ansi::ansimode_data ansimode_data |
|
|
|
|
upvar ::punk::ansi::ansimode_names ansimode_names |
|
|
|
|
|
|
|
|
|
set t [textblock::class::table new "ANSI Modes"] |
|
|
|
|
$t configure -show_header 1 -show_hseps 1 |
|
|
|
|
$t add_column -headers Code |
|
|
|
|
$t add_column -headers Names |
|
|
|
|
$t add_column -headers Origin |
|
|
|
|
$t add_column -headers Description |
|
|
|
|
$t add_column -headers set-state |
|
|
|
|
$t add_column -headers reset-state |
|
|
|
|
if {$do_test} { |
|
|
|
|
$t add_column -headers Status |
|
|
|
|
} |
|
|
|
|
set names [dict keys $ansimode_names] |
|
|
|
|
if {[llength $matches] == 0} { |
|
|
|
|
#show all entries |
|
|
|
|
set codes [dict keys $ansimode_data] |
|
|
|
|
} else { |
|
|
|
|
set codes [list] |
|
|
|
|
foreach m $matches { |
|
|
|
|
if {[punk::lib::is_indexset $m]} { |
|
|
|
|
lappend codes {*}[punk::lib::indexset_resolve -base 1 [dict size $ansimode_data] $m] |
|
|
|
|
} else { |
|
|
|
|
foreach nm $names { |
|
|
|
|
if {[string match -nocase $m $nm]} { |
|
|
|
|
lappend codes [dict get $ansimode_names $nm] |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#dict for {code items} $ansimode_data {} |
|
|
|
|
foreach code $codes { |
|
|
|
|
set items [dict get $ansimode_data $code] |
|
|
|
|
set colour "" |
|
|
|
|
set set_state_colour "" |
|
|
|
|
set reset_state_colour "" |
|
|
|
|
set RST "" |
|
|
|
|
if {$do_test} { |
|
|
|
|
set testresult [ansi_get_mode $code] |
|
|
|
|
switch -- $testresult { |
|
|
|
|
0 { |
|
|
|
|
set colour [punk::ansi::a+ red bold] |
|
|
|
|
} |
|
|
|
|
1 { |
|
|
|
|
set colour [punk::ansi::a+ green] |
|
|
|
|
set set_state_colour $colour |
|
|
|
|
} |
|
|
|
|
2 { |
|
|
|
|
set colour [punk::ansi::a+ yellow bold] |
|
|
|
|
set reset_state_colour $colour |
|
|
|
|
} |
|
|
|
|
3 { |
|
|
|
|
set colour [punk::ansi::a+ green] |
|
|
|
|
set set_state_colour $colour |
|
|
|
|
} |
|
|
|
|
4 { |
|
|
|
|
set colour [punk::ansi::a+ yellow bold] |
|
|
|
|
set reset_state_colour $colour |
|
|
|
|
} |
|
|
|
|
default { |
|
|
|
|
#unexpected |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {$colour ne ""} { |
|
|
|
|
set RST "\x1b\[m" |
|
|
|
|
} |
|
|
|
|
set testdisplay $colour$testresult$RST |
|
|
|
|
} |
|
|
|
|
foreach itm $items { |
|
|
|
|
set code $colour$code$RST |
|
|
|
|
set names $colour[dict get $itm names]$RST |
|
|
|
|
set origin [dict get $itm origin] |
|
|
|
|
set desc [dict get $itm description] |
|
|
|
|
set set_state $set_state_colour[dict get $itm set-state]$RST |
|
|
|
|
set reset_state $reset_state_colour[dict get $itm reset-state]$RST |
|
|
|
|
|
|
|
|
|
set row [list $code [join $names \n] $origin $desc $set_state $reset_state] |
|
|
|
|
if {$do_test} { |
|
|
|
|
lappend row $testdisplay |
|
|
|
|
} |
|
|
|
|
$t add_row $row |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
set out [$t print] |
|
|
|
|
$t destroy |
|
|
|
|
return $out |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
set DECRQSS_DATA { |
|
|
|
|
"Select Active Status Display" DECSASD "$\}" |
|
|
|
|
@ -1878,8 +2428,8 @@ namespace eval punk::console {
|
|
|
|
|
#(no leading DCS) - this |
|
|
|
|
|
|
|
|
|
lappend PUNKARGS [list { |
|
|
|
|
@id -id ::punk::console::request_dec_setting |
|
|
|
|
@cmd -name punk::console::request_dec_setting\ |
|
|
|
|
@id -id ::punk::console::dec_request_setting |
|
|
|
|
@cmd -name punk::console::dec_request_setting\ |
|
|
|
|
-summary\ |
|
|
|
|
{Perform DECRQSS query to get DECRPSS response}\ |
|
|
|
|
-help\ |
|
|
|
|
@ -1891,15 +2441,15 @@ namespace eval punk::console {
|
|
|
|
|
@values -min 1 -max 1 |
|
|
|
|
name -type string |
|
|
|
|
}] |
|
|
|
|
proc request_dec_setting {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::request_dec_setting] |
|
|
|
|
proc dec_request_setting {args} { |
|
|
|
|
set argd [punk::args::parse $args withid ::punk::console::dec_request_setting] |
|
|
|
|
lassign [dict values $argd] leaders opts values |
|
|
|
|
set console [dict get $opts -console] |
|
|
|
|
set name [dict get $values name] |
|
|
|
|
|
|
|
|
|
variable DECRQSS_DICT |
|
|
|
|
if {![dict exists $DECRQSS_DICT $name]} { |
|
|
|
|
error "request_dec_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" |
|
|
|
|
error "dec_request_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" |
|
|
|
|
} |
|
|
|
|
set str [dict get $DECRQSS_DICT $name] |
|
|
|
|
set re_str [string map [list * \\* \$ \\\$ + \\+ ( \\(] $str] ;#regex escaped |
|
|
|
|
@ -1911,12 +2461,12 @@ namespace eval punk::console {
|
|
|
|
|
set c1 [string index $payload 0] |
|
|
|
|
switch -- $c1 { |
|
|
|
|
0 { |
|
|
|
|
error "request_dec_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" |
|
|
|
|
error "dec_request_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" |
|
|
|
|
} |
|
|
|
|
1 {} |
|
|
|
|
default { |
|
|
|
|
#shouldn't get here |
|
|
|
|
error "request_dec_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" |
|
|
|
|
error "dec_request_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
#strip leading 1$r |
|
|
|
|
@ -2091,8 +2641,7 @@ namespace eval punk::console {
|
|
|
|
|
|
|
|
|
|
if {[info exists ::env(TERM_PROGRAM)]} { |
|
|
|
|
#terminals known to support grapheme clusters, but unable to respond to decmode request 2027 |
|
|
|
|
#wezterm (on windows as at 2024-12 decmode 2027 doesn't work) |
|
|
|
|
#REVIEW - what if terminal is remote wezterm? can/will this env variable |
|
|
|
|
#wezterm (on windows as at 2024-12 decmode 2027 doesn't work) (2025-12 update - 2027 request works) |
|
|
|
|
# iterm and apple terminal also set TERM_PROGRAM |
|
|
|
|
if {[string tolower $::env(TERM_PROGRAM)] in [list wezterm]} { |
|
|
|
|
set is_available 1 |
|
|
|
|
@ -2100,7 +2649,7 @@ namespace eval punk::console {
|
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
#where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) |
|
|
|
|
set state [get_mode grapheme_clusters] ;#decmode 2027 extension |
|
|
|
|
set state [dec_get_mode grapheme_clusters] ;#decmode 2027 extension |
|
|
|
|
set is_available 0 |
|
|
|
|
switch -- $state { |
|
|
|
|
0 { |
|
|
|
|
@ -2257,7 +2806,7 @@ namespace eval punk::console {
|
|
|
|
|
The sequence emitted will depend on the mode of the |
|
|
|
|
terminal as stored in the consolehandle. |
|
|
|
|
Directly setting the mode via raw escape sequences: |
|
|
|
|
e.g unset_mode DECANM for vt52 |
|
|
|
|
e.g dec_unset_mode DECANM for vt52 |
|
|
|
|
or puts \x1b< to return to ANSI |
|
|
|
|
will not necessarily update the application of |
|
|
|
|
the change in terminal state. Major state changes |
|
|
|
|
@ -2885,7 +3434,7 @@ namespace eval punk::console::check {
|
|
|
|
|
|
|
|
|
|
namespace eval ::punk::args::register { |
|
|
|
|
#use fully qualified so 8.6 doesn't find existing var in global namespace |
|
|
|
|
lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::internal ::punk::console::local ::punk::console::ansi |
|
|
|
|
lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::argdoc ::punk::console::internal ::punk::console::local ::punk::console::ansi |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
