Browse Source
New agent-maintainable scriptlib/developer/ area (recorded in root AGENTS.md ownership notes). tkconsole_demo.tcl wires a Tk text widget as a live ::opunk::TkConsole and runs an interactive repl against it, with a layer-by-layer commented walkthrough of the mechanics: voo virtual dispatch, the reflected-channel/input-pipe wiring, repl::init -console routing and the junction-stack output diversion, and the vwait/Tk event loop interplay. punk::args-documented options (--help renders the usage table; the definition is registered for 'i developer::tkconsole_demo'): -columns/-rows/-font/-title, -demo (auto-typed session via feed, including a window-resize step showing size queries tracking actual dimensions) and -autoclose (exercises the <Destroy> -> teardown -> eof path). Includes a demo-installed code-interp bridge so in-session punk::console::get_size reports the tk console's current size - documented as a hand-rolled preview of G-008 scoped console state. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
2 changed files with 374 additions and 1 deletions
@ -0,0 +1,373 @@
|
||||
#! /usr/bin/env tclsh |
||||
# ============================================================================= |
||||
# tkconsole_demo.tcl - developer showcase for the G-001 Tk console backend |
||||
# ============================================================================= |
||||
# |
||||
# WHAT THIS DEMONSTRATES |
||||
# |
||||
# An interactive punk repl running against a Tk text widget instead of the |
||||
# process console - the tk-widget case of goal G-001 (see |
||||
# goals/archive/G-001-pluggable-console-backends.md). You type commands into |
||||
# the text widget; results, prompts and the code interp's stdout/stderr all |
||||
# render back into the same widget. |
||||
# |
||||
# HOW TO RUN |
||||
# |
||||
# from a punk shell checkout (any of): |
||||
# <punkexe> script lib:developer/tkconsole_demo.tcl |
||||
# tclsh scriptlib/developer/tkconsole_demo.tcl |
||||
# (when run under plain tclsh from inside a punkshell checkout, the script |
||||
# adds the checkout's src module/lib paths itself - see BOOTSTRAP below) |
||||
# |
||||
# options (punk::args-parsed - see the definition below; try --help): |
||||
# -columns/-rows widget character dimensions (what the console's 'size' |
||||
# method reports to the repl) |
||||
# -font text widget font (default TkFixedFont) |
||||
# -title window title |
||||
# -demo auto-type a short scripted session via |
||||
# ::opunk::console::tk::feed before handing you the keys |
||||
# -autoclose <ms> destroy the window after <ms> (automation/testing aid - |
||||
# exercises the <Destroy> -> teardown -> eof path) |
||||
# |
||||
# THE MECHANICS, LAYER BY LAYER (follow the numbered comments in the code) |
||||
# |
||||
# [1] ::opunk::TkConsole (module opunk::console::tk) is a voo value-based |
||||
# subclass of the -virtual base class ::opunk::Console. A console value |
||||
# is a plain Tcl list whose slot 0 carries the concrete class namespace |
||||
# tag, so existing holders calling BASE-class methods |
||||
# (::opunk::Console::size $obj, ::at_eof, ::can_respond) dispatch to the |
||||
# subclass overrides - no edits to the base class or punk::console were |
||||
# needed (that was G-001's acceptance constraint). TkConsole's overrides |
||||
# answer from the WIDGET: size = the text widget's ACTUAL character |
||||
# dimensions while mapped (current pixel size / font metrics - resize |
||||
# the window and watch the status bar and size queries follow; the |
||||
# requested -width/-height only answer for an unmapped widget), |
||||
# at_eof = a backend marker (::opunk::console::tk::set_eof) or widget |
||||
# destruction, can_respond/is_console_or_tty = 1 by construction. |
||||
# |
||||
# [2] ::opunk::console::tk::console $widget wires the widget as a LIVE |
||||
# console and returns a TkConsole whose in/out slots carry CHANNELS: |
||||
# - out: a reflected channel (chan create write); everything written |
||||
# to it is rendered into the widget (ansi-stripped when punk::ansi |
||||
# is present, \r\n normalized) |
||||
# - in: the read end of a chan pipe; the <Return> binding (proc |
||||
# 'submit') takes the text typed after the 'conin_start' mark (i.e |
||||
# since the last output) and writes it as one line to the pipe. |
||||
# ::opunk::console::tk::feed does the same programmatically. |
||||
# - <Destroy> on the widget runs 'teardown': flags backend eof and |
||||
# closes the pipe's write end, so the repl's reader sees eof. |
||||
# Because in/out are real channels, the channel-driven repl core needs |
||||
# no special casing - the repl reads/writes channels, and consults the |
||||
# console OBJECT for the capability questions. |
||||
# |
||||
# [3] repl::init -console $con resolves the spec via |
||||
# punk::console::console_spec_resolve and stores per-repl channel state |
||||
# (repl::conin/conout/conerr - conerr==conout for a foreign console; |
||||
# separate err channels are goal G-011). Because a foreign console is |
||||
# selected: |
||||
# - prompts/results are written to the console channels (rputs maps |
||||
# stdout/stderr per-repl; doprompt no longer needs tcl_interactive) |
||||
# - the codethread's CODE INTERP gets shellfilter 'var' JUNCTION |
||||
# stacks on its stdout/stderr: writes are diverted (no pass-through |
||||
# to the process std channels) and the repl emits the collected |
||||
# output to the console after each command run. Note the caveat: |
||||
# output of a run appears when the run completes - incremental |
||||
# output of a long-running command is not streamed (yet). |
||||
# - eof and size questions dispatch through repl::console_at_eof / |
||||
# repl::console_get_size to the TkConsole overrides ([1]). |
||||
# |
||||
# [4] repl::start (input channel omitted - it defaults to the selected |
||||
# console's input) blocks in a vwait servicing the event loop, which is |
||||
# what keeps Tk alive: key events fire the <Return> binding, the repl's |
||||
# readable handler fires on the input pipe, and the reflected output |
||||
# channel renders. Typing 'exit' (or 'quit') in the console - or |
||||
# destroying the window - completes repl::start and this script exits. |
||||
# |
||||
# [5] in-session size queries: 'punk::console::get_size' typed at the P% |
||||
# prompt is bridged (by this demo - see the commented block before |
||||
# repl::start) from the code interp back to this thread's |
||||
# repl::console_get_size, so it reports the tk console's CURRENT size, |
||||
# resize-aware, instead of the codethread's process console. This is a |
||||
# hand-rolled preview of G-008 scoped console state. |
||||
# |
||||
# CAVEATS WORTH KNOWING (also recorded in the archived G-001 detail file) |
||||
# - line mode only: raw-mode/editbuf interaction with foreign consoles is |
||||
# future work (G-013/G-044); there is no history/line-editing beyond what |
||||
# the text widget itself gives you. |
||||
# - code-interp output is emitted per-run (see [3]). |
||||
# - colour/raw-mode/ansi_wanted state is process-global (G-008): the repl |
||||
# may settle ansi capability for the whole process. |
||||
# |
||||
# ============================================================================= |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# BOOTSTRAP - make the punkshell dev modules reachable under plain tclsh. |
||||
# Under '<punkexe> script' (app-punkscript) the module environment is already |
||||
# set up and these requires just work. |
||||
# --------------------------------------------------------------------------- |
||||
if {[catch {package require punk::repl}]} { |
||||
#assume we are scriptlib/developer/<this file> inside a punkshell checkout |
||||
set checkout [file dirname [file dirname [file dirname [file normalize [info script]]]]] |
||||
if {[file isdirectory [file join $checkout src modules]]} { |
||||
package prefer latest ;#dev modules use alpha magic version 999999.0a1.0 |
||||
tcl::tm::add [file join $checkout src modules] [file join $checkout src vendormodules] |
||||
lappend ::auto_path [file join $checkout src lib] [file join $checkout src vendorlib] |
||||
} |
||||
package require punk::repl ;#errors usefully if we still can't find it |
||||
} |
||||
#repl::init -console arrived in punk::repl 0.4.0 (G-001). A punk kit built |
||||
#before that provides an older repl (and won't take the dev-path fallback |
||||
#above since punk::repl IS loadable) - fail with directions instead of an |
||||
#'unknown option' error later. |
||||
if {[package vcompare [package provide punk::repl] 0.4.0] < 0} { |
||||
puts stderr "tkconsole_demo: punk::repl [package provide punk::repl] is too old (need >= 0.4.0 for 'repl::init -console')." |
||||
puts stderr "Run from the source checkout (tclsh scriptlib/developer/tkconsole_demo.tcl), via '<punkexe> src script ...', or rebuild the kits." |
||||
exit 5 |
||||
} |
||||
package require punk::args |
||||
package require opunk::console::tk ;#loads WITHOUT Tk (class def only) ... |
||||
package require Tk ;#... Tk is needed for the live wiring below |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# Argument definition & parsing - a punk::args usage example in its own right: |
||||
# the definition is both the parser and the documentation ('i' inspectable in |
||||
# a punk shell once the namespace is registered, and rendered by --help here). |
||||
# --------------------------------------------------------------------------- |
||||
namespace eval ::developer::tkconsole_demo { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::developer::tkconsole_demo |
||||
@cmd -name "developer::tkconsole_demo"\ |
||||
-summary\ |
||||
"Interactive showcase: a punk repl on a Tk text widget console (G-001 tk backend)."\ |
||||
-help\ |
||||
"Wires a Tk text widget as a live ::opunk::TkConsole via |
||||
::opunk::console::tk::console and starts an interactive repl |
||||
against it with 'repl::init -console'. Type commands at the |
||||
P% prompt inside the widget; 'exit' (or closing the window) |
||||
ends the session. See the header comments of |
||||
scriptlib/developer/tkconsole_demo.tcl for a layer-by-layer |
||||
walkthrough of the mechanics." |
||||
@opts |
||||
-columns -type integer -default 100 -help\ |
||||
"text widget width in characters. |
||||
Also what the console's size method - and therefore |
||||
repl::console_get_size inside the running repl - reports." |
||||
-rows -type integer -default 30 -help\ |
||||
"text widget height in characters (see -columns)" |
||||
-font -type string -default TkFixedFont -help\ |
||||
"font for the console text widget" |
||||
-title -type string -default "punk repl on a Tk text widget (G-001)" -help\ |
||||
"window title" |
||||
-demo -type none -help\ |
||||
"auto-type a short scripted session first, using |
||||
::opunk::console::tk::feed (the programmatic input path the |
||||
verification tests use), then leave the session interactive" |
||||
-autoclose -type integer -default 0 -help\ |
||||
"destroy the window after this many milliseconds (0 = never). |
||||
Automation/testing aid: exercises the <Destroy> binding -> |
||||
::opunk::console::tk::teardown -> input-pipe eof path, after |
||||
which the repl finishes as if the terminal disconnected." |
||||
@values -min 0 -max 0 |
||||
}] |
||||
#register so 'i developer::tkconsole_demo' can find the definition in a punk shell |
||||
namespace eval ::punk::args::register { |
||||
lappend ::punk::args::register::NAMESPACES ::developer::tkconsole_demo |
||||
} |
||||
} |
||||
apply {{} { |
||||
foreach block $::developer::tkconsole_demo::PUNKARGS { |
||||
punk::args::define {*}$block |
||||
} |
||||
}} |
||||
|
||||
if {"--help" in $::argv || "-help" in $::argv} { |
||||
puts stdout [punk::args::usage ::developer::tkconsole_demo] |
||||
exit 0 |
||||
} |
||||
set argd [punk::args::parse $::argv withid ::developer::tkconsole_demo] |
||||
set opts [dict get $argd opts] |
||||
set opt_columns [dict get $opts -columns] |
||||
set opt_rows [dict get $opts -rows] |
||||
set opt_font [dict get $opts -font] |
||||
set opt_title [dict get $opts -title] |
||||
set opt_demo [dict exists [dict get $argd received] -demo] |
||||
set opt_autoclose [dict get $opts -autoclose] |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# UI - a text widget playing the terminal role, plus a small toolbar whose |
||||
# buttons poke the console OBJECT directly so you can watch the base-class |
||||
# methods dispatch to the TkConsole overrides ([1] in the header). |
||||
# --------------------------------------------------------------------------- |
||||
wm title . $opt_title |
||||
set txt [text .console -width $opt_columns -height $opt_rows -font $opt_font\ |
||||
-wrap char -background black -foreground green -insertbackground green\ |
||||
-yscrollcommand {.scroll set}] |
||||
scrollbar .scroll -command [list $txt yview] |
||||
frame .bar |
||||
label .bar.status -anchor w -text "console object: (not wired yet)" |
||||
button .bar.size -text "Query size" -command { |
||||
#Base-class call, subclass answer: ::opunk::Console::size dispatches on the |
||||
#value's slot-0 tag to TkConsole's override, which reads the WIDGET's |
||||
#character dimensions - no channel or terminal query involved. |
||||
.bar.status configure -text "size: [::opunk::Console::size $::con] at_eof: [::opunk::Console::at_eof $::con] can_respond: [::opunk::Console::can_respond $::con]" |
||||
} |
||||
button .bar.eof -text "End session (set_eof)" -command { |
||||
#Flag backend eof (the marker TkConsole's at_eof consults), then submit an |
||||
#empty line: at_eof is CONSULTED by the repl's reader when input arrives, |
||||
#so the nudge is what makes the repl notice and finish - a deliberate |
||||
#teaching point about where eof checks happen in the loop. |
||||
::opunk::console::tk::set_eof $::txt |
||||
::opunk::console::tk::feed $::txt "" |
||||
} |
||||
pack .bar.size .bar.eof -side left -padx 2 -pady 2 |
||||
pack .bar.status -side left -padx 8 |
||||
pack .bar -side bottom -fill x |
||||
pack .scroll -side right -fill y |
||||
pack $txt -side left -fill both -expand 1 |
||||
focus $txt |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# [2] Wire the widget as a live console. From here on: |
||||
# - $con is an ::opunk::TkConsole VALUE (try: lindex $con 0 -> class tag) |
||||
# - [::opunk::Console::in $con] is the input pipe's read end |
||||
# - [::opunk::Console::out $con] is the reflected channel -> widget |
||||
# - <Return> on the widget submits the current input line |
||||
# - destroying the widget tears the wiring down (eof to the repl) |
||||
# --------------------------------------------------------------------------- |
||||
set con [::opunk::console::tk::console $txt] |
||||
.bar.status configure -text "console object tag: [lindex $con 0] channels: [::opunk::Console::channels $con]" |
||||
|
||||
#Live resize feedback: TkConsole's size override computes the ACTUAL character |
||||
#dimensions from the widget's current pixel size and font metrics whenever the |
||||
#widget is mapped (the requested -width/-height only describe the initial |
||||
#size). <Configure> fires on every resize, so the status bar tracks reality - |
||||
#and the same override is what the repl's repl::console_get_size (and the |
||||
#in-session punk::console::get_size bridge below) report. |
||||
bind $txt <Configure> {+after idle {catch { |
||||
.bar.status configure -text "resized - console size now: [::opunk::Console::size $::con]" |
||||
}}} |
||||
|
||||
#Keep a transcript snapshot for the end-of-session report: the widget may be |
||||
#gone by then (autoclose or user close), and a <Destroy> binding is too late - |
||||
#when destruction cascades from the toplevel the widget command is already |
||||
#dead by the time its binding fires. Instead snapshot on every content change |
||||
#via the text widget's <<Modified>> virtual event (re-armed by resetting the |
||||
#modified flag). The '+' prefix APPENDS, preserving any existing bindings. |
||||
set ::final_transcript "" |
||||
bind $txt <<Modified>> {+ |
||||
catch {set ::final_transcript [%W get 1.0 end-1c]} |
||||
catch {%W edit modified 0} |
||||
} |
||||
|
||||
#Anything a holder writes to the console's out channel renders in the widget - |
||||
#the repl does exactly this internally (rputs/doprompt write repl::conout). |
||||
set outch [::opunk::Console::out $con] |
||||
puts $outch "=== tkconsole_demo: this banner was written to the console's out channel ===" |
||||
puts $outch "=== type Tcl at the P% prompt; 'exit' or closing the window ends it ===" |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# Optional scripted session (-demo): programmatic typing via feed - each line |
||||
# is inserted into the widget's input area and submitted exactly as the |
||||
# <Return> binding would. Staggered with 'after' so you can watch each |
||||
# command run; the repl services these timer events from inside repl::start. |
||||
# --------------------------------------------------------------------------- |
||||
#helper for the -demo resize step: grow the toplevel by a fixed pixel amount - |
||||
#the <Configure> binding updates the status bar and the next size query shows |
||||
#the console's reported dimensions following the window |
||||
proc ::developer::tkconsole_demo::grow_window {} { |
||||
catch {wm geometry . [expr {[winfo width .] + 240}]x[expr {[winfo height .] + 96}]} |
||||
} |
||||
|
||||
if {$opt_demo} { |
||||
set delay 1500 |
||||
foreach step { |
||||
{feed {set demo_x 7}} |
||||
{feed {expr {$demo_x * 6}}} |
||||
{feed {puts stdout "hello from the code interp (diverted to the widget)"}} |
||||
{feed {puts stderr "stderr lands here too (conerr==conout pending G-011)"}} |
||||
{feed {punk::console::get_size}} |
||||
{grow} |
||||
{feed {punk::console::get_size}} |
||||
} { |
||||
lassign $step kind line |
||||
switch -- $kind { |
||||
feed { |
||||
after $delay [list ::opunk::console::tk::feed $txt $line] |
||||
} |
||||
grow { |
||||
#resize happens in THIS (repl/Tk) thread; the two surrounding |
||||
#get_size queries run in the code interp and report the size |
||||
#before and after - proving the whole chain tracks the window |
||||
after $delay ::developer::tkconsole_demo::grow_window |
||||
} |
||||
} |
||||
incr delay 1200 |
||||
} |
||||
} |
||||
if {$opt_autoclose > 0} { |
||||
after $opt_autoclose {catch {destroy .}} |
||||
} |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# [3]+[4] Select the console and run the repl. init spins up the codethread |
||||
# and its code interp (with the output-diverting junction stacks, because a |
||||
# foreign console is selected); start blocks servicing events until 'exit', |
||||
# 'quit', or console eof. NOTE: -type 0 (the plain 'punk' code interp) is the |
||||
# repltype wired for foreign-console output diversion. |
||||
# --------------------------------------------------------------------------- |
||||
repl::init -type 0 -console $con |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# In-session size queries: make 'punk::console::get_size' typed at the P% |
||||
# prompt answer with THIS console's current size. |
||||
# |
||||
# Why this needs wiring at all: commands you type run in the CODE INTERP, |
||||
# which lives in the codethread - a different thread with no Tk and no access |
||||
# to this thread's channels or widget. A plain punk::console::get_size there |
||||
# would report the codethread's own default console (the process console - |
||||
# actively misleading inside a tk-console session). |
||||
# |
||||
# The bridge reuses the pattern the repl itself uses for its 'colour'/'mode'/ |
||||
# 'vt52' code-interp aliases: an alias in the code interp targets a proc in |
||||
# the codethread's MAIN interp, which thread::sends the query back to this |
||||
# (repl) thread, where repl::console_get_size dispatches to the TkConsole |
||||
# size override - so it tracks live resizing just like the Query size button. |
||||
# The synchronous send is serviced because the repl runs 'update' while it |
||||
# waits for a command to complete (the same property the G-007 owner-routed |
||||
# queries rely on). |
||||
# |
||||
# NOTE this is a hand-rolled, single-proc preview of "scoped console state |
||||
# for subshells" - goal G-008 owns the general answer (ALL punk::console |
||||
# state/queries scoped to the selected console, not just get_size). It is |
||||
# installed by the DEMO, not by repl::init, precisely because the general |
||||
# design is still G-008's to make. (Without the bridge you could still reach |
||||
# the repl thread explicitly with: repl eval repl::console_get_size) |
||||
# |
||||
# Ordering: repl::init queued its codethread init_script asynchronously; this |
||||
# synchronous thread::send lands AFTER it in the codethread's event queue, so |
||||
# the code interp (and its punk::console package) exist by the time it runs. |
||||
# --------------------------------------------------------------------------- |
||||
thread::send $::repl::codethread [string map [list %replthread% [thread::id]] { |
||||
namespace eval ::tkconsole_demo_helpers { |
||||
proc console_get_size {args} { |
||||
#query the repl thread's selected console (the tk widget console) |
||||
thread::send %replthread% {repl::console_get_size} |
||||
} |
||||
} |
||||
interp alias code ::punk::console::get_size {} ::tkconsole_demo_helpers::console_get_size |
||||
}] |
||||
|
||||
set done [repl::start] |
||||
|
||||
# repl::start returned: report how the session ended. The window may already |
||||
# be gone (autoclose / user closed it - even the Tk application itself may be |
||||
# destroyed); the process stdout may or may not be visible depending on how we |
||||
# were launched - all reports are best-effort. |
||||
catch {puts stdout "tkconsole_demo: repl finished with: $done"} |
||||
if {![catch {$txt get 1.0 end-1c} live_transcript]} { |
||||
set ::final_transcript $live_transcript ;#widget still alive - freshest copy |
||||
} |
||||
catch {puts stdout "tkconsole_demo: final transcript:\n$::final_transcript"} |
||||
catch {destroy .} |
||||
exit 0 |
||||
Loading…
Reference in new issue