Browse Source

vfscommonupdate: sync pending built modules into _vfscommon.vfs

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.com
master
Julian Noble 2 weeks ago
parent
commit
4924fca21b
  1. 2
      src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl
  2. 111
      src/vfs/_vfscommon.vfs/modules/opunk/console/ssh-0.1.0.tm
  3. 120
      src/vfs/_vfscommon.vfs/modules/opunk/console/test-0.1.0.tm
  4. 154
      src/vfs/_vfscommon.vfs/modules/opunk/console/tk-0.1.0.tm
  5. 105
      src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.2.0.tm
  6. 86
      src/vfs/_vfscommon.vfs/modules/punk/sshrun-0.1.0.tm

2
src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl

@ -1,7 +1,7 @@
package provide app-punkscript 1.0
#Lean one-shot script runner for the punk executable 'script' subcommand (goal G-015).
#
#Contract (G-015 - see goals/G-015-script-subcommand-piped-stdin.md):
#Contract (G-015 - see goals/archive/G-015-script-subcommand-piped-stdin.md):
# - runs a script FILE (first argument, remaining arguments become the script's ::argv)
# or, with no arguments, the whole of piped/redirected stdin as the script.
# - the script interp carries the default punk shell module/alias environment

111
src/vfs/_vfscommon.vfs/modules/opunk/console/ssh-0.1.0.tm

@ -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

120
src/vfs/_vfscommon.vfs/modules/opunk/console/test-0.1.0.tm

@ -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

154
src/vfs/_vfscommon.vfs/modules/opunk/console/tk-0.1.0.tm

@ -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

105
src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.1.0.tm → src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.2.0.tm

@ -8,7 +8,7 @@
# (C) 2025
#
# @@ Meta Begin
# Application punk::args::moduledoc::tclcore 0.1.0
# Application punk::args::moduledoc::tclcore 0.2.0
# Meta platform tcl
# Meta license MIT
# @@ Meta End
@ -18,7 +18,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::args::moduledoc::tclcore 0 0.1.0]
#[manpage_begin punkshell_module_punk::args::moduledoc::tclcore 0 0.2.0]
#[copyright "2025"]
#[titledesc {punk::args definitions for tcl core commands}] [comment {-- Name section and table of contents description --}]
#[moddesc {tcl core argument definitions}] [comment {-- Description at end of page heading --}]
@ -9817,41 +9817,37 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
# ==============================================================================================================
punk::args::define [punk::args::lib::tstr -return string {
@id -id ::tcl::string::is
@cmd -name "Built-in: tcl::string::is"\
-summary\
"Test character class of string."\
-help\
"Returns 1 if string is a valid member of the specified character class, otherwise returns 0.
"
@leaders -min 1 -max 1
class -type string\
-choices {
alnum
alpha
ascii
boolean
control
dict
digit
double
entier
false
graph
integer
list
lower
print
punct
space
true
upper
wideinteger
wordchar
xdigit
}\
-choicelabels {
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#G-054: the 'string is' class set is harvested from the RUNNING interpreter rather
#than hard-coded. It varies by tcl version (8.6 has no dict class; the unreleased
#8.7 series added unicode, which tcl 9 removed) and a static list breaks
#accept/reject parity between these docs and the interpreter they load into.
#A deliberately invalid probe of the pure builtin (safe, side-effect free) yields
#the authoritative list from its error message:
# bad class "zzz": must be alnum, alpha, ..., or xdigit
set string_is_classes [list]
if {[catch {string is __punk_argdoc_probe__ x} _sis_msg]} {
if {[regexp {must be (.+)$} $_sis_msg -> _sis_csv]} {
foreach _sis_c [split $_sis_csv ,] {
set _sis_c [string trim $_sis_c]
if {[string match "or *" $_sis_c]} {
set _sis_c [string range $_sis_c 3 end]
}
if {$_sis_c ne ""} {
lappend string_is_classes $_sis_c
}
}
}
}
if {![llength $string_is_classes]} {
#harvest failed (unexpected error message format) - fall back to the tcl 9.0 set
set string_is_classes {alnum alpha ascii boolean control dict digit double entier false graph integer list lower print punct space true upper wideinteger wordchar xdigit}
}
set string_is_classes [lsort $string_is_classes] ;#display order (as the previous hand-written list)
#hand-written class descriptions (man-page derived, verbatim) - applied below only for
#classes the running interpreter accepts; accepted classes without an entry get a
#generic label. tstr here resolves the ${$A_WARN}/${$A_RST} highlights as before.
set string_is_class_descriptions [punk::args::lib::tstr -return string {
alnum
" Any Unicode alphabet
or digit character"
@ -9877,7 +9873,9 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
will contain the index of
the \"element\" where the
dict parsing fails or -1 if
this cannot be determined."
this cannot be determined.
(class not present in
Tcl 8.6)"
digit
" Any Unicode digit char.
Note that this includes
@ -9937,6 +9935,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
" Any of the forms allowed
for Tcl_GetBoolean where the
value is true"
unicode
" Any Unicode character.
(class exists only in the
unreleased Tcl 8.7 series -
removed in Tcl 9)"
upper
" Any upper case alphabet
character in the Unicode
@ -9959,7 +9962,29 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
xdigit
" Any hexadecimal digit
character ([0-9A-Fa-f])."
}\
}]
set string_is_choicelabels ""
foreach _sis_c $string_is_classes {
if {[dict exists $string_is_class_descriptions $_sis_c]} {
append string_is_choicelabels [list $_sis_c] " " [list [dict get $string_is_class_descriptions $_sis_c]] \n
} else {
append string_is_choicelabels [list $_sis_c] " " [list " (class accepted by this Tcl\n runtime - not yet described\n in the punk tclcore docs)"] \n
}
}
unset -nocomplain _sis_msg _sis_csv _sis_c
punk::args::define [punk::args::lib::tstr -return string {
@id -id ::tcl::string::is
@cmd -name "Built-in: tcl::string::is"\
-summary\
"Test character class of string."\
-help\
"Returns 1 if string is a valid member of the specified character class, otherwise returns 0.
"
@leaders -min 1 -max 1
class -type string\
-choices {${$string_is_classes}}\
-choicelabels {${$string_is_choicelabels}}\
-help\
"character class
In the case of boolean, true and false, if the function will return 0, then the
@ -12518,7 +12543,7 @@ namespace eval ::punk::args::register {
package provide punk::args::moduledoc::tclcore [tcl::namespace::eval punk::args::moduledoc::tclcore {
variable pkg punk::args::moduledoc::tclcore
variable version
set version 0.1.0
set version 0.2.0
}]
return

86
src/vfs/_vfscommon.vfs/modules/punk/sshrun-0.1.0.tm

@ -55,6 +55,92 @@
#[subsection Concepts]
#[para] -
####### original wiki documentation
## Overview
## Tclssh is a package of pure Tcl functions for executing Tcl scripts in a remote host. It is used by Nbsp and the WRFPak to offload some long-time running jobs in parallel to other computers.
##
## The remote host must be accessible via ssh keys without a password; that is, for example, the contents of your ./ssh/id_rsa.pub must be added to the .ssh/authorized_keys file in the remote host.
##
## The directory
##
## <prefix>/share/doc/examples
## has several examples that can be used for testing and documentation.
##
## Example
## The best way to explain how to use is by looking at one of them, ex-1.tcl.
##
## #!/usr/bin/tclsh
##
## package require ssh
##
## #
## # Collect in the string "script" the script that will be sent to the
## # remote (slave) host.
## #
## set script {
## puts "I am a remote host named [info hostname] executing a script
## that my master sent me. I am going to sent him back the results of some
## commands. Here they are:
##
## The date is: [exec date]
## My info is: [exec uname -a]
##
## Now I need to inform my master that I have finished.
##
## DONE 0"
## };
##
## set slave "is.1-loop.net"; # This is the remote host
##
## #
## # If the tcl shell in the remote host is just "tclsh" (e.g. a linux system)
## # the -t option (and its argment) can be omitted; otherwise it can be
## # used to specify the name of the remote tcl shell.
## #
## ::ssh::connect -t tclsh8.6 -- $slave
## ::ssh::push $slave $script
## ::ssh::send $slave;
## while {[::ssh::pop_line $slave line] >= 0} {
## if {[regexp {^DONE\s+(\d+)} $line match code]} {
## break;
## }
## puts $line;
## }
## ::ssh::disconnect $slave;
##
## puts "Slave finished with code: $code";
## Below is the output of executing ex-1.tcl from a machine named elite:
##
## [nieves@elite examples]$ ./ex-1.tcl
## I am a remote host named is.1-loop.net executing a script
## that my master sent me. I am going to sent him back the results of some
## commands. Here they are:
##
## The date is: Sun Dec 9 17:35:43 AST 2012
## My info is: Linux is 2.6.32-308.8.2.el5.028stab101.1 #1 SMP Sun Jun 24 20:25:35 MSD 2012 i686 GNU/Linux
##
## Now I need to inform my master that I have finished.
## Slave finished with code: 0
## [nieves@elite examples]$
## Several other examples in the
##
## <prefix>/share/doc/examples
## directory illustrate more capabilities of this package.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements

Loading…
Cancel
Save