diff --git a/src/modules/punk/AGENTS.md b/src/modules/punk/AGENTS.md index 01c10884..fd0e3db7 100644 --- a/src/modules/punk/AGENTS.md +++ b/src/modules/punk/AGENTS.md @@ -28,7 +28,7 @@ Source of truth for all modules under the `punk::*` namespace. This is the prima ## Work Guidance - New modules under `punk::*` should be created as `/-999999.0a1.0.tm` following the namespace-to-path convention. -- punk::console is incrementally migrating positional `inoutchannels` arguments to the documented `-console` convention. A `-console` value may be a 2-element {in out} channel list, an anchored `opunk::console` instance name, or an `::opunk::Console` object value (resolved via `punk::console::console_spec_resolve`). Converted procs accept the legacy leading positional channel-pair during the transition; convert remaining positional procs opportunistically when touched, with tests. PUNKARGS definitions include the `-console` option via the shared fragments `::punk::console::argdoc::console_opts` (query/set functions) or `::punk::console::argdoc::console_emit_opts` (emit functions) rather than duplicating the option text; never re-add a `-minsize 2` constraint to `-console` (it rejects instance-name specs). +- punk::console uses the documented `-console` convention throughout: a `-console` value may be a 2-element {in out} channel list, an anchored `opunk::console` instance name, or an `::opunk::Console` object value (resolved via `punk::console::console_spec_resolve`). Query functions use the hybrid pattern (legacy trailing positional spec also accepted, parsed by `punk::console::internal::hybrid_console_spec`) - new query procs must follow it, with tests (see `src/tests/modules/punk/console/testsuites/console/queryprocs.test`). PUNKARGS definitions include the `-console` option via the shared fragments `::punk::console::argdoc::console_opts` (query/set functions) or `::punk::console::argdoc::console_emit_opts` (emit functions) rather than duplicating the option text; never re-add a `-minsize 2` constraint to `-console` (it rejects instance-name specs). The internal `get_size_using_*` size mechanisms deliberately remain canonical-pair positional (always fed by `get_size`). - punk::console emit-side functions (the `punk::console::ansi::*` emit wrappers, mouse/paste toggles, `vt52`, `set_tabstop_width`, `titleset`, top-level `move`, and the width-test probes) accept an optional trailing `-console ` pair, parsed manually for performance by `punk::console::internal::opt_console_out`/`opt_console_channels` (`_var` variants for procs whose args-tail also carries row/col/data triples). Each carries a documentation-only PUNKARGS definition that includes the shared `::punk::console::argdoc::console_emit_opts` fragment via `punk::args::resolved_def`; keep manual parsing and PUNKARGS synchronized. New emit procs must follow this pattern. Tests live in `src/tests/modules/punk/console/testsuites/console/emitconsole.test`. - punk::console terminal-property facts (is_vt52, tabwidth, cell_size, last_da1_result, grapheme_cluster_support, check::has_bug_*) are per-console: read/write them via `punk::console::console_fact_get`/`console_fact_set`, keyed by canonical {in out} channel pair. The process-default console `{stdin stdout}` stores its facts in the legacy namespace variables (`::punk::console::is_vt52`, `tabwidth`, ...) so existing external readers keep working - do not bypass the helpers for non-default consoles. `ansi_wanted`/`colour_disabled` (string-generation gates), `ansi_available` and raw-mode state are deliberately process-global (rationale documented at the `console_facts` store in the module). Tests live in `src/tests/modules/punk/console/testsuites/console/consolefacts.test`. - Use `punk::args::parse` with `@id` references in `argdoc` namespaces for public API procs. diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 8a6f2c5a..973bfea6 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -402,6 +402,38 @@ namespace eval punk::console { } return $channels } + punk::args::define { + @id -id ::punk::console::internal::hybrid_console_spec + @cmd -name punk::console::internal::hybrid_console_spec -summary\ + "Resolve a get_size-style hybrid args-tail (?consolespec? or -console ) to the console specification."\ + -help\ + "Used by the query functions that accept the legacy trailing positional + console specification as well as the -console option form. Returns the + spec unresolved (callers pass it downstream or resolve as needed); + {stdin stdout} for an empty tail." + @leaders + argstail -type list + procname -type string -help\ + "caller name for error messages" + @values -min 0 -max 0 + } + proc hybrid_console_spec {argstail procname} { + #see PUNKARGS id ::punk::console::internal::hybrid_console_spec + switch -exact -- [llength $argstail] { + 0 { + return {stdin stdout} + } + 1 { + return [lindex $argstail 0] ;#legacy positional - accepts any console spec form + } + 2 { + if {[lindex $argstail 0] eq "-console"} { + return [lindex $argstail 1] + } + } + } + error "$procname: expected ?consolespec? or -console - got '$argstail'" + } proc abort_if_loop {{failmsg ""}} { #obsolete @@ -1241,10 +1273,24 @@ namespace eval punk::console { # -- --- --- --- --- --- --- #get_ansi_response functions - #review - can these functions sensibly be used on channels not attached to the local console? - #ie can we default to {stdin stdout} but allow other channel pairs? + #These accept the get_size-style hybrid tail: an optional legacy positional console + #specification, or -console (see internal::hybrid_console_spec). # -- --- --- --- --- --- --- - proc get_cursor_pos {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_cursor_pos + @cmd -name punk::console::get_cursor_pos -summary\ + "Query cursor position (CSI 6n) - returns the raw 'row;col' payload."\ + -help\ + "NOTE: argument parsing is manual for performance - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_cursor_pos {args} { + #see PUNKARGS id ::punk::console::get_cursor_pos + set inoutchannels [internal::hybrid_console_spec $args get_cursor_pos] if {[console_fact_get $inoutchannels is_vt52]} { error "vt52 can't perform get_cursor_pos" } @@ -1265,7 +1311,28 @@ namespace eval punk::console { - proc get_checksum_rect {id page t l b r {inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_checksum_rect + @cmd -name punk::console::get_checksum_rect -summary\ + "Query rectangular area checksum (DECRQCRA)."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @leaders + id -type integer -help "request id (echoed in the response)" + page -type integer + t -type integer -help "top row" + l -type integer -help "left column" + b -type integer -help "bottom row" + r -type integer -help "right column" + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_checksum_rect {id page t l b r args} { + #see PUNKARGS id ::punk::console::get_checksum_rect + set inoutchannels [internal::hybrid_console_spec $args get_checksum_rect] #e.g \x1b\[P44!~E797\x1b\\ #re e.g {(.*)(\x1b\[P44!~([[:alnum:]])\x1b\[\\)$} set capturingregex [string map [list %id% $id] {(.*)(\x1bP%id%!~([[:alnum:]]+)\x1b\\)$}] @@ -1273,7 +1340,21 @@ namespace eval punk::console { set payload [punk::console::internal::get_ansi_response_payload -console $inoutchannels $request $capturingregex] return $payload } - proc get_device_status {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_device_status + @cmd -name punk::console::get_device_status -summary\ + "Query device status (DSR 5n) - a 0 payload indicates OK."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_device_status {args} { + #see PUNKARGS id ::punk::console::get_device_status + set inoutchannels [internal::hybrid_console_spec $args get_device_status] set capturingregex {(.*)(\x1b\[([0-9]+)n)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[5n" set payload [punk::console::internal::get_ansi_response_payload -console $inoutchannels $request $capturingregex] @@ -1302,7 +1383,21 @@ namespace eval punk::console { #https://vt100.net/docs/vt510-rm/DA1.html # - proc get_device_attributes {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_device_attributes + @cmd -name punk::console::get_device_attributes -summary\ + "Query primary device attributes (DA1) - the payload is recorded as the console's last_da1_result fact."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_device_attributes {args} { + #see PUNKARGS id ::punk::console::get_device_attributes + set inoutchannels [internal::hybrid_console_spec $args get_device_attributes] #Note the vt52 rough equivalen \x1bZ - commonly supported but probably best considered obsolete as it collides with ECMA 48 SCI Single Character Introducer #DA1 #first element in result is the terminal's architectural class 61,62,63,64.. ? @@ -1606,19 +1701,60 @@ namespace eval punk::console { set parsed [classify_device_attributes_secondary $da2_response] return $parsed } - proc get_device_attributes_tertiary {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_device_attributes_tertiary + @cmd -name punk::console::get_device_attributes_tertiary -summary\ + "Query tertiary device attributes (DA3) - terminal unit id."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_device_attributes_tertiary {args} { + #see PUNKARGS id ::punk::console::get_device_attributes_tertiary + set inoutchannels [internal::hybrid_console_spec $args get_device_attributes_tertiary] #DA3 set capturingregex {(.*)(\x1bP!\|([0-9]{8})\x1b\\)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[=c" set payload [punk::console::internal::get_ansi_response_payload -console $inoutchannels $request $capturingregex] return $payload } - proc get_terminal_id {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_terminal_id + @cmd -name punk::console::get_terminal_id -summary\ + "Alias for get_device_attributes_tertiary (DA3)."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_terminal_id {args} { + #see PUNKARGS id ::punk::console::get_terminal_id #DA3 - alias - get_device_attributes_tertiary $inoutchannels + get_device_attributes_tertiary {*}$args } - proc get_tabstops {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_tabstops + @cmd -name punk::console::get_tabstops -summary\ + "Query tabstop columns (DECTABSR) - returns the list of tabstop column numbers."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_tabstops {args} { + #see PUNKARGS id ::punk::console::get_tabstops + set inoutchannels [internal::hybrid_console_spec $args get_tabstops] #DECTABSR \x1b\[2\$w #response example " ^[P2$u9/17/25/33/41/49/57/65/73/81^[\ " (where ^[ is \x1b) #set capturingregex {(.*)(\x1b\[P2$u()\x1b\[\\)} @@ -1634,7 +1770,21 @@ namespace eval punk::console { #It's known this isn't always the case - but things like textutil::untabify2 take only a single value #on some systems test_char_width is a similar speed to get_tabstop_apparent_width - but on some test_char_width is much slower #we will use test_char_width as a fallback - proc get_tabstop_apparent_width {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_tabstop_apparent_width + @cmd -name punk::console::get_tabstop_apparent_width -summary\ + "Determine apparent tabstop spacing (DECTABSR, falling back to test_char_width, then 8)."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_tabstop_apparent_width {args} { + #see PUNKARGS id ::punk::console::get_tabstop_apparent_width + set inoutchannels [internal::hybrid_console_spec $args get_tabstop_apparent_width] set tslist [get_tabstops $inoutchannels] if {![llength $tslist]} { #either terminal failed to report - or none set. @@ -1704,8 +1854,21 @@ namespace eval punk::console { } - proc get_cursor_pos_list {{inoutchannels {stdin stdout}}} { - return [split [get_cursor_pos $inoutchannels] ";"] + lappend PUNKARGS [list { + @id -id ::punk::console::get_cursor_pos_list + @cmd -name punk::console::get_cursor_pos_list -summary\ + "Query cursor position (CSI 6n) - returns {row col}."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_cursor_pos_list {args} { + #see PUNKARGS id ::punk::console::get_cursor_pos_list + return [split [get_cursor_pos {*}$args] ";"] } #todo - work out how to query terminal and set cell size in pixels @@ -1799,7 +1962,18 @@ namespace eval punk::console { #until a read is attempted - so for pipe-like channels a non-blocking 1-byte probe read is performed. #Any byte consumed by the probe is preserved in ::punk::console::input_chunks_waiting($input) for #cooperating readers (repl etc). + lappend PUNKARGS [list { + @id -id ::punk::console::input_at_eof + @cmd -name punk::console::input_at_eof -summary\ + "Determine with certainty whether an input channel is closed/at eof (probe read for deferred pipe eof; probed bytes preserved in input_chunks_waiting)."\ + -help\ + "NOTE: plain positional signature - this definition is documentation." + @values -min 0 -max 1 + input -type string -default stdin -optional 1 -help\ + "Input channel name." + }] proc input_at_eof {{input stdin}} { + #see PUNKARGS id ::punk::console::input_at_eof if {[catch {chan eof $input} is_eof]} { return 1 ;#closed/invalid channel - unusable } @@ -1839,7 +2013,18 @@ namespace eval punk::console { #(MSYSTEM, TERM_PROGRAM) are used to avoid false negatives there, at the cost of false positives in #environments that inherit such vars with genuinely piped (but still open) input - those paths still #rely on the ANSI query timeout mechanisms rather than hanging indefinitely. + lappend PUNKARGS [list { + @id -id ::punk::console::is_input_console_or_tty + @cmd -name punk::console::is_input_console_or_tty -summary\ + "Best-effort test whether an input channel could be a terminal able to answer ANSI queries (0 only when reasonably certain it cannot)."\ + -help\ + "NOTE: plain positional signature - this definition is documentation." + @values -min 0 -max 1 + input -type string -default stdin -optional 1 -help\ + "Input channel name." + }] proc is_input_console_or_tty {{input stdin}} { + #see PUNKARGS id ::punk::console::is_input_console_or_tty if {[catch {chan configure $input} conf]} { return 0 } @@ -2151,23 +2336,7 @@ namespace eval punk::console { } proc get_size {args} { #manual argument parsing - performance sensitive path (see PUNKARGS id ::punk::console::get_size for documentation) - switch -exact -- [llength $args] { - 0 { - set consolespec {stdin stdout} - } - 1 { - set consolespec [lindex $args 0] ;#legacy positional inoutchannels - accepts any console spec form - } - 2 { - if {[lindex $args 0] ne "-console"} { - error "get_size: expected ?consolespec? or -console - got '$args'" - } - set consolespec [lindex $args 1] - } - default { - error "get_size: expected ?consolespec? or -console - got '$args'" - } - } + set consolespec [internal::hybrid_console_spec $args get_size] set cinfo [console_spec_resolve $consolespec] set in [dict get $cinfo in] set out [dict get $cinfo out] @@ -2225,7 +2394,19 @@ namespace eval punk::console { #{columns rows } or an empty dict when size cannot be determined. #Used by the legacy get_size channel path and (as console_size_provider) by the base #::opunk::Console::size method via the pluggable ::opunk::console::size_query_provider hook. + lappend PUNKARGS [list { + @id -id ::punk::console::size_via_query_mechanisms + @cmd -name punk::console::size_via_query_mechanisms -summary\ + "ANSI/tput size mechanisms with per-console-pair timing cache - {columns rows } or empty dict when undetermined."\ + -help\ + "Internal mechanism dispatcher used by get_size and (as console_size_provider) by the + ::opunk::Console::size method. Callers supply a canonical {in out} channel pair." + @values -min 1 -max 1 + inoutchannels -type list -help\ + "Canonical {in out} channel pair." + }] proc size_via_query_mechanisms {inoutchannels} { + #see PUNKARGS id ::punk::console::size_via_query_mechanisms if {[console_fact_get $inoutchannels is_vt52]} { #vt52 doesn't support cursor save/restore or cursor position reports. if {![catch {get_size_using_tput $inoutchannels} sizedict]} { @@ -2289,7 +2470,16 @@ namespace eval punk::console { #Registered as the ::opunk::console::size_query_provider (see ensure_object_integration): #gives the base ::opunk::Console::size method access to the ANSI query mechanisms without the #class depending on punk::console. + lappend PUNKARGS [list { + @id -id ::punk::console::console_size_provider + @cmd -name punk::console::console_size_provider -summary\ + "Registered as ::opunk::console::size_query_provider - gives the base Console::size method the ANSI size mechanisms." + @values -min 1 -max 1 + obj -type list -help\ + "::opunk::Console (or subclass) object value." + }] proc console_size_provider {obj} { + #see PUNKARGS id ::punk::console::console_size_provider size_via_query_mechanisms [::opunk::Console::channels $obj] } @@ -2314,7 +2504,16 @@ namespace eval punk::console { set object_integration_done 1 } + lappend PUNKARGS [list { + @id -id ::punk::console::get_size_using_chanconfigure + @cmd -name punk::console::get_size_using_chanconfigure -summary\ + "Console size from 'chan configure -winsize' on the output channel - errors when unsupported." + @values -min 0 -max 1 + inoutchannels -type list -default {stdin stdout} -optional 1 -help\ + "Canonical {in out} channel pair (internal size mechanism - not spec-form aware)." + }] proc get_size_using_chanconfigure {{inoutchannels {stdin stdout}}} { + #see PUNKARGS id ::punk::console::get_size_using_chanconfigure set out [lindex $inoutchannels 1] set outconf [chan configure $out] if {[dict exists $outconf -winsize]} { @@ -2329,7 +2528,16 @@ namespace eval punk::console { error "chan configure method of getting console size not supported or failed to get valid size info" } + lappend PUNKARGS [list { + @id -id ::punk::console::get_size_using_tput + @cmd -name punk::console::get_size_using_tput -summary\ + "Console size via the external tput utility (process terminal) - errors when tput is unavailable." + @values -min 0 -max 1 + inoutchannels -type list -default {stdin stdout} -optional 1 -help\ + "Canonical {in out} channel pair (internal size mechanism - not spec-form aware)." + }] proc get_size_using_tput {{inoutchannels {stdin stdout}}} { + #see PUNKARGS id ::punk::console::get_size_using_tput set tputcmd [auto_execok tput] if {$tputcmd eq ""} { error "tput command not found - cannot use tput method to get console size" @@ -2338,7 +2546,16 @@ namespace eval punk::console { return [dict create columns $cols rows $lines] } + lappend PUNKARGS [list { + @id -id ::punk::console::get_size_using_cursormove + @cmd -name punk::console::get_size_using_cursormove -summary\ + "Console size via big cursor move + position report (no cursor save/restore)." + @values -min 0 -max 1 + inoutchannels -type list -default {stdin stdout} -optional 1 -help\ + "Canonical {in out} channel pair (internal size mechanism - not spec-form aware)." + }] proc get_size_using_cursormove {{inoutchannels {stdin stdout}}} { + #see PUNKARGS id ::punk::console::get_size_using_cursormove set out [lindex $inoutchannels 1] #we can't reliably use [chan names] for stdin,stdout. There could be stacked channels and they may have a names such as file22fb27fe810 #chan eof is faster whether chan exists or not than @@ -2368,7 +2585,16 @@ namespace eval punk::console { } #faster than get_size when it is using ansi mechanism - but uses cursor_save - which we may want to avoid if calling during another operation which uses cursor save/restore + lappend PUNKARGS [list { + @id -id ::punk::console::get_size_using_cursorrestore + @cmd -name punk::console::get_size_using_cursorrestore -summary\ + "Console size via big cursor move + position report, bracketed by DEC cursor save/restore." + @values -min 0 -max 1 + inoutchannels -type list -default {stdin stdout} -optional 1 -help\ + "Canonical {in out} channel pair (internal size mechanism - not spec-form aware)." + }] proc get_size_using_cursorrestore {{inoutchannels {stdin stdout}}} { + #see PUNKARGS id ::punk::console::get_size_using_cursorrestore lassign $inoutchannels in out set outconf [chan configure $out] #don't use shortcut mechanisms - this function is intended to specificall use the cursor_save/restore method @@ -2398,22 +2624,63 @@ namespace eval punk::console { } - proc get_dimensions {{inoutchannels {stdin stdout}}} { - lassign [get_size $inoutchannels] _c cols _l lines + lappend PUNKARGS [list { + @id -id ::punk::console::get_dimensions + @cmd -name punk::console::get_dimensions -summary\ + "Console size as a WxH string (see get_size)."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_dimensions {args} { + #see PUNKARGS id ::punk::console::get_dimensions + lassign [get_size {*}$args] _c cols _l lines return "${cols}x${lines}" } #the (xterm?) CSI 18t query is supported by *some* terminals - proc get_xterm_size {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_xterm_size + @cmd -name punk::console::get_xterm_size -summary\ + "Query text-area size via xterm CSI 18t - returns {columns rows }."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_xterm_size {args} { + #see PUNKARGS id ::punk::console::get_xterm_size + set inoutchannels [internal::hybrid_console_spec $args get_xterm_size] set capturingregex {(.*)(\x1b\[8;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[18t" set payload [punk::console::internal::get_ansi_response_payload -console $inoutchannels $request $capturingregex] lassign [split $payload {;}] rows cols return [list columns $cols rows $rows] } - proc get_xterm_pixels {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::get_xterm_pixels + @cmd -name punk::console::get_xterm_pixels -summary\ + "Query text-area pixel size via xterm CSI 14t - returns {width height }."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc get_xterm_pixels {args} { + #see PUNKARGS id ::punk::console::get_xterm_pixels + set inoutchannels [internal::hybrid_console_spec $args get_xterm_pixels] set capturingregex {(.*)(\x1b\[4;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[14t" set payload [punk::console::internal::get_ansi_response_payload -console $inoutchannels $request $capturingregex] @@ -2425,7 +2692,21 @@ namespace eval punk::console { - proc dec_get_mode_line_wrap {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::dec_get_mode_line_wrap + @cmd -name punk::console::dec_get_mode_line_wrap -summary\ + "Query DEC autowrap mode (DECAWM, mode 7) state via DECRQM."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc dec_get_mode_line_wrap {args} { + #see PUNKARGS id ::punk::console::dec_get_mode_line_wrap + set inoutchannels [internal::hybrid_console_spec $args dec_get_mode_line_wrap] 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 -console $inoutchannels $request $capturingregex] @@ -2434,7 +2715,21 @@ namespace eval punk::console { #Terminals generally default to LNM being reset (off) ie enter key sends a lone #windows terminal defaults to LNM on, but wezterm on windows default to LNM off #LNM on sends both and ?? - proc ansi_get_mode_LNM {{inoutchannels {stdin stdout}}} { + lappend PUNKARGS [list { + @id -id ::punk::console::ansi_get_mode_LNM + @cmd -name punk::console::ansi_get_mode_LNM -summary\ + "Query ANSI linefeed/newline mode (LNM, mode 20) state via DECRQM."\ + -help\ + "NOTE: argument parsing is manual - this definition is documentation." + @opts + ${[punk::args::resolved_def -types opts ::punk::console::argdoc::console_opts -console]} + @values -min 0 -max 1 + inoutchannels -type list -optional 1 -help\ + "Legacy positional console specification (same forms accepted as -console)." + }] + proc ansi_get_mode_LNM {args} { + #see PUNKARGS id ::punk::console::ansi_get_mode_LNM + set inoutchannels [internal::hybrid_console_spec $args ansi_get_mode_LNM] 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 -console $inoutchannels $request $capturingregex] diff --git a/src/modules/punk/console-buildversion.txt b/src/modules/punk/console-buildversion.txt index d32969ed..d8406a1c 100644 --- a/src/modules/punk/console-buildversion.txt +++ b/src/modules/punk/console-buildversion.txt @@ -1,6 +1,9 @@ -0.4.0 +0.5.0 #First line must be a semantic version number #all other lines are ignored. +#0.5.0 - migration complete: the remaining trailing-positional query functions (get_cursor_pos, get_cursor_pos_list, get_checksum_rect, get_device_status, get_device_attributes, get_device_attributes_tertiary, get_terminal_id, get_tabstops, get_tabstop_apparent_width, get_dimensions, get_xterm_size, get_xterm_pixels, dec_get_mode_line_wrap, ansi_get_mode_LNM) converted to the get_size hybrid pattern via new internal::hybrid_console_spec - each accepts the legacy positional console spec or -console (any spec form), with PUNKARGS documentation +#0.5.0 - get_size refactored onto internal::hybrid_console_spec (behaviour unchanged) +#0.5.0 - documentation-only PUNKARGS added for input_at_eof, is_input_console_or_tty, size_via_query_mechanisms, console_size_provider and the get_size_using_* mechanism helpers (signatures unchanged - internal size mechanisms remain canonical-pair only) #0.4.0 - mode setters (dec_set_mode/dec_unset_mode/ansi_set_mode/ansi_unset_mode) and cursor_style resolve their -console spec via console_spec_resolve instead of '[lindex $terminal 1]' - anchored instance names and ::opunk::Console object values now work (previously silently wrote to the wrong target) #0.4.0 - the fourteen '-console -type list -minsize 2' declarations replaced with shared fragment ::punk::console::argdoc::console_opts (the -minsize 2 constraint rejected 1-element instance-name specs at parse time); show_input_response and cell_size -console docs unified on the fragment #0.4.0 - dec_has_mode/ansi_has_mode cache on the canonical {in out} pair - all spec forms addressing the same console share one cache entry (previously keyed on the raw spec string) diff --git a/src/tests/modules/punk/console/testsuites/console/queryprocs.test b/src/tests/modules/punk/console/testsuites/console/queryprocs.test new file mode 100644 index 00000000..99f7eb34 --- /dev/null +++ b/src/tests/modules/punk/console/testsuites/console/queryprocs.test @@ -0,0 +1,154 @@ +package require tcltest +tcltest::configure {*}$::argv + +#min-version bounds document that these tests target the dev modules' API and protect against +#stable copies shadowing them if this file is sourced outside runtests.tcl (whose testinterp +#runs 'package prefer latest'). +package require punk::console 999999.0a1.0- +package require opunk::console 999999.0a1.0- + +#Tests for the hybrid-converted query functions (migration plan phase 4): each accepts an +#optional legacy positional console specification or '-console ' (any spec form), +#parsed via punk::console::internal::hybrid_console_spec. Terminal responses are fed on the +#'input' pipe after each query is emitted, as a real terminal would. + +namespace eval ::testspace { + namespace import ::tcltest::* + + #in/out pipe pairs: rdi/wri feeds the console 'input', wro/rdo captures 'output' + variable pipes_setup { + set result "" + lassign [chan pipe] rdi wri + lassign [chan pipe] rdo wro + chan configure $wri -buffering none -translation lf + chan configure $wro -buffering none -translation lf + chan configure $rdo -blocking 0 -translation lf + } + variable pipes_cleanup { + foreach c [list $wri $rdi $wro $rdo] { + catch {chan close $c} + } + array unset ::punk::console::input_chunks_waiting $rdi + } + #deliver a terminal response after the query has been emitted (fires inside the + #query's vwait - simulating a real terminal's response timing) + proc feed {wchan data} { + after 40 [list apply [list {w d} { + puts -nonewline $w $d + flush $w + }] $wchan $data] + } + + test qp_cursor_pos_forms {get_cursor_pos/get_cursor_pos_list accept positional, -console and instance-name spec forms}\ + -setup $pipes_setup -body { + feed $wri "\x1b\[10;5R" + lappend result [punk::console::get_cursor_pos [list $rdi $wro]] + feed $wri "\x1b\[11;6R" + lappend result [punk::console::get_cursor_pos -console [list $rdi $wro]] + opunk::console::create qptest1 $rdi $wro + #pre-settle capability - an unsettled anchored instance would trigger first-use + #settling, which (correctly) settles 0 on a hint-less pipe pair and refuses to query + upvar #0 [opunk::console::instancevar qptest1] qpobj + ::opunk::Console::set.o_can_respond qpobj 1 + feed $wri "\x1b\[12;7R" + lappend result [punk::console::get_cursor_pos_list -console qptest1] + #bad tails error without emitting + lappend result [catch {punk::console::get_cursor_pos -notanoption x}] + lappend result [catch {punk::console::get_cursor_pos a b c}] + }\ + -cleanup [string cat { + catch {opunk::console::forget qptest1} + } $pipes_cleanup]\ + -result [list\ + {10;5}\ + {11;6}\ + {12 7}\ + 1\ + 1\ + ] + + test qp_device_queries {get_device_status, DA3 and get_terminal_id parse fed responses}\ + -setup $pipes_setup -body { + set spec [list $rdi $wro] + feed $wri "\x1b\[0n" + lappend result [punk::console::get_device_status -console $spec] + feed $wri "\x1bP!|00010203\x1b\\" + lappend result [punk::console::get_device_attributes_tertiary -console $spec] + feed $wri "\x1bP!|00010203\x1b\\" + lappend result [punk::console::get_terminal_id $spec] + }\ + -cleanup $pipes_cleanup\ + -result [list\ + 0\ + 00010203\ + 00010203\ + ] + + test qp_tabstops {get_tabstops and get_tabstop_apparent_width parse DECTABSR responses}\ + -setup $pipes_setup -body { + set spec [list $rdi $wro] + feed $wri "\x1bP2\$u9/17/25\x1b\\" + lappend result [punk::console::get_tabstops -console $spec] + #tabstop at column 1 present: apparent width is next stop minus 1 + feed $wri "\x1bP2\$u1/9\x1b\\" + lappend result [punk::console::get_tabstop_apparent_width -console $spec] + }\ + -cleanup $pipes_cleanup\ + -result [list\ + {9 17 25}\ + 8\ + ] + + test qp_xterm_size_pixels {get_xterm_size and get_xterm_pixels parse CSI t reports}\ + -setup $pipes_setup -body { + set spec [list $rdi $wro] + feed $wri "\x1b\[8;24;80t" + lappend result [punk::console::get_xterm_size -console $spec] + feed $wri "\x1b\[4;480;640t" + lappend result [punk::console::get_xterm_pixels -console $spec] + }\ + -cleanup $pipes_cleanup\ + -result [list\ + {columns 80 rows 24}\ + {width 640 height 480}\ + ] + + test qp_mode_shortcuts_and_checksum {dec_get_mode_line_wrap, ansi_get_mode_LNM and get_checksum_rect parse fed responses}\ + -setup $pipes_setup -body { + set spec [list $rdi $wro] + feed $wri "\x1b\[?7;1\$y" + lappend result [punk::console::dec_get_mode_line_wrap -console $spec] + feed $wri "\x1b\[20;2\$y" + lappend result [punk::console::ansi_get_mode_LNM -console $spec] + feed $wri "\x1bP1!~ABCD\x1b\\" + lappend result [punk::console::get_checksum_rect 1 1 1 1 10 10 -console $spec] + }\ + -cleanup $pipes_cleanup\ + -result [list\ + 1\ + 2\ + ABCD\ + ] + + test qp_get_dimensions_passthrough {get_dimensions delegates its spec to get_size (settled object supplies default size)}\ + -setup { + set result "" + lassign [chan pipe] rd wr + }\ + -body { + set obj [::opunk::Console::new.args -o_in $rd -o_out $wr -o_default_size {columns 132 rows 50}] + ::opunk::Console::set.o_can_respond obj 0 + lappend result [punk::console::get_dimensions -console $obj] + lappend result [punk::console::get_dimensions $obj] + }\ + -cleanup { + catch {chan close $wr} + catch {chan close $rd} + }\ + -result [list\ + 132x50\ + 132x50\ + ] + +} +tcltest::cleanupTests ;#needed to produce test summary.