#! /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): # 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 destroy the window after (automation/testing aid - # exercises the -> 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 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. # - 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 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 ' 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/ 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 ' 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 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 # - 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). 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 {+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 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 <> virtual event (re-armed by resetting the #modified flag). The '+' prefix APPENDS, preserving any existing bindings. set ::final_transcript "" bind $txt <> {+ 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 # 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 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