punkshell/scriptlib/developer/tkconsole_demo.tcl

#! /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