Browse Source
Catch-up vfs sync for module work committed earlier without a vfscommonupdate pass: opunk::console backend modules (G-001 increment 1), punk::sshrun 0.1.0, punk::args::moduledoc::tclcore 0.1.0 -> 0.2.0, app-punkscript punkscript.tcl. All copies verified byte-identical to their committed sources modulo build version stamping. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
6 changed files with 537 additions and 41 deletions
@ -0,0 +1,111 @@ |
|||||||
|
# -*- tcl -*- |
||||||
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||||
|
# |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# (C) 2026 |
||||||
|
# |
||||||
|
# @@ Meta Begin |
||||||
|
# Application opunk::console::ssh 0.1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license BSD |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
package require Tcl 8.6- |
||||||
|
package require voo |
||||||
|
package require opunk::console |
||||||
|
|
||||||
|
#opunk::SshConsole - an ::opunk::Console backend for terminal sessions carried over a |
||||||
|
#socket-like channel pair (G-001) - the ssh-channel case: a remote user's terminal is on |
||||||
|
#the other end of the connection, but the local channel is a plain socket exposing none |
||||||
|
#of the signals terminal detection relies on (-inputmode/-mode, twapi handles, env hints). |
||||||
|
# |
||||||
|
#The backend is CONSTRUCTED knowing the far end is a terminal, so: |
||||||
|
# - is_console_or_tty: always 1 (explicit construction-time knowledge, not detection) |
||||||
|
# - can_respond: settled value if set, else 1 (the remote terminal answers ANSI |
||||||
|
# queries carried over the connection) |
||||||
|
# - at_eof: plain [chan eof] on the channel - deliberately NO base-class |
||||||
|
# pipe-probe: probing a socket would consume a byte the protocol |
||||||
|
# layer/reader needs (see goals/G-001 detail) |
||||||
|
# - size: the registered ::opunk::console::size_query_provider when |
||||||
|
# available (punk::console's ANSI cursor-report mechanisms operate |
||||||
|
# over the channel pair like any other console), else the |
||||||
|
# configured default size. No -winsize attempt (sockets have none). |
||||||
|
# |
||||||
|
#No edits to the base ::opunk::Console or punk::console are needed (G-001 acceptance). |
||||||
|
|
||||||
|
voo::class ::opunk::SshConsole -extends ::opunk::Console { |
||||||
|
public { |
||||||
|
method is_console_or_tty {} { |
||||||
|
return 1 |
||||||
|
} |
||||||
|
method can_respond {} { |
||||||
|
set settled [get.o_can_respond $this] |
||||||
|
if {$settled != -1} { |
||||||
|
return $settled |
||||||
|
} |
||||||
|
return 1 |
||||||
|
} |
||||||
|
method at_eof {} { |
||||||
|
set in [::opunk::Console::in $this] |
||||||
|
if {[catch {chan eof $in} is_eof]} { |
||||||
|
return 1 ;#closed/invalid channel - unusable |
||||||
|
} |
||||||
|
return $is_eof |
||||||
|
} |
||||||
|
method size {} { |
||||||
|
if {![can_respond $this]} { |
||||||
|
return [::opunk::Console::default_size $this] |
||||||
|
} |
||||||
|
if {$::opunk::console::size_query_provider ne ""} { |
||||||
|
if {![catch {{*}$::opunk::console::size_query_provider $this} sized]} { |
||||||
|
if {[dict size $sized] && [string is integer -strict [dict get $sized columns]] && [string is integer -strict [dict get $sized rows]]} { |
||||||
|
return $sized |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
return [::opunk::Console::default_size $this] |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
constructor {in out} { |
||||||
|
#in/out: the channel pair of the connection (a single socket channel may be |
||||||
|
#passed for both). Parent fields are private - set via imported index variables. |
||||||
|
variable o_in |
||||||
|
variable o_out |
||||||
|
set obj [new()] |
||||||
|
lset obj $o_in $in |
||||||
|
lset obj $o_out $out |
||||||
|
return $obj |
||||||
|
} |
||||||
|
} |
||||||
|
namespace eval ::opunk::SshConsole { |
||||||
|
namespace ensemble create |
||||||
|
} |
||||||
|
|
||||||
|
tcl::namespace::eval ::opunk::console::ssh { |
||||||
|
tcl::namespace::export {[a-z]*} |
||||||
|
variable PUNKARGS |
||||||
|
|
||||||
|
lappend PUNKARGS [list { |
||||||
|
@id -id "(package)opunk::console::ssh" |
||||||
|
@package -name "opunk::console::ssh" -help\ |
||||||
|
"voo class ::opunk::SshConsole - an ::opunk::Console backend for terminal sessions |
||||||
|
carried over socket-like channels (e.g an ssh connection): constructed knowing the |
||||||
|
far end is a terminal, eof via chan eof (no byte-consuming probe), size via the |
||||||
|
registered ANSI size-query provider over the connection (G-001)." |
||||||
|
}] |
||||||
|
} |
||||||
|
|
||||||
|
namespace eval ::punk::args::register { |
||||||
|
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||||
|
lappend ::punk::args::register::NAMESPACES ::opunk::console::ssh ::opunk::SshConsole |
||||||
|
} |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
package provide opunk::console::ssh [tcl::namespace::eval ::opunk::console::ssh { |
||||||
|
variable pkg opunk::console::ssh |
||||||
|
variable version |
||||||
|
set version 0.1.0 |
||||||
|
}] |
||||||
|
return |
||||||
@ -0,0 +1,120 @@ |
|||||||
|
# -*- tcl -*- |
||||||
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||||
|
# |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# (C) 2026 |
||||||
|
# |
||||||
|
# @@ Meta Begin |
||||||
|
# Application opunk::console::test 0.1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license BSD |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
package require Tcl 8.6- |
||||||
|
package require voo |
||||||
|
package require opunk::console |
||||||
|
|
||||||
|
#opunk::TestConsole - a scripted/deterministic ::opunk::Console backend (G-001). |
||||||
|
# |
||||||
|
#The first client of the pluggable-backend seam and the console TEST DOUBLE the repl |
||||||
|
#characterization work needs (see goals/G-044 detail - class_editbuf and raw-mode |
||||||
|
#behaviours are console-coupled and cannot be unit-tested against a live terminal). |
||||||
|
# |
||||||
|
#Wraps a caller-supplied channel pair (typically [chan pipe] ends or reflected channels |
||||||
|
#owned by a test harness) and answers the capability/size questions DETERMINISTICALLY: |
||||||
|
# - is_console_or_tty: always 1 (constructed knowing it plays the terminal role) |
||||||
|
# - can_respond: settled value if set, else 1 |
||||||
|
# - at_eof: plain [chan eof] on the input channel - NEVER probes (a probe |
||||||
|
# would consume a byte the test harness scripted) |
||||||
|
# - size: the configured size - no -winsize, no query emission, no |
||||||
|
# size_query_provider consultation. Set at construction |
||||||
|
# (-columns/-rows) and stored in the inherited o_default_size. |
||||||
|
# |
||||||
|
#No edits to the base ::opunk::Console or punk::console are needed (G-001 acceptance): |
||||||
|
#values carry this class's namespace tag at slot 0 and existing holders (e.g |
||||||
|
#punk::console::console_spec_resolve callers) dispatch to these overrides virtually. |
||||||
|
|
||||||
|
voo::class ::opunk::TestConsole -extends ::opunk::Console { |
||||||
|
public { |
||||||
|
method is_console_or_tty {} { |
||||||
|
return 1 |
||||||
|
} |
||||||
|
method can_respond {} { |
||||||
|
set settled [get.o_can_respond $this] |
||||||
|
if {$settled != -1} { |
||||||
|
return $settled |
||||||
|
} |
||||||
|
return 1 |
||||||
|
} |
||||||
|
method at_eof {} { |
||||||
|
set in [::opunk::Console::in $this] |
||||||
|
if {[catch {chan eof $in} is_eof]} { |
||||||
|
return 1 ;#closed/invalid channel - unusable |
||||||
|
} |
||||||
|
return $is_eof |
||||||
|
} |
||||||
|
method size {} { |
||||||
|
return [::opunk::Console::default_size $this] |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
constructor {in out args} { |
||||||
|
#args: optional -columns <int> -rows <int> (default 80x24 from the base field). |
||||||
|
#Parent fields are private, so their imported INDEX variables are used to set |
||||||
|
#slots on the child-tagged default value (the voo -extends pattern for |
||||||
|
#initialising inherited private fields). |
||||||
|
variable o_in |
||||||
|
variable o_out |
||||||
|
variable o_default_size |
||||||
|
set obj [new()] |
||||||
|
lset obj $o_in $in |
||||||
|
lset obj $o_out $out |
||||||
|
set size [lindex $obj $o_default_size] |
||||||
|
foreach {k v} $args { |
||||||
|
switch -- $k { |
||||||
|
-columns { |
||||||
|
dict set size columns $v |
||||||
|
} |
||||||
|
-rows { |
||||||
|
dict set size rows $v |
||||||
|
} |
||||||
|
default { |
||||||
|
error "opunk::TestConsole::new unknown option '$k'. Known options: -columns -rows" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
lset obj $o_default_size $size |
||||||
|
return $obj |
||||||
|
} |
||||||
|
} |
||||||
|
namespace eval ::opunk::TestConsole { |
||||||
|
namespace ensemble create |
||||||
|
} |
||||||
|
|
||||||
|
tcl::namespace::eval ::opunk::console::test { |
||||||
|
tcl::namespace::export {[a-z]*} |
||||||
|
variable PUNKARGS |
||||||
|
|
||||||
|
lappend PUNKARGS [list { |
||||||
|
@id -id "(package)opunk::console::test" |
||||||
|
@package -name "opunk::console::test" -help\ |
||||||
|
"voo class ::opunk::TestConsole - a scripted/deterministic ::opunk::Console backend |
||||||
|
wrapping a caller-supplied channel pair (e.g chan pipe ends) with fixed capability |
||||||
|
answers and a configured size. The console test double for harness-driven repl and |
||||||
|
editbuf testing (G-001)." |
||||||
|
}] |
||||||
|
} |
||||||
|
|
||||||
|
namespace eval ::punk::args::register { |
||||||
|
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||||
|
lappend ::punk::args::register::NAMESPACES ::opunk::console::test ::opunk::TestConsole |
||||||
|
} |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
package provide opunk::console::test [tcl::namespace::eval ::opunk::console::test { |
||||||
|
variable pkg opunk::console::test |
||||||
|
variable version |
||||||
|
set version 0.1.0 |
||||||
|
}] |
||||||
|
return |
||||||
@ -0,0 +1,154 @@ |
|||||||
|
# -*- tcl -*- |
||||||
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||||
|
# |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# (C) 2026 |
||||||
|
# |
||||||
|
# @@ Meta Begin |
||||||
|
# Application opunk::console::tk 0.1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license BSD |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
package require Tcl 8.6- |
||||||
|
package require voo |
||||||
|
package require opunk::console |
||||||
|
#NOTE: deliberately NO 'package require Tk' here - the class definition is loadable |
||||||
|
#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). |
||||||
|
|
||||||
|
#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) |
||||||
|
# - 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) |
||||||
|
# - at_eof: a backend eof MARKER, not a channel eof: 1 when the widget no |
||||||
|
# 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. |
||||||
|
# |
||||||
|
#No edits to the base ::opunk::Console or punk::console are needed (G-001 acceptance). |
||||||
|
|
||||||
|
tcl::namespace::eval ::opunk::console::tk { |
||||||
|
#backend eof markers keyed by widget path - set via set_eof, consulted by at_eof |
||||||
|
variable eof_flags |
||||||
|
if {![array exists eof_flags]} { |
||||||
|
array set eof_flags {} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
voo::class ::opunk::TkConsole -extends ::opunk::Console { |
||||||
|
public { |
||||||
|
method is_console_or_tty {} { |
||||||
|
return 1 |
||||||
|
} |
||||||
|
method can_respond {} { |
||||||
|
set settled [get.o_can_respond $this] |
||||||
|
if {$settled != -1} { |
||||||
|
return $settled |
||||||
|
} |
||||||
|
return 1 |
||||||
|
} |
||||||
|
method at_eof {} { |
||||||
|
set w [::opunk::Console::in $this] |
||||||
|
if {[info exists ::opunk::console::tk::eof_flags($w)] && $::opunk::console::tk::eof_flags($w)} { |
||||||
|
return 1 |
||||||
|
} |
||||||
|
if {[catch {winfo exists $w} exists]} { |
||||||
|
#Tk not loaded (or not usable) in this interp - the widget cannot be |
||||||
|
#driven from here; report eof rather than pretending liveness |
||||||
|
return 1 |
||||||
|
} |
||||||
|
return [expr {!$exists}] |
||||||
|
} |
||||||
|
method size {} { |
||||||
|
set w [::opunk::Console::in $this] |
||||||
|
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} { |
||||||
|
return [dict create columns $cols rows $rows] |
||||||
|
} |
||||||
|
} |
||||||
|
return [::opunk::Console::default_size $this] |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
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. |
||||||
|
variable o_in |
||||||
|
variable o_out |
||||||
|
variable o_terminal_class |
||||||
|
set obj [new()] |
||||||
|
lset obj $o_in $widget |
||||||
|
lset obj $o_out $widget |
||||||
|
lset obj $o_terminal_class tk-text |
||||||
|
return $obj |
||||||
|
} |
||||||
|
} |
||||||
|
namespace eval ::opunk::TkConsole { |
||||||
|
namespace ensemble create |
||||||
|
} |
||||||
|
|
||||||
|
tcl::namespace::eval ::opunk::console::tk { |
||||||
|
tcl::namespace::export {[a-z]*} |
||||||
|
variable PUNKARGS |
||||||
|
|
||||||
|
#flag (or clear) backend eof for a widget-backed console - e.g when the hosting |
||||||
|
#frame/toplevel is being torn down but holders may still consult the console value |
||||||
|
proc set_eof {widget {value 1}} { |
||||||
|
variable eof_flags |
||||||
|
set eof_flags($widget) [expr {bool($value)}] |
||||||
|
return |
||||||
|
} |
||||||
|
|
||||||
|
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)." |
||||||
|
}] |
||||||
|
lappend PUNKARGS [list { |
||||||
|
@id -id ::opunk::console::tk::set_eof |
||||||
|
@cmd -name opunk::console::tk::set_eof\ |
||||||
|
-summary\ |
||||||
|
"Flag or clear backend eof for a widget-backed console."\ |
||||||
|
-help\ |
||||||
|
"Sets the backend eof marker consulted by ::opunk::TkConsole at_eof. |
||||||
|
Use when the hosting frame/toplevel is being torn down (or reopened) while |
||||||
|
holders may still consult console values wrapping the widget." |
||||||
|
@leaders -min 1 -max 1 |
||||||
|
widget -type string -help\ |
||||||
|
"Tk widget path the console wraps" |
||||||
|
@values -min 0 -max 1 |
||||||
|
value -type boolean -default 1 -optional 1 -help\ |
||||||
|
"1 to flag eof (default), 0 to clear" |
||||||
|
}] |
||||||
|
} |
||||||
|
|
||||||
|
namespace eval ::punk::args::register { |
||||||
|
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||||
|
lappend ::punk::args::register::NAMESPACES ::opunk::console::tk ::opunk::TkConsole |
||||||
|
} |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
package provide opunk::console::tk [tcl::namespace::eval ::opunk::console::tk { |
||||||
|
variable pkg opunk::console::tk |
||||||
|
variable version |
||||||
|
set version 0.1.0 |
||||||
|
}] |
||||||
|
return |
||||||
Loading…
Reference in new issue