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

punk::console improved control of DEC and ANSI modes

master
Julian Noble 3 weeks ago
parent
84663d2a05
commit
f0d06d3d57
3 changed files with 664 additions and 80 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. 99
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 2
      src/modules/punk/basictelnet-999999.0a1.0.tm
  3. 643
      src/modules/punk/console-999999.0a1.0.tm

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

@ -5031,7 +5031,6 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# origin 6\
# DECCOLM 3\
# line_wrap 7\
# LNM 20\
# alt_screen 1049\
# grapheme_clusters 2027\
# bracketed_paste 2004\
@ -5043,6 +5042,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# some more ansi mode/sequence info:
#https://pkg.go.dev/github.com/charmbracelet/x/ansi
#see also: https://ucs-detect.readthedocs.io/results.html#dec-private-modes-support
#REVIEW - these modes are sometimes used for different things on different terminals
#For now we are assigning based on common usage in things like xterm & windows terminal
#Proper handling would require tables for various terminals - review.
#set with DECSET ESC [ ? <code> h
#unset with DECRST ESC [ ? <code> l
variable decmode_data {
1 {
{origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}}
@ -5069,8 +5076,11 @@ In VT52 mode - use \x1b< to exit.
7 {
{origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}}
}
8 {
{origin DEC description "DECARM - Auto Repeat Mode" names {DECARM autorepeat}}
}
9 {
{origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking} note {
{origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking XTMOSREP} note {
Escape sequence on button press only.
CSI M CbCxCy (6 chars)
Coords limited to 223 (=255 - 32)
@ -5078,24 +5088,28 @@ Coords limited to 223 (=255 - 32)
}
{origin DEC description "DECINLM - Interlace Mode (obsolete?)" names {DECINLM}}
}
20 {
{origin DEC description "LNM - Line Feed/New Line Mode" names {LNM} note {
For terminals that support LNM, the default is off
meaning a lone CR respresents the character emitted
when enter is pushed. Turning LNM on would mean that
CR LF is sent when hitting enter. This feature is
not commonly supported, and the default will normally
be as if this was off - ie lone CR.
}
}
12 {
{origin xterm description "Cursor blink" names {XTCBLINK cursorblink}}
{origin DEC description "DECKANAM - Katakana Shift Mode (obsolete?)" names {DECKANAM}}
}
25 {
{origin DEC description "DECTCEM - Text Cursor Enable Mode" names {DECTCEM cursor_enable}}
}
40 {
{origin DEC description "New Line Mode" names {DECCRNLM newline_mode}}
{origin xterm description "Allow 80->132 mode" names {xt80-132}}
}
45 {
{origin DEC description "Graphics Print Color Syntax" names {DECGPCS}}
{origin xterm description "Reverse Wraparound Mode" names {reverse_wraparound}}
}
47 {
{origin xterm description "xterm alternate buffer" names {xterm_altbuf}}
{origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}}
}
64 {
{origin DEC description "DECPCCM - Page Cursor Coupling Mode" names {DECPCCM}}
}
66 {
{origin DEC description "DECNKM - Numeric Keypad Mode" see "https://vt100.net/docs/vt510-rm/DECNKM.html" names {DECNKM}}
}
@ -5105,6 +5119,12 @@ be as if this was off - ie lone CR.
69 {
{origin DEC description "DECLRMM - Left Right Margin Mode" see "https://vt100.net/docs/vt510-rm/DECLRMM.html" names {DECLRMM}}
}
80 {
{origin ??? description "Sixel Display Mode" see "" names {sixel_display}}
}
117 {
{origin ??? description "Erase Color Mode" see "" names {erase_color}}
}
1000 {
{origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note {
Escape sequence on both button press and release.
@ -5112,6 +5132,15 @@ CSI M CbCxCy
}
}
}
1001 {
{origin "???" description "Use Hilite Mouse Tracking" names {mouse_tracking_hilite}}
}
1002 {
{origin "???" description "Use Cell Motion Mouse Tracking" names {mouse_tracking_cellmotion}}
}
1003 {
{origin "???" description "Use All Motion Mouse Tracking" names {mouse_tracking_allmotion}}
}
1004 {
{origin "xterm" description "Send FocusIn/FocusOut events" names {mouse_focus_event}}
}
@ -5125,6 +5154,9 @@ to 223 (=255 - 32)
}
}
}
1007 {
{origin "???" description "Enable Alternate Scroll Mode" names {alternate_scroll}}
}
1015 {
{origin "urxvt" description "Enable urxvt Mouse Mode" names {mouse_urxvt}}
}
@ -5143,6 +5175,12 @@ to 223 (=255 - 32)
2027 {
{origin Contour description "Grapheme Cluster Processing" names {grapheme_clusters}}
}
8452 {
{origin "rlogin xterm" description "Post sixel cursor position" names {RLSIXPOS}}
}
9001 {
{origin "windows" description "win32 input mode" names {win32-input}}
}
}
set decmode_names [dict create]
dict for {code items} $decmode_data {
@ -5154,6 +5192,43 @@ to 223 (=255 - 32)
}
}
#set with SM: ESC [ <code> h
#unset with RM: ESC [ <code> l
variable ansimode_data {
2 {
{origin "vt" description "Lock the keyboard" names {KAM}}
}
4 {
{origin "vt" description "Insert mode" names {IRM}}
}
8 {
{origin "vt" description "Bidirectional support" names {BDSM}}
}
12 {
{origin "vt" description "Local echo" names {SRM}}
}
20 {
{origin vt description "LNM - Line Feed/New Line Mode" names {LNM} note {
For terminals that support LNM, the default is off
meaning a lone CR respresents the character emitted
when enter is pushed. Turning LNM on would mean that
CR LF is sent when hitting enter. This feature is
not commonly supported, and the default will normally
be as if this was off - ie lone CR.
}
}
}
}
set ansimode_names [dict create]
dict for {code items} $ansimode_data {
foreach itm $items {
set names [dict get $itm names]
foreach nm $names {
dict set ansimode_names $nm $code
}
}
}

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

@ -494,7 +494,7 @@ namespace eval punk::basictelnet {
::mode $tmode
}
}
if {[catch {set priormouse [punk::console::get_mode mouse_sgr]}]} {
if {[catch {set priormouse [punk::console::dec_get_mode mouse_sgr]}]} {
set priormouse -1
if {$mouse} {
puts stderr "Cannot determine mouse_sgr mode - assuming terminal doesn't support mouse"

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

@ -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 {
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_set_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}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 unset_mode {num_or_name {inoutchannels {stdin stdout}}} {
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 {
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
}
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 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,267 @@ 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 0
}]
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
}
upvar ::punk::ansi::ansimode_data ansimode_data
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
if {$do_test} {
$t add_column -headers Status
}
dict for {code items} $ansimode_data {
set 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]
}
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
}
set DECRQSS_DATA {
"Select Active Status Display" DECSASD "$\}"
@ -1878,8 +2388,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 +2401,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 +2421,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 +2601,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 +2609,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 +2766,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 +3394,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
}

Write Preview
Loading…
Cancel
Save