From 7e8d819663ddedd6fdafb3b773bcb5c5a653c578 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 11 Jul 2026 20:52:18 +1000 Subject: [PATCH] opunk::console::tk 0.2.0: widget field, -in/-out channels, live console wiring, resize-aware size (G-001) TkConsole holds the widget in a subclass o_widget field (always the authority for size/eof/capability; new 'widget' accessor) and accepts optional -in/-out constructor channels. New minimal widget-console wiring ::opunk::console::tk::console: a reflected output channel rendering into the widget (ansi-stripped when punk::ansi is present) plus an input pipe fed by the binding or programmatic submit/feed, with teardown flagging backend eof and closing the feed end - so a channel- driven repl runs against the widget via 'repl::init -console'. The size override now reports the widget's ACTUAL character dimensions while mapped (current pixel size / font metrics - tracks live window resizing); the requested -width/-height still answer for unmapped widgets, keeping construction-time behaviour and existing test pins unchanged. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- src/modules/opunk/AGENTS.md | 2 +- src/modules/opunk/console/tk-999999.0a1.0.tm | 246 ++++++++++++++++-- src/modules/opunk/console/tk-buildversion.txt | 4 +- 3 files changed, 235 insertions(+), 17 deletions(-) diff --git a/src/modules/opunk/AGENTS.md b/src/modules/opunk/AGENTS.md index 855d162d..ad54926d 100644 --- a/src/modules/opunk/AGENTS.md +++ b/src/modules/opunk/AGENTS.md @@ -21,7 +21,7 @@ Modules under the `opunk::*` namespace explore value-based class implementations - Anchor lifecycle is observable the same way: `::opunk::console::lifecycle_callback` is a command prefix invoked as `{*}$cb created|forgotten {in out}` after `create` anchors / `forget` releases an instance; punk::console registers its handler via `ensure_object_integration` to maintain the G-007 console ownership registry. Empty by default; callback errors propagate to the create/forget caller. - Method-entry validity guards use `[llength $this] < N` (not `!= N`) so field-adding subclasses keep working. - Subclassing (`voo::class -extends ::opunk::Console {...}`): the child inherits public accessors and the field INDEX variables, but not the parent's private `my.*` accessors - a subclass CONSTRUCTOR initialises inherited private fields via the index variables (`variable o_in` then `lset obj $o_in $value` - the sanctioned exception to the avoid-`variable o_` rule, which still applies in method bodies where the parent's public accessor METHODS should be used instead, e.g `[::opunk::Console::in $this]`). Overridden `-virtual` methods are plain `method` declarations in the child; base-class calls dispatch to them via the slot-0 tag. -- G-001 backend subclasses (console/ subfolder): `opunk::console::test` (`::opunk::TestConsole` - deterministic channel-pair test double: fixed size, no probes; the console seam for repl/editbuf characterization), `opunk::console::ssh` (`::opunk::SshConsole` - socket-carried terminal sessions: construction-time capability, chan-eof without probe, size via the ANSI size-query provider over the connection), `opunk::console::tk` (`::opunk::TkConsole` - Tk text widget as terminal: widget path in the in/out slots, size from widget char dims, backend eof marker via `::opunk::console::tk::set_eof`; no Tk package require at load). Tests: `src/tests/modules/opunk/console/testsuites/console/backends.test` (tk case gated behind env `PUNK_TEST_TK=1` - loading Tk into the shared runtests testinterp has event-loop side effects). +- G-001 backend subclasses (console/ subfolder): `opunk::console::test` (`::opunk::TestConsole` - deterministic channel-pair test double: fixed size, no probes; the console seam for repl/editbuf characterization), `opunk::console::ssh` (`::opunk::SshConsole` - socket-carried terminal sessions: construction-time capability, chan-eof without probe, size via the ANSI size-query provider over the connection), `opunk::console::tk` (`::opunk::TkConsole` - Tk text widget as terminal: widget held in a subclass `o_widget` field which always answers size/eof/capability; in/out slots carry the widget path by default or channels via `-in`/`-out`; backend eof marker via `::opunk::console::tk::set_eof`; `::opunk::console::tk::console ` wires a reflected output channel + Return-binding input pipe so a channel-driven repl runs against the widget; no Tk package require at load - only the wiring proc requires Tk). Tests: `src/tests/modules/opunk/console/testsuites/console/backends.test` (tk case gated behind env `PUNK_TEST_TK=1` - loading Tk into the shared runtests testinterp has event-loop side effects) and the repl-integration suite `src/tests/modules/punk/repl/testsuites/repl/consolebackends.test` (child-process drivers; tk case self-gates on Tk availability in the child). - Module filenames use the `-999999.0a1.0.tm` magic suffix with `-buildversion.txt` per parent conventions. - `opunk::console` (with its dependency `voo`) is included in bootsupport via `src/bootsupport/modules/include_modules.config` for eventual boot/repl-startup console objects; after releasing a new version, rebuild with `make.tcl modules` then refresh the snapshot with `make.tcl bootsupport`. diff --git a/src/modules/opunk/console/tk-999999.0a1.0.tm b/src/modules/opunk/console/tk-999999.0a1.0.tm index a40ec2f3..718c2aec 100644 --- a/src/modules/opunk/console/tk-999999.0a1.0.tm +++ b/src/modules/opunk/console/tk-999999.0a1.0.tm @@ -17,15 +17,21 @@ package require opunk::console #without Tk; construction errors usefully if the widget doesn't exist. This keeps the #backend requirable in non-GUI processes (introspection, docs) and leaves Tk loading #policy to the application (punk runtimes load Tk as an extension - punkbin convention). +#Only ::opunk::console::tk::console (which wires live channels to a widget) requires Tk. #opunk::TkConsole - an ::opunk::Console backend for a Tk text widget acting as a #terminal (G-001). A widget is not a channel at all, so every channel-shaped base #method is overridden - none of the channel/provider logic applies (the class comment #in opunk/console anticipates exactly this subclass). # -# - o_in/o_out carry the WIDGET PATH (documented reuse of the inherited channel slots - -# holders calling in/out/channels get the widget path; a non-channel consumer must -# know its backend, which is what is_console_or_tty/terminal_class are for) +# - o_widget (subclass field) carries the WIDGET PATH; capability/size/eof questions +# are always answered from the widget +# - o_in/o_out carry CHANNELS when constructed with -in/-out (e.g the reflected/pipe +# pair made by ::opunk::console::tk::console - this is what lets a channel-driven +# repl read/write through the console); without them they default to the widget +# path (documented non-channel reuse of the inherited slots - holders calling +# in/out/channels then get the widget path and must know their backend, which is +# what is_console_or_tty/terminal_class are for) # - is_console_or_tty: always 1 (constructed as a terminal) # - can_respond: settled value if set, else 1 (the widget side can answer - # whatever integrating layer renders to the widget also responds) @@ -33,9 +39,10 @@ package require opunk::console # longer exists (winfo exists - requires Tk loaded) or when the # integrating layer has flagged eof via ::opunk::console::tk::set_eof # (e.g the user closed the console frame but the widget remains) -# - size: the widget's character dimensions ([$w cget -width/-height] - -# the text widget's requested size in chars), falling back to the -# inherited default size if the widget can't be queried. +# - size: the widget's ACTUAL character dimensions when mapped (pixel +# size / font metrics - tracks live window resizing), else the +# requested -width/-height, falling back to the inherited +# default size if the widget can't be queried. # #No edits to the base ::opunk::Console or punk::console are needed (G-001 acceptance). @@ -45,10 +52,21 @@ tcl::namespace::eval ::opunk::console::tk { if {![array exists eof_flags]} { array set eof_flags {} } + #widget-console wiring state keyed by widget path (see proc console) + variable wiring + if {![array exists wiring]} { + array set wiring {} + } } voo::class ::opunk::TkConsole -extends ::opunk::Console { + private { + string_t o_widget "" + } public { + method widget {} { + my.get.o_widget $this + } method is_console_or_tty {} { return 1 } @@ -60,7 +78,7 @@ voo::class ::opunk::TkConsole -extends ::opunk::Console { return 1 } method at_eof {} { - set w [::opunk::Console::in $this] + set w [my.get.o_widget $this] if {[info exists ::opunk::console::tk::eof_flags($w)] && $::opunk::console::tk::eof_flags($w)} { return 1 } @@ -72,7 +90,29 @@ voo::class ::opunk::TkConsole -extends ::opunk::Console { return [expr {!$exists}] } method size {} { - set w [::opunk::Console::in $this] + #Size of the console the widget presents RIGHT NOW: + # 1. mapped widget: ACTUAL character dimensions computed from the current + # pixel size and font metrics - tracks live window resizing. + # ([$w cget -width/-height] only report the REQUESTED size, which does + # not change when the user resizes the window.) + # 2. unmapped (constructed but not yet displayed, or withdrawn): the + # requested -width/-height + # 3. the inherited default size when the widget can't be queried at all + set w [my.get.o_widget $this] + if {![catch {winfo ismapped $w} mapped] && $mapped} { + if {![catch { + set fnt [$w cget -font] + set charw [font measure $fnt 0] + set charh [font metrics $fnt -linespace] + set extra [expr {[$w cget -borderwidth] + [$w cget -highlightthickness]}] + set cols [expr {([winfo width $w] - 2*($extra + [$w cget -padx])) / $charw}] + set rows [expr {([winfo height $w] - 2*($extra + [$w cget -pady])) / $charh}] + }]} { + if {$cols > 0 && $rows > 0} { + return [dict create columns $cols rows $rows] + } + } + } if {![catch {list [$w cget -width] [$w cget -height]} wh]} { lassign $wh cols rows if {[string is integer -strict $cols] && [string is integer -strict $rows] && $cols > 0 && $rows > 0} { @@ -83,17 +123,37 @@ voo::class ::opunk::TkConsole -extends ::opunk::Console { } } - constructor {widget} { - #widget: path of a Tk text widget playing the terminal role. Stored in both the - #inherited in/out slots (documented non-channel reuse). Parent fields are - #private - set via imported index variables. + constructor {widget args} { + #widget: path of a Tk text widget playing the terminal role - stored in the + #subclass o_widget field (always the authority for size/eof/capability). + #args: optional -in -out channels for the inherited in/out slots + #(e.g from ::opunk::console::tk::console); default is the widget path in both + #slots (non-channel reuse). Parent fields are private - set via imported index + #variables (the voo -extends pattern for initialising inherited private fields). variable o_in variable o_out variable o_terminal_class + variable o_widget set obj [new()] - lset obj $o_in $widget - lset obj $o_out $widget + set in $widget + set out $widget + foreach {k v} $args { + switch -- $k { + -in { + set in $v + } + -out { + set out $v + } + default { + error "opunk::TkConsole::new unknown option '$k'. Known options: -in -out" + } + } + } + lset obj $o_in $in + lset obj $o_out $out lset obj $o_terminal_class tk-text + lset obj $o_widget $widget return $obj } } @@ -113,13 +173,116 @@ tcl::namespace::eval ::opunk::console::tk { return } + #Minimal widget-console wiring (G-001): turn a Tk text widget into a live console a + #channel-driven repl can be launched against. Deliberately basic - a fuller virtual + #terminal (ansi rendering, line editing, scrollback control) is the punkwish + #textwidget exploration's territory, not this module's. + # - output: a reflected write channel; written text is rendered into the widget + # (ansi-stripped when punk::ansi is present, \r\n normalized to \n) + # - input: a chan pipe; the binding (or programmatic 'feed') submits the + # text typed after the last output position + # - on the widget flags backend eof and closes the input feed end, so a + # repl reading the input channel sees eof and finishes + + proc console {widget} { + variable wiring + package require Tk + if {![winfo exists $widget]} { + error "opunk::console::tk::console - widget '$widget' does not exist" + } + if {[info exists wiring($widget)]} { + error "opunk::console::tk::console - widget '$widget' is already wired as a console" + } + lassign [chan pipe] in_rd in_wr + chan configure $in_wr -translation lf -encoding utf-8 -buffering none + chan configure $in_rd -translation lf -encoding utf-8 + set out_ch [chan create write [list [namespace current]::out_handler $widget]] + chan configure $out_ch -translation lf -encoding utf-8 -buffering none + set wiring($widget) [dict create in_rd $in_rd in_wr $in_wr out_ch $out_ch] + $widget mark set conin_start end-1c + $widget mark gravity conin_start left + bind $widget "[list [namespace current]::submit $widget]; break" + bind $widget [list [namespace current]::teardown $widget] + return [::opunk::TkConsole::new $widget -in $in_rd -out $out_ch] + } + + proc submit {widget} { + #submit the current input area (text after conin_start) as one line on the + #console's input channel - the binding and 'feed' both land here + variable wiring + if {![info exists wiring($widget)]} { + return + } + set line [$widget get conin_start end-1c] + $widget insert end \n + $widget mark set conin_start end-1c + $widget see end + catch {puts [dict get $wiring($widget) in_wr] $line} + return + } + + proc feed {widget line} { + #programmatic typing: append the line to the widget's input area and submit it + #(automation/testing convenience - the interactive path is the binding) + $widget insert end $line + submit $widget + } + + proc teardown {widget} { + #widget destroyed: flag backend eof and close the input feed end so a reader of + #the console's input channel sees eof. The output channel is left to its holder + #(out_handler no-ops once the widget is gone). + variable wiring + set_eof $widget + if {![info exists wiring($widget)]} { + return + } + set w $wiring($widget) + unset wiring($widget) + catch {close [dict get $w in_wr]} + return + } + + proc out_handler {widget cmd args} { + #reflected-channel handler (chan create write) rendering console output into + #the text widget + switch -- $cmd { + initialize { + return {initialize finalize watch write} + } + finalize { + return + } + watch { + return + } + write { + lassign $args ch bytes + set text [encoding convertfrom utf-8 $bytes] + set text [string map [list \r\n \n] $text] + if {![catch {package present punk::ansi}]} { + set text [punk::ansi::ansistrip $text] + } + if {![catch {winfo exists $widget} exists] && $exists} { + $widget insert end $text + $widget mark set conin_start end-1c + $widget see end + } + return [string length $bytes] + } + } + } + lappend PUNKARGS [list { @id -id "(package)opunk::console::tk" @package -name "opunk::console::tk" -help\ "voo class ::opunk::TkConsole - an ::opunk::Console backend wrapping a Tk text widget acting as a terminal: size from the widget's character dimensions, eof via a backend marker (::opunk::console::tk::set_eof) or widget destruction - a - non-channel subclass overriding all channel-shaped base methods (G-001)." + non-channel subclass overriding all channel-shaped base methods (G-001). + ::opunk::console::tk::console wires a widget with a reflected output channel and + an input pipe (Return-binding driven), so a channel-driven repl can be launched + against the widget (repl::init -console)." }] lappend PUNKARGS [list { @id -id ::opunk::console::tk::set_eof @@ -137,6 +300,59 @@ tcl::namespace::eval ::opunk::console::tk { value -type boolean -default 1 -optional 1 -help\ "1 to flag eof (default), 0 to clear" }] + lappend PUNKARGS [list { + @id -id ::opunk::console::tk::console + @cmd -name opunk::console::tk::console\ + -summary\ + "Wire a Tk text widget as a live console and return a ::opunk::TkConsole for it."\ + -help\ + "Creates a reflected output channel rendering into the widget and an input + pipe fed by the widget's binding (or programmatic 'feed'), then + returns a ::opunk::TkConsole constructed with those channels (-in/-out). + The returned console value can be passed to 'repl::init -console' to run an + interactive repl through the widget. on the widget flags backend + eof and closes the input feed end. Requires Tk." + @leaders -min 1 -max 1 + widget -type string -help\ + "path of an existing Tk text widget" + }] + lappend PUNKARGS [list { + @id -id ::opunk::console::tk::submit + @cmd -name opunk::console::tk::submit\ + -summary\ + "Submit the widget's current input area as one line on the console input channel."\ + -help\ + "The text after the conin_start mark (i.e typed since the last output) is + written as one line to the console's input pipe. Bound to by + 'console'; call directly (or via 'feed') for programmatic input." + @leaders -min 1 -max 1 + widget -type string -help\ + "Tk widget path wired by ::opunk::console::tk::console" + }] + lappend PUNKARGS [list { + @id -id ::opunk::console::tk::feed + @cmd -name opunk::console::tk::feed\ + -summary\ + "Programmatically type a line into a wired widget console and submit it." + @leaders -min 1 -max 1 + widget -type string -help\ + "Tk widget path wired by ::opunk::console::tk::console" + @values -min 1 -max 1 + line -type string -help\ + "the line to append to the input area and submit" + }] + lappend PUNKARGS [list { + @id -id ::opunk::console::tk::teardown + @cmd -name opunk::console::tk::teardown\ + -summary\ + "Release a widget's console wiring: flag eof and close the input feed end."\ + -help\ + "Bound to by 'console'; may be called directly to end a widget + console session while the widget lives on." + @leaders -min 1 -max 1 + widget -type string -help\ + "Tk widget path wired by ::opunk::console::tk::console" + }] } namespace eval ::punk::args::register { diff --git a/src/modules/opunk/console/tk-buildversion.txt b/src/modules/opunk/console/tk-buildversion.txt index 12bddbe4..e88269c9 100644 --- a/src/modules/opunk/console/tk-buildversion.txt +++ b/src/modules/opunk/console/tk-buildversion.txt @@ -1,4 +1,6 @@ -0.1.0 +0.2.0 #First line must be a semantic version number #all other lines are ignored. +#0.2.0 - size now reports the widget's ACTUAL character dimensions when mapped (current pixel size / font metrics - tracks live window resizing); the requested -width/-height remain the answer for unmapped widgets (construction-time/tests unchanged) +#0.2.0 - G-001: TkConsole gains a subclass o_widget field (widget is always the authority for size/eof/capability; new 'widget' accessor) and optional -in/-out constructor channels; new minimal widget-console wiring ::opunk::console::tk::console (reflected output channel rendering into the widget, input pipe fed by the binding or programmatic submit/feed, teardown) so a channel-driven repl can be launched against the widget via repl::init -console. Default construction (widget path in in/out slots) unchanged. #0.1.0 - G-001: initial ::opunk::Console backend subclass