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