jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

size mechanisms as overridable Console methods (subclass dispatch from punk::console) 

opunk::console (0.3.0):
- base size method resolution order: -winsize fast path -> capability gate (settled or heuristic
  can_respond; unresponsive consoles get default_size with no query emission) -> pluggable
  ::opunk::console::size_query_provider -> default_size. The provider hook follows the
  waiting-store pattern: the class carries no punk::console dependency, and non-channel
  subclasses (tk widget / channel-environment terminals) simply override size.

punk::console (0.1.7):
- get_size dispatches object-governed calls through the virtual ::opunk::Console::size method
  after first-use settling - subclass size overrides are honoured from every punk::console
  call site
- ANSI/tput mechanisms + per-pair timing cache factored into size_via_query_mechanisms, shared
  by the legacy channel-pair path and the registered provider (console_size_provider)
- integration wiring consolidated into once-latched ensure_object_integration (probe-byte store
  redirect + provider registration, respecting customised providers), invoked from
  default_console, console_spec_resolve lazy-require sites and the get_size object path
- legacy path returns the documented 80x24 fallback instead of erroring when undetermined

tests: WidgetishConsole subclass override returned through punk::console::get_size for both
anchored-name and object-value specs; class-level provider consultation/capability-gating with
a counting fake provider; provider registration assert. Console suites 27/27 + 10/10; punkexe
6/6, goals 8/8; full suite green except pre-existing exec-14.3.

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 2 weeks ago
parent
c6ead68a89
commit
c5f17a6447
15 changed files with 21022 additions and 47 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 399
      src/bootsupport/modules/opunk/console-0.3.0.tm
  2. 4814
      src/bootsupport/modules/punk/console-0.1.7.tm
  3. 1
      src/modules/opunk/AGENTS.md
  4. 33
      src/modules/opunk/console-999999.0a1.0.tm
  5. 3
      src/modules/opunk/console-buildversion.txt
  6. 106
      src/modules/punk/console-999999.0a1.0.tm
  7. 3
      src/modules/punk/console-buildversion.txt
  8. 399
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/opunk/console-0.3.0.tm
  9. 4814
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.7.tm
  10. 399
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/opunk/console-0.3.0.tm
  11. 4814
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.7.tm
  12. 34
      src/tests/modules/opunk/console/testsuites/console/consoleclass.test
  13. 37
      src/tests/modules/punk/console/testsuites/console/consolespec.test
  14. 399
      src/vfs/_vfscommon.vfs/modules/opunk/console-0.3.0.tm
  15. 4814
      src/vfs/_vfscommon.vfs/modules/punk/console-0.1.7.tm

399
src/bootsupport/modules/opunk/console-0.3.0.tm
Unescape View File

@ -0,0 +1,399 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.4.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2026
#
# @@ Meta Begin
# Application opunk::console 0.3.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
package require Tcl 8.6-
package require voo
package require punk::args
#opunk::Console - a voo (value-based) representation of a console: an in/out channel pair claimed to
#belong to one responding endpoint, together with settled capability facts about that endpoint.
#
#Motivation (see punk::console get_size / get_ansi_response_payload history):
#ANSI query mechanisms assume the input channel receives what the output channel's device emits in
#response. When stdio is redirected that pairing silently breaks - queries go to a terminal whose
#replies land in some other process's input. A console object makes the pairing an explicit,
#construction-time property instead of a per-query-site guess.
#
#Design notes:
# - Objects are voo values (plain lists). Consoles are entities, not values - so canonical instances
# are anchored at well-known namespace variables (::opunk::console::instances::<name>) and the value
# semantics serve as cheap snapshots. Mutation (settling capabilities) goes through the anchor via
# the lowercase ::opunk::console wrapper procs.
# - The class is -virtual: slot 0 of each value carries the concrete class namespace, so channel
# environments that respond like terminals but aren't platform consoles can subclass
# (-extends ::opunk::Console) and override the capability/size methods, with existing holders of
# console values dispatching correctly.
# - This first cut is standalone and passive: capability detection is heuristic (channel options,
# probed eof, terminal env hints) and size uses chan -winsize else the default size. Active ANSI
# query probing arrives with punk::console integration (which will delegate here rather than the
# class depending on punk::console).
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
#well-known cooperative store for bytes consumed by probe reads on pipe-like channels:
#an array keyed by channel name -> list of chunks. Readers taking over a channel should consume
#and clear any entry for that channel first.
#The store is PLUGGABLE via waiting_chunks_arrayvar: environments with an established cooperative
#store (e.g punk::console::input_chunks_waiting, which the punk repl reader consults) redirect it
#so probe-consumed bytes are never invisible to the active reader. The class itself stays free of
#any punk::console dependency - redirection is performed by the integrating layer.
variable waiting_chunks
if {![array exists waiting_chunks]} {
array set waiting_chunks {}
}
variable waiting_chunks_arrayvar
if {![info exists waiting_chunks_arrayvar]} {
set waiting_chunks_arrayvar ::opunk::console::waiting_chunks
}
#Pluggable size-query provider: a command prefix invoked as {*}$size_query_provider <consoleobj>
#returning a dict {columns <int> rows <int>} - or an empty dict/error when size cannot be
#determined. The base ::opunk::Console::size method consults it (after the fast -winsize path and
#capability gating) so channel-based consoles gain ANSI query mechanisms when an integrating layer
#registers one (punk::console registers console_size_provider) - while this class carries no
#dependency on that machinery, and non-channel subclasses simply override size and never touch it.
variable size_query_provider
if {![info exists size_query_provider]} {
set size_query_provider ""
}
}
voo::class ::opunk::Console -virtual {
private {
#o_ prefix per opunk voo convention (distinguishes fields from locals in -update methods,
#and matches tclOO-style implementations elsewhere for easier code movement).
#Note the class is -virtual: slot 0 of the object value is the concrete class namespace tag.
string_t o_in stdin
string_t o_out stdout
string_t o_terminal_class "" ;#e.g windows-console, tty, pipe - "" until classified
list_t o_size_mechanism [list] ;#preferred size mechanism try-order - empty until timed/settled
dict_t o_default_size [dict create columns 80 rows 24]
}
public {
#settled response capability: -1 unknown, 0 cannot respond, 1 can respond.
#public accessors (get.o_can_respond / set.o_can_respond) so the anchored-mutation wrappers in
#::opunk::console can settle it without reaching into private my.* accessors.
int_t o_can_respond -1
method in {} {
my.get.o_in $this
}
method out {} {
my.get.o_out $this
}
method channels {} {
list [my.get.o_in $this] [my.get.o_out $this]
}
method terminal_class {} {
my.get.o_terminal_class $this
}
method default_size {} {
my.get.o_default_size $this
}
#Certainty test: is the input channel closed or at eof (and so can never deliver a response)?
#A consumed/half-closed pipe may not flag eof until a read is attempted, so pipe-like channels
#get a non-blocking 1-byte probe. A probed byte is preserved in the cooperative waiting store
#(array named by ::opunk::console::waiting_chunks_arrayvar - redirectable by the integrating
#layer to e.g punk::console::input_chunks_waiting so active readers can find it).
#Console/tty channels are never probed (must not consume a keystroke).
method at_eof {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan eof $in} is_eof]} {
return 1 ;#closed/invalid channel - unusable
}
if {$is_eof} {
return 1
}
if {[catch {chan configure $in} conf]} {
return 1
}
if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} {
return 0
}
if {[catch {
set prior_blocking [dict get $conf -blocking]
chan configure $in -blocking 0
set probe [read $in 1]
chan configure $in -blocking $prior_blocking
}]} {
return 1
}
if {$probe ne ""} {
upvar #0 $::opunk::console::waiting_chunks_arrayvar wchunks
lappend wchunks($in) $probe
}
return [chan eof $in]
}
#Heuristic: could the input channel be connected to a terminal able to answer queries?
#Returns 0 only when reasonably confident it cannot. mintty without winpty presents a
#terminal's stdin as a plain pipe, so env hints (MSYSTEM, TERM_PROGRAM) prevent false
#negatives there at the cost of false positives for genuinely piped-but-open input.
method is_console_or_tty {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan configure $in} conf]} {
return 0
}
if {[dict exists $conf -inputmode]} {
return 1
}
if {[dict exists $conf -mode]} {
return 1
}
if {[at_eof $this]} {
return 0
}
if {[info exists ::env(TERM_PROGRAM)] || [info exists ::env(MSYSTEM)]} {
return 1
}
return 0
}
#Response capability: settled value if known, else computed heuristically (without settling -
#this method is pure; use ::opunk::console::can_respond <name> to settle an anchored instance
#heuristically, or punk::console::settle_can_respond <spec> for active-probe settling - the
#probe machinery lives in punk::console so this class stays free of that dependency).
method can_respond {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set settled [get.o_can_respond $this]
if {$settled != -1} {
return $settled
}
return [is_console_or_tty $this]
}
#Size of the console. Resolution order for the base (channel-pair) class:
# 1. chan -winsize on the output channel (fast, no query)
# 2. capability gate: if the console cannot respond to queries (settled, or heuristically for
# an unsettled console) -> the configured default size, with no query emission
# 3. the pluggable ::opunk::console::size_query_provider when registered (e.g punk::console's
# ANSI cursor-report mechanisms)
# 4. the configured default size
#Non-channel subclasses (e.g a tk text widget acting as a terminal) override this method
#entirely - none of the channel/provider logic is imposed on them.
method size {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set out [my.get.o_out $this]
if {![catch {chan configure $out} oconf]} {
if {[dict exists $oconf -winsize]} {
lassign [dict get $oconf -winsize] cols lines
if {[string is integer -strict $cols] && [string is integer -strict $lines]} {
return [dict create columns $cols rows $lines]
}
}
}
if {![can_respond $this]} {
return [my.get.o_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 [my.get.o_default_size $this]
}
}
constructor {in out} {
#new() supplies the class defaults including the virtual class tag at slot 0
set obj [new()]
my.set.o_in obj $in
my.set.o_out obj $out
return $obj
}
}
#make introspection (with i and punk::ns::cmdinfo) easier by making the class namespace an ensemble - we can still access it as ::opunk::Console
namespace eval ::opunk::Console {
namespace ensemble create
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Anchored instances - the 'consoles are entities' layer
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval ::opunk::console {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
namespace eval instances {
#one variable per anchored console instance - the canonical location of each console object.
#Access via the sibling procs; methods needing to mutate an instance go through these anchors.
}
proc create {name in out} {
if {![string is wordchar -strict $name]} {
error "opunk::console::create name must be alphanumeric/underscore, got '$name'"
}
set [namespace current]::instances::$name [::opunk::Console::new $in $out]
return [namespace current]::instances::$name
}
proc instancevar {name} {
set v [namespace current]::instances::$name
if {![info exists $v]} {
error "opunk::console: no anchored console instance named '$name' (known: [names])"
}
return $v
}
proc instance {name} {
set [instancevar $name]
}
proc names {} {
set result [list]
foreach v [info vars [namespace current]::instances::*] {
lappend result [namespace tail $v]
}
return $result
}
proc forget {name} {
unset [instancevar $name]
return
}
#settle-and-cache response capability on the anchored instance.
#The class method is pure (value-in) - this wrapper owns the mutation via the anchor.
proc can_respond {name} {
upvar #0 [instancevar $name] obj
set settled [::opunk::Console::get.o_can_respond $obj]
if {$settled != -1} {
return $settled
}
set r [::opunk::Console::can_respond $obj]
::opunk::Console::set.o_can_respond obj $r
return $r
}
proc size {name} {
::opunk::Console::size [instance $name]
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)opunk::console"
@package -name "opunk::console" -help\
"voo class ::opunk::Console representing a console as an in/out channel pair with settled
response-capability facts, plus anchored canonical instances under ::opunk::console::instances."
}]
namespace eval argdoc {
proc package_name {} {
return opunk::console
}
proc about_topics {} {
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package opunk::console
voo class for consoles as channel-pair objects with anchored canonical instances.
} \n]
}
proc get_topic_License {} {
return "BSD"
}
proc get_topic_Version {} {
return "$::opunk::console::version"
}
proc get_topic_Contributors {} {
set authors {{"Julian Noble" "julian@precisium.com.au"}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_classes {} {
punk::args::lib::tstr -return string {
opunk::Console "virtual class for consoles as in/out channel pairs"
}
}
}
set overrides [dict create]
dict set overrides @id -id "::opunk::console::about"
dict set overrides @cmd -name "opunk::console::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About opunk::console
}] \n]
dict set overrides topic -choices [list {*}[opunk::console::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [opunk::console::argdoc::default_topics]
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
set argd [punk::args::parse $args withid ::opunk::console::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::opunk::console::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
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 ::opunk::Console
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide opunk::console [tcl::namespace::eval ::opunk::console {
variable pkg opunk::console
variable version
set version 0.3.0
}]
return

4814
src/bootsupport/modules/punk/console-0.1.7.tm
View File

File diff suppressed because it is too large Load Diff

1
src/modules/opunk/AGENTS.md
Unescape View File

@ -17,6 +17,7 @@ Modules under the `opunk::*` namespace explore value-based class implementations
- Classes intended for behavioral subclassing are declared `-virtual` (slot 0 of each value is the concrete class namespace tag); behaviour-differentiating methods are declared `-virtual` so calls through the base class dispatch on the tag.
- Entity-like objects (e.g. consoles) anchor canonical instances at well-known namespace variables (`::opunk::console::instances::<name>`) with lowercase wrapper procs owning mutation; the value semantics serve as snapshots/copies where cheap.
- Cooperative shared state is pluggable rather than hardwired: the probe-byte waiting store is the array named by `::opunk::console::waiting_chunks_arrayvar` (default `::opunk::console::waiting_chunks`); integrating layers redirect it to their established store (punk::console::default_console points it at `punk::console::input_chunks_waiting`) so probe-consumed bytes stay visible to active readers.
- Query-based mechanisms enter the class the same way: `::opunk::console::size_query_provider` is a command prefix (invoked with the console object) the base `size` method consults after the -winsize fast path and capability gating; punk::console registers `console_size_provider` via `ensure_object_integration`. Non-channel subclasses override the relevant `-virtual` methods and never touch providers.
- Method-entry validity guards use `[llength $this] < N` (not `!= N`) so field-adding subclasses keep working.
- Module filenames use the `-999999.0a1.0.tm` magic suffix with `<modulename>-buildversion.txt` per parent conventions.
- `opunk::console` (with its dependency `voo`) is included in bootsupport via `src/bootsupport/modules/include_modules.config` for eventual boot/repl-startup console objects; after releasing a new version, rebuild with `make.tcl modules` then refresh the snapshot with `make.tcl bootsupport`.

33
src/modules/opunk/console-999999.0a1.0.tm
Unescape View File

@ -64,6 +64,17 @@ tcl::namespace::eval ::opunk::console {
if {![info exists waiting_chunks_arrayvar]} {
set waiting_chunks_arrayvar ::opunk::console::waiting_chunks
}
#Pluggable size-query provider: a command prefix invoked as {*}$size_query_provider <consoleobj>
#returning a dict {columns <int> rows <int>} - or an empty dict/error when size cannot be
#determined. The base ::opunk::Console::size method consults it (after the fast -winsize path and
#capability gating) so channel-based consoles gain ANSI query mechanisms when an integrating layer
#registers one (punk::console registers console_size_provider) - while this class carries no
#dependency on that machinery, and non-channel subclasses simply override size and never touch it.
variable size_query_provider
if {![info exists size_query_provider]} {
set size_query_provider ""
}
}
voo::class ::opunk::Console -virtual {
@ -179,9 +190,15 @@ voo::class ::opunk::Console -virtual {
return [is_console_or_tty $this]
}
#Size of the console: chan -winsize on the output channel when available (fast, no query),
#else the configured default size. ANSI cursor-report mechanisms are deliberately absent from
#this standalone class - they arrive via punk::console integration and subclasses.
#Size of the console. Resolution order for the base (channel-pair) class:
# 1. chan -winsize on the output channel (fast, no query)
# 2. capability gate: if the console cannot respond to queries (settled, or heuristically for
# an unsettled console) -> the configured default size, with no query emission
# 3. the pluggable ::opunk::console::size_query_provider when registered (e.g punk::console's
# ANSI cursor-report mechanisms)
# 4. the configured default size
#Non-channel subclasses (e.g a tk text widget acting as a terminal) override this method
#entirely - none of the channel/provider logic is imposed on them.
method size {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
@ -195,6 +212,16 @@ voo::class ::opunk::Console -virtual {
}
}
}
if {![can_respond $this]} {
return [my.get.o_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 [my.get.o_default_size $this]
}
}

3
src/modules/opunk/console-buildversion.txt
Unescape View File

@ -1,5 +1,6 @@
0.2.0
0.3.0
#First line must be a semantic version number
#all other lines are ignored.
#0.1.1 - can_respond method docs reference punk::console::settle_can_respond for active-probe settling (no behaviour change)
#0.2.0 - probe-byte waiting store changed from dict to array (::opunk::console::waiting_chunks) and made pluggable via waiting_chunks_arrayvar so integrating layers can redirect to an established cooperative store (e.g punk::console::input_chunks_waiting)
#0.3.0 - size method gains capability gating (can_respond) and consults the new pluggable ::opunk::console::size_query_provider hook for query-based mechanisms; non-channel subclasses continue to simply override size

106
src/modules/punk/console-999999.0a1.0.tm
Unescape View File

@ -1671,6 +1671,7 @@ namespace eval punk::console {
if {[catch {package require opunk::console} errM]} {
error "console_spec_resolve: spec '$spec' looks like an anchored console instance name but package opunk::console is unavailable ($errM)"
}
ensure_object_integration
set obj [opunk::console::instance $spec]
return [dict create in [::opunk::Console::in $obj] out [::opunk::Console::out $obj] object $obj]
}
@ -1678,6 +1679,7 @@ namespace eval punk::console {
if {[llength $spec] >= 7} {
set tag [lindex $spec 0]
if {![catch {package require opunk::console}] && ![catch {voo::isVooClass $tag} isclass] && $isclass} {
ensure_object_integration
return [dict create in [::opunk::Console::in $spec] out [::opunk::Console::out $spec] object $spec]
}
}
@ -1692,16 +1694,14 @@ namespace eval punk::console {
#during repl::init. console_spec_resolve auto-attaches it for matching channel pairs.
proc default_console {} {
if {[info exists ::opunk::console::instances::default]} {
#instance exists => opunk::console is loaded - ensure the store unification below applies
set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting
#instance exists => opunk::console is loaded - ensure integration wiring applies
ensure_object_integration
return default
}
if {[catch {package require opunk::console}]} {
return ""
}
#unify the class's probe-byte store with our cooperative store so bytes consumed by
#opunk::Console probe reads are visible to active readers (punk repl etc)
set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting
ensure_object_integration
opunk::console::create default stdin stdout
return default
}
@ -1860,36 +1860,36 @@ namespace eval punk::console {
set out [dict get $cinfo out]
set cobj [dict get $cinfo object]
set inoutchannels [list $in $out] ;#canonical channel pair - also the get_size_mechanism cache key
set tried_mechlist [list]
#fastest mechanism if available - use Tcl's inbuilt -winsize key from chan configure if available - this is much faster than any ANSI mechanism
#unknown which platforms support this.
if {![catch {get_size_using_chanconfigure $inoutchannels} sizedict]} {
return $sizedict
}
lappend tried_mechlist "chanconfigure"
#settled facts on a supplied console object override the heuristics in both directions
set can_respond -1
if {$cobj ne ""} {
set can_respond [::opunk::Console::get.o_can_respond $cobj]
if {$can_respond == -1} {
#object-governed: dispatch through the (virtual) ::opunk::Console::size method so
#subclass overrides (channel environments, widget terminals) are honoured from every
#punk::console call site. The base class method consults our registered
#size_query_provider for the ANSI mechanisms.
ensure_object_integration
if {[::opunk::Console::get.o_can_respond $cobj] == -1} {
#first-use active settling - only for persistable specs (anchored instance name, or
#the auto-attached default instance) so unanchored object values can't cause a probe
#per call. settle_can_respond only emits a query in the ambiguous zone.
if {[llength $consolespec] == 1 || ([info exists ::opunk::console::instances::default] && $cobj eq [set ::opunk::console::instances::default])} {
set can_respond [settle_can_respond $consolespec]
settle_can_respond $consolespec
#settlement persisted via the anchor - re-resolve for the updated object value
set cinfo [console_spec_resolve $consolespec]
set cobj [dict get $cinfo object]
}
}
return [::opunk::Console::size $cobj]
}
if {$can_respond == 0} {
#console object is settled as unable to answer queries - its default_size is authoritative.
#(tput deliberately not consulted here: it reflects the controlling terminal environment,
# not the supplied channel pair)
return [::opunk::Console::default_size $cobj]
#legacy channel-pair path (no governing object)
#fastest mechanism if available - use Tcl's inbuilt -winsize key from chan configure if available - this is much faster than any ANSI mechanism
#unknown which platforms support this.
if {![catch {get_size_using_chanconfigure $inoutchannels} sizedict]} {
return $sizedict
}
if {$can_respond != 1 && ![is_input_console_or_tty $in]} {
if {![is_input_console_or_tty $in]} {
#input channel can't answer cursor position queries - skip the ANSI cursor-report mechanisms
#entirely (they would hang or timeout waiting for a response that cannot arrive)
if {![catch {get_size_using_tput $inoutchannels} sizedict]} {
@ -1900,15 +1900,26 @@ namespace eval punk::console {
return [dict create columns 80 rows 24]
}
set sized [size_via_query_mechanisms $inoutchannels]
if {[dict size $sized]} {
return $sized
}
#undetermined - conventional default rather than an error (see PUNKARGS help)
return [dict create columns 80 rows 24]
}
#ANSI/tput size mechanisms with per-console-pair timing cache. Returns a dict
#{columns <int> rows <int>} or an empty dict when size cannot be determined.
#Used by the legacy get_size channel path and (as console_size_provider) by the base
#::opunk::Console::size method via the pluggable ::opunk::console::size_query_provider hook.
proc size_via_query_mechanisms {inoutchannels} {
variable is_vt52
if {$is_vt52} {
#vt52 doesn't support cursor save/restore or cursor position reports.
if {![catch {get_size_using_tput $inoutchannels} sizedict]} {
return $sizedict
}
lappend tried_mechlist "tput"
error "can't get console size. Tried mechanisms: $mechlist"
return [dict create]
}
variable get_size_mechanism ;#dict keyed on terminal ident. (currently just list of inoutchannels but may be something else in future such as terminal object or ident string)
@ -1959,25 +1970,36 @@ namespace eval punk::console {
if {![catch {get_size_using_$mech $inoutchannels} sizedict]} {
return $sizedict
}
lappend tried_mechlist $mech
}
return [dict create]
}
#if {![catch {get_size_using_cursorrestore $inoutchannels} sizedict]} {
# return $sizedict
#}
#lappend tried_mechlist "cursorrestore"
#if {![catch {get_size_using_cursormove $inoutchannels} sizedict]} {
# return $sizedict
#}
#lappend tried_mechlist "cursormove"
#if {![catch {get_size_using_tput $inoutchannels} sizedict]} {
# return $sizedict
#}
#lappend tried_mechlist "tput"
#Registered as the ::opunk::console::size_query_provider (see ensure_object_integration):
#gives the base ::opunk::Console::size method access to the ANSI query mechanisms without the
#class depending on punk::console.
proc console_size_provider {obj} {
size_via_query_mechanisms [::opunk::Console::channels $obj]
}
error "can't get console size. Tried mechanisms: $tried_mechlist"
variable object_integration_done
if {![info exists object_integration_done]} {
set object_integration_done 0
}
#One-time wiring performed whenever punk::console works with opunk::console objects:
# - unify the class's probe-byte store with our cooperative input_chunks_waiting so probe-consumed
# bytes stay visible to active readers (punk repl etc)
# - register the size-query provider (only if none registered - a deliberately customised
# provider is respected)
proc ensure_object_integration {} {
variable object_integration_done
if {$object_integration_done} {
return
}
set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting
if {$::opunk::console::size_query_provider eq ""} {
set ::opunk::console::size_query_provider [list ::punk::console::console_size_provider]
}
set object_integration_done 1
}
proc get_size_using_chanconfigure {{inoutchannels {stdin stdout}}} {

3
src/modules/punk/console-buildversion.txt
Unescape View File

@ -1,6 +1,7 @@
0.1.6
0.1.7
#First line must be a semantic version number
#all other lines are ignored.
#0.1.7 - get_size dispatches object-governed calls through the virtual ::opunk::Console::size method (subclass overrides honoured); ANSI/tput mechanisms factored into size_via_query_mechanisms and registered as the class size_query_provider via ensure_object_integration; legacy channel path returns 80x24 instead of erroring when undetermined
#0.1.6 - get_ansi_response_payload performs first-use active settling (with recursion latch) so all query paths pay one probe instead of a timeout per call on unsettled ambiguous consoles; default_console unifies the opunk::console probe-byte store with input_chunks_waiting
#0.1.5 - settle_can_respond: layered active settling of console response capability (certainty/heuristic without emission, CSI 6n probe with timeout in the ambiguous zone); get_size triggers it at first use for anchored/default console specs; new variable can_respond_probe_timeout_ms
#0.1.5 - get_ansi_response_payload only cycles console raw mode when the input channel is a console/tty - pipe-targeted probes no longer flip the process console mode (also fixes a repeat-cycle deadlock under captured-channel environments)

399
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/opunk/console-0.3.0.tm
Unescape View File

@ -0,0 +1,399 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.4.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2026
#
# @@ Meta Begin
# Application opunk::console 0.3.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
package require Tcl 8.6-
package require voo
package require punk::args
#opunk::Console - a voo (value-based) representation of a console: an in/out channel pair claimed to
#belong to one responding endpoint, together with settled capability facts about that endpoint.
#
#Motivation (see punk::console get_size / get_ansi_response_payload history):
#ANSI query mechanisms assume the input channel receives what the output channel's device emits in
#response. When stdio is redirected that pairing silently breaks - queries go to a terminal whose
#replies land in some other process's input. A console object makes the pairing an explicit,
#construction-time property instead of a per-query-site guess.
#
#Design notes:
# - Objects are voo values (plain lists). Consoles are entities, not values - so canonical instances
# are anchored at well-known namespace variables (::opunk::console::instances::<name>) and the value
# semantics serve as cheap snapshots. Mutation (settling capabilities) goes through the anchor via
# the lowercase ::opunk::console wrapper procs.
# - The class is -virtual: slot 0 of each value carries the concrete class namespace, so channel
# environments that respond like terminals but aren't platform consoles can subclass
# (-extends ::opunk::Console) and override the capability/size methods, with existing holders of
# console values dispatching correctly.
# - This first cut is standalone and passive: capability detection is heuristic (channel options,
# probed eof, terminal env hints) and size uses chan -winsize else the default size. Active ANSI
# query probing arrives with punk::console integration (which will delegate here rather than the
# class depending on punk::console).
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
#well-known cooperative store for bytes consumed by probe reads on pipe-like channels:
#an array keyed by channel name -> list of chunks. Readers taking over a channel should consume
#and clear any entry for that channel first.
#The store is PLUGGABLE via waiting_chunks_arrayvar: environments with an established cooperative
#store (e.g punk::console::input_chunks_waiting, which the punk repl reader consults) redirect it
#so probe-consumed bytes are never invisible to the active reader. The class itself stays free of
#any punk::console dependency - redirection is performed by the integrating layer.
variable waiting_chunks
if {![array exists waiting_chunks]} {
array set waiting_chunks {}
}
variable waiting_chunks_arrayvar
if {![info exists waiting_chunks_arrayvar]} {
set waiting_chunks_arrayvar ::opunk::console::waiting_chunks
}
#Pluggable size-query provider: a command prefix invoked as {*}$size_query_provider <consoleobj>
#returning a dict {columns <int> rows <int>} - or an empty dict/error when size cannot be
#determined. The base ::opunk::Console::size method consults it (after the fast -winsize path and
#capability gating) so channel-based consoles gain ANSI query mechanisms when an integrating layer
#registers one (punk::console registers console_size_provider) - while this class carries no
#dependency on that machinery, and non-channel subclasses simply override size and never touch it.
variable size_query_provider
if {![info exists size_query_provider]} {
set size_query_provider ""
}
}
voo::class ::opunk::Console -virtual {
private {
#o_ prefix per opunk voo convention (distinguishes fields from locals in -update methods,
#and matches tclOO-style implementations elsewhere for easier code movement).
#Note the class is -virtual: slot 0 of the object value is the concrete class namespace tag.
string_t o_in stdin
string_t o_out stdout
string_t o_terminal_class "" ;#e.g windows-console, tty, pipe - "" until classified
list_t o_size_mechanism [list] ;#preferred size mechanism try-order - empty until timed/settled
dict_t o_default_size [dict create columns 80 rows 24]
}
public {
#settled response capability: -1 unknown, 0 cannot respond, 1 can respond.
#public accessors (get.o_can_respond / set.o_can_respond) so the anchored-mutation wrappers in
#::opunk::console can settle it without reaching into private my.* accessors.
int_t o_can_respond -1
method in {} {
my.get.o_in $this
}
method out {} {
my.get.o_out $this
}
method channels {} {
list [my.get.o_in $this] [my.get.o_out $this]
}
method terminal_class {} {
my.get.o_terminal_class $this
}
method default_size {} {
my.get.o_default_size $this
}
#Certainty test: is the input channel closed or at eof (and so can never deliver a response)?
#A consumed/half-closed pipe may not flag eof until a read is attempted, so pipe-like channels
#get a non-blocking 1-byte probe. A probed byte is preserved in the cooperative waiting store
#(array named by ::opunk::console::waiting_chunks_arrayvar - redirectable by the integrating
#layer to e.g punk::console::input_chunks_waiting so active readers can find it).
#Console/tty channels are never probed (must not consume a keystroke).
method at_eof {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan eof $in} is_eof]} {
return 1 ;#closed/invalid channel - unusable
}
if {$is_eof} {
return 1
}
if {[catch {chan configure $in} conf]} {
return 1
}
if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} {
return 0
}
if {[catch {
set prior_blocking [dict get $conf -blocking]
chan configure $in -blocking 0
set probe [read $in 1]
chan configure $in -blocking $prior_blocking
}]} {
return 1
}
if {$probe ne ""} {
upvar #0 $::opunk::console::waiting_chunks_arrayvar wchunks
lappend wchunks($in) $probe
}
return [chan eof $in]
}
#Heuristic: could the input channel be connected to a terminal able to answer queries?
#Returns 0 only when reasonably confident it cannot. mintty without winpty presents a
#terminal's stdin as a plain pipe, so env hints (MSYSTEM, TERM_PROGRAM) prevent false
#negatives there at the cost of false positives for genuinely piped-but-open input.
method is_console_or_tty {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan configure $in} conf]} {
return 0
}
if {[dict exists $conf -inputmode]} {
return 1
}
if {[dict exists $conf -mode]} {
return 1
}
if {[at_eof $this]} {
return 0
}
if {[info exists ::env(TERM_PROGRAM)] || [info exists ::env(MSYSTEM)]} {
return 1
}
return 0
}
#Response capability: settled value if known, else computed heuristically (without settling -
#this method is pure; use ::opunk::console::can_respond <name> to settle an anchored instance
#heuristically, or punk::console::settle_can_respond <spec> for active-probe settling - the
#probe machinery lives in punk::console so this class stays free of that dependency).
method can_respond {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set settled [get.o_can_respond $this]
if {$settled != -1} {
return $settled
}
return [is_console_or_tty $this]
}
#Size of the console. Resolution order for the base (channel-pair) class:
# 1. chan -winsize on the output channel (fast, no query)
# 2. capability gate: if the console cannot respond to queries (settled, or heuristically for
# an unsettled console) -> the configured default size, with no query emission
# 3. the pluggable ::opunk::console::size_query_provider when registered (e.g punk::console's
# ANSI cursor-report mechanisms)
# 4. the configured default size
#Non-channel subclasses (e.g a tk text widget acting as a terminal) override this method
#entirely - none of the channel/provider logic is imposed on them.
method size {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set out [my.get.o_out $this]
if {![catch {chan configure $out} oconf]} {
if {[dict exists $oconf -winsize]} {
lassign [dict get $oconf -winsize] cols lines
if {[string is integer -strict $cols] && [string is integer -strict $lines]} {
return [dict create columns $cols rows $lines]
}
}
}
if {![can_respond $this]} {
return [my.get.o_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 [my.get.o_default_size $this]
}
}
constructor {in out} {
#new() supplies the class defaults including the virtual class tag at slot 0
set obj [new()]
my.set.o_in obj $in
my.set.o_out obj $out
return $obj
}
}
#make introspection (with i and punk::ns::cmdinfo) easier by making the class namespace an ensemble - we can still access it as ::opunk::Console
namespace eval ::opunk::Console {
namespace ensemble create
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Anchored instances - the 'consoles are entities' layer
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval ::opunk::console {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
namespace eval instances {
#one variable per anchored console instance - the canonical location of each console object.
#Access via the sibling procs; methods needing to mutate an instance go through these anchors.
}
proc create {name in out} {
if {![string is wordchar -strict $name]} {
error "opunk::console::create name must be alphanumeric/underscore, got '$name'"
}
set [namespace current]::instances::$name [::opunk::Console::new $in $out]
return [namespace current]::instances::$name
}
proc instancevar {name} {
set v [namespace current]::instances::$name
if {![info exists $v]} {
error "opunk::console: no anchored console instance named '$name' (known: [names])"
}
return $v
}
proc instance {name} {
set [instancevar $name]
}
proc names {} {
set result [list]
foreach v [info vars [namespace current]::instances::*] {
lappend result [namespace tail $v]
}
return $result
}
proc forget {name} {
unset [instancevar $name]
return
}
#settle-and-cache response capability on the anchored instance.
#The class method is pure (value-in) - this wrapper owns the mutation via the anchor.
proc can_respond {name} {
upvar #0 [instancevar $name] obj
set settled [::opunk::Console::get.o_can_respond $obj]
if {$settled != -1} {
return $settled
}
set r [::opunk::Console::can_respond $obj]
::opunk::Console::set.o_can_respond obj $r
return $r
}
proc size {name} {
::opunk::Console::size [instance $name]
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)opunk::console"
@package -name "opunk::console" -help\
"voo class ::opunk::Console representing a console as an in/out channel pair with settled
response-capability facts, plus anchored canonical instances under ::opunk::console::instances."
}]
namespace eval argdoc {
proc package_name {} {
return opunk::console
}
proc about_topics {} {
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package opunk::console
voo class for consoles as channel-pair objects with anchored canonical instances.
} \n]
}
proc get_topic_License {} {
return "BSD"
}
proc get_topic_Version {} {
return "$::opunk::console::version"
}
proc get_topic_Contributors {} {
set authors {{"Julian Noble" "julian@precisium.com.au"}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_classes {} {
punk::args::lib::tstr -return string {
opunk::Console "virtual class for consoles as in/out channel pairs"
}
}
}
set overrides [dict create]
dict set overrides @id -id "::opunk::console::about"
dict set overrides @cmd -name "opunk::console::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About opunk::console
}] \n]
dict set overrides topic -choices [list {*}[opunk::console::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [opunk::console::argdoc::default_topics]
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
set argd [punk::args::parse $args withid ::opunk::console::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::opunk::console::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
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 ::opunk::Console
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide opunk::console [tcl::namespace::eval ::opunk::console {
variable pkg opunk::console
variable version
set version 0.3.0
}]
return

4814
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.7.tm
View File

File diff suppressed because it is too large Load Diff

399
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/opunk/console-0.3.0.tm
Unescape View File

@ -0,0 +1,399 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.4.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2026
#
# @@ Meta Begin
# Application opunk::console 0.3.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
package require Tcl 8.6-
package require voo
package require punk::args
#opunk::Console - a voo (value-based) representation of a console: an in/out channel pair claimed to
#belong to one responding endpoint, together with settled capability facts about that endpoint.
#
#Motivation (see punk::console get_size / get_ansi_response_payload history):
#ANSI query mechanisms assume the input channel receives what the output channel's device emits in
#response. When stdio is redirected that pairing silently breaks - queries go to a terminal whose
#replies land in some other process's input. A console object makes the pairing an explicit,
#construction-time property instead of a per-query-site guess.
#
#Design notes:
# - Objects are voo values (plain lists). Consoles are entities, not values - so canonical instances
# are anchored at well-known namespace variables (::opunk::console::instances::<name>) and the value
# semantics serve as cheap snapshots. Mutation (settling capabilities) goes through the anchor via
# the lowercase ::opunk::console wrapper procs.
# - The class is -virtual: slot 0 of each value carries the concrete class namespace, so channel
# environments that respond like terminals but aren't platform consoles can subclass
# (-extends ::opunk::Console) and override the capability/size methods, with existing holders of
# console values dispatching correctly.
# - This first cut is standalone and passive: capability detection is heuristic (channel options,
# probed eof, terminal env hints) and size uses chan -winsize else the default size. Active ANSI
# query probing arrives with punk::console integration (which will delegate here rather than the
# class depending on punk::console).
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
#well-known cooperative store for bytes consumed by probe reads on pipe-like channels:
#an array keyed by channel name -> list of chunks. Readers taking over a channel should consume
#and clear any entry for that channel first.
#The store is PLUGGABLE via waiting_chunks_arrayvar: environments with an established cooperative
#store (e.g punk::console::input_chunks_waiting, which the punk repl reader consults) redirect it
#so probe-consumed bytes are never invisible to the active reader. The class itself stays free of
#any punk::console dependency - redirection is performed by the integrating layer.
variable waiting_chunks
if {![array exists waiting_chunks]} {
array set waiting_chunks {}
}
variable waiting_chunks_arrayvar
if {![info exists waiting_chunks_arrayvar]} {
set waiting_chunks_arrayvar ::opunk::console::waiting_chunks
}
#Pluggable size-query provider: a command prefix invoked as {*}$size_query_provider <consoleobj>
#returning a dict {columns <int> rows <int>} - or an empty dict/error when size cannot be
#determined. The base ::opunk::Console::size method consults it (after the fast -winsize path and
#capability gating) so channel-based consoles gain ANSI query mechanisms when an integrating layer
#registers one (punk::console registers console_size_provider) - while this class carries no
#dependency on that machinery, and non-channel subclasses simply override size and never touch it.
variable size_query_provider
if {![info exists size_query_provider]} {
set size_query_provider ""
}
}
voo::class ::opunk::Console -virtual {
private {
#o_ prefix per opunk voo convention (distinguishes fields from locals in -update methods,
#and matches tclOO-style implementations elsewhere for easier code movement).
#Note the class is -virtual: slot 0 of the object value is the concrete class namespace tag.
string_t o_in stdin
string_t o_out stdout
string_t o_terminal_class "" ;#e.g windows-console, tty, pipe - "" until classified
list_t o_size_mechanism [list] ;#preferred size mechanism try-order - empty until timed/settled
dict_t o_default_size [dict create columns 80 rows 24]
}
public {
#settled response capability: -1 unknown, 0 cannot respond, 1 can respond.
#public accessors (get.o_can_respond / set.o_can_respond) so the anchored-mutation wrappers in
#::opunk::console can settle it without reaching into private my.* accessors.
int_t o_can_respond -1
method in {} {
my.get.o_in $this
}
method out {} {
my.get.o_out $this
}
method channels {} {
list [my.get.o_in $this] [my.get.o_out $this]
}
method terminal_class {} {
my.get.o_terminal_class $this
}
method default_size {} {
my.get.o_default_size $this
}
#Certainty test: is the input channel closed or at eof (and so can never deliver a response)?
#A consumed/half-closed pipe may not flag eof until a read is attempted, so pipe-like channels
#get a non-blocking 1-byte probe. A probed byte is preserved in the cooperative waiting store
#(array named by ::opunk::console::waiting_chunks_arrayvar - redirectable by the integrating
#layer to e.g punk::console::input_chunks_waiting so active readers can find it).
#Console/tty channels are never probed (must not consume a keystroke).
method at_eof {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan eof $in} is_eof]} {
return 1 ;#closed/invalid channel - unusable
}
if {$is_eof} {
return 1
}
if {[catch {chan configure $in} conf]} {
return 1
}
if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} {
return 0
}
if {[catch {
set prior_blocking [dict get $conf -blocking]
chan configure $in -blocking 0
set probe [read $in 1]
chan configure $in -blocking $prior_blocking
}]} {
return 1
}
if {$probe ne ""} {
upvar #0 $::opunk::console::waiting_chunks_arrayvar wchunks
lappend wchunks($in) $probe
}
return [chan eof $in]
}
#Heuristic: could the input channel be connected to a terminal able to answer queries?
#Returns 0 only when reasonably confident it cannot. mintty without winpty presents a
#terminal's stdin as a plain pipe, so env hints (MSYSTEM, TERM_PROGRAM) prevent false
#negatives there at the cost of false positives for genuinely piped-but-open input.
method is_console_or_tty {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan configure $in} conf]} {
return 0
}
if {[dict exists $conf -inputmode]} {
return 1
}
if {[dict exists $conf -mode]} {
return 1
}
if {[at_eof $this]} {
return 0
}
if {[info exists ::env(TERM_PROGRAM)] || [info exists ::env(MSYSTEM)]} {
return 1
}
return 0
}
#Response capability: settled value if known, else computed heuristically (without settling -
#this method is pure; use ::opunk::console::can_respond <name> to settle an anchored instance
#heuristically, or punk::console::settle_can_respond <spec> for active-probe settling - the
#probe machinery lives in punk::console so this class stays free of that dependency).
method can_respond {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set settled [get.o_can_respond $this]
if {$settled != -1} {
return $settled
}
return [is_console_or_tty $this]
}
#Size of the console. Resolution order for the base (channel-pair) class:
# 1. chan -winsize on the output channel (fast, no query)
# 2. capability gate: if the console cannot respond to queries (settled, or heuristically for
# an unsettled console) -> the configured default size, with no query emission
# 3. the pluggable ::opunk::console::size_query_provider when registered (e.g punk::console's
# ANSI cursor-report mechanisms)
# 4. the configured default size
#Non-channel subclasses (e.g a tk text widget acting as a terminal) override this method
#entirely - none of the channel/provider logic is imposed on them.
method size {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set out [my.get.o_out $this]
if {![catch {chan configure $out} oconf]} {
if {[dict exists $oconf -winsize]} {
lassign [dict get $oconf -winsize] cols lines
if {[string is integer -strict $cols] && [string is integer -strict $lines]} {
return [dict create columns $cols rows $lines]
}
}
}
if {![can_respond $this]} {
return [my.get.o_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 [my.get.o_default_size $this]
}
}
constructor {in out} {
#new() supplies the class defaults including the virtual class tag at slot 0
set obj [new()]
my.set.o_in obj $in
my.set.o_out obj $out
return $obj
}
}
#make introspection (with i and punk::ns::cmdinfo) easier by making the class namespace an ensemble - we can still access it as ::opunk::Console
namespace eval ::opunk::Console {
namespace ensemble create
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Anchored instances - the 'consoles are entities' layer
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval ::opunk::console {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
namespace eval instances {
#one variable per anchored console instance - the canonical location of each console object.
#Access via the sibling procs; methods needing to mutate an instance go through these anchors.
}
proc create {name in out} {
if {![string is wordchar -strict $name]} {
error "opunk::console::create name must be alphanumeric/underscore, got '$name'"
}
set [namespace current]::instances::$name [::opunk::Console::new $in $out]
return [namespace current]::instances::$name
}
proc instancevar {name} {
set v [namespace current]::instances::$name
if {![info exists $v]} {
error "opunk::console: no anchored console instance named '$name' (known: [names])"
}
return $v
}
proc instance {name} {
set [instancevar $name]
}
proc names {} {
set result [list]
foreach v [info vars [namespace current]::instances::*] {
lappend result [namespace tail $v]
}
return $result
}
proc forget {name} {
unset [instancevar $name]
return
}
#settle-and-cache response capability on the anchored instance.
#The class method is pure (value-in) - this wrapper owns the mutation via the anchor.
proc can_respond {name} {
upvar #0 [instancevar $name] obj
set settled [::opunk::Console::get.o_can_respond $obj]
if {$settled != -1} {
return $settled
}
set r [::opunk::Console::can_respond $obj]
::opunk::Console::set.o_can_respond obj $r
return $r
}
proc size {name} {
::opunk::Console::size [instance $name]
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)opunk::console"
@package -name "opunk::console" -help\
"voo class ::opunk::Console representing a console as an in/out channel pair with settled
response-capability facts, plus anchored canonical instances under ::opunk::console::instances."
}]
namespace eval argdoc {
proc package_name {} {
return opunk::console
}
proc about_topics {} {
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package opunk::console
voo class for consoles as channel-pair objects with anchored canonical instances.
} \n]
}
proc get_topic_License {} {
return "BSD"
}
proc get_topic_Version {} {
return "$::opunk::console::version"
}
proc get_topic_Contributors {} {
set authors {{"Julian Noble" "julian@precisium.com.au"}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_classes {} {
punk::args::lib::tstr -return string {
opunk::Console "virtual class for consoles as in/out channel pairs"
}
}
}
set overrides [dict create]
dict set overrides @id -id "::opunk::console::about"
dict set overrides @cmd -name "opunk::console::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About opunk::console
}] \n]
dict set overrides topic -choices [list {*}[opunk::console::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [opunk::console::argdoc::default_topics]
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
set argd [punk::args::parse $args withid ::opunk::console::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::opunk::console::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
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 ::opunk::Console
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide opunk::console [tcl::namespace::eval ::opunk::console {
variable pkg opunk::console
variable version
set version 0.3.0
}]
return

4814
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.7.tm
View File

File diff suppressed because it is too large Load Diff

34
src/tests/modules/opunk/console/testsuites/console/consoleclass.test
Unescape View File

@ -228,6 +228,40 @@ namespace eval ::testspace {
0\
]
test console_size_provider_hook {base size method consults the pluggable provider, gated by capability}\
-setup [string cat $common $hints_save {
set saved_provider $::opunk::console::size_query_provider
set ::testspace::fakeprov_calls 0
proc ::testspace::fakeprov {obj} {
incr ::testspace::fakeprov_calls
return [dict create columns 123 rows 45]
}
set ::opunk::console::size_query_provider [list ::testspace::fakeprov]
}]\
-body {
lassign [chan pipe] rd wr
#capability settled 1: provider consulted (winsize unavailable on pipes)
set obj [::opunk::Console::new $rd $wr]
::opunk::Console::set.o_can_respond obj 1
lappend result [::opunk::Console::size $obj]
#capability settled 0: provider NOT consulted - default size authoritative
::opunk::Console::set.o_can_respond obj 0
lappend result [::opunk::Console::size $obj]
lappend result $::testspace::fakeprov_calls
}\
-cleanup [string cat {
set ::opunk::console::size_query_provider $saved_provider
catch {rename ::testspace::fakeprov ""}
unset -nocomplain ::testspace::fakeprov_calls
catch {chan close $wr}
catch {chan close $rd}
} $hints_restore]\
-result [list\
{columns 123 rows 45}\
{columns 80 rows 24}\
1\
]
test console_subclass_virtual_dispatch {subclass overriding size dispatches via slot 0 tag from parent-class call sites}\
-setup $common -body {
voo::class ::testspace::FixedSizeConsole -extends ::opunk::Console {

37
src/tests/modules/punk/console/testsuites/console/consolespec.test
Unescape View File

@ -387,5 +387,42 @@ namespace eval ::testspace {
{}\
]
test sizeprov_registered {integration registers console_size_provider as the class size provider}\
-setup $common -body {
punk::console::default_console
lappend result [expr {$::opunk::console::size_query_provider eq [list ::punk::console::console_size_provider]}]
}\
-cleanup {
catch {opunk::console::forget default}
}\
-result [list\
1\
]
test sizeprov_subclass_dispatch_via_get_size {punk::console::get_size honours subclass size overrides (widget/channel-environment consoles)}\
-setup $common -body {
voo::class ::testspace::WidgetishConsole -extends ::opunk::Console {
method size {} -override {
return [dict create columns 640 rows 480]
}
}
#pre-settled so the test exercises dispatch, not settling
set obj [::testspace::WidgetishConsole::new() ]
::opunk::Console::set.o_can_respond obj 1
#anchored instance name spec
set ::opunk::console::instances::testwidget $obj
lappend result [punk::console::get_size -console testwidget]
#object value spec (legacy positional slot)
lappend result [punk::console::get_size $obj]
}\
-cleanup {
catch {opunk::console::forget testwidget}
namespace delete ::testspace::WidgetishConsole
}\
-result [list\
{columns 640 rows 480}\
{columns 640 rows 480}\
]
}
tcltest::cleanupTests ;#needed to produce test summary.

399
src/vfs/_vfscommon.vfs/modules/opunk/console-0.3.0.tm
Unescape View File

@ -0,0 +1,399 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.4.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2026
#
# @@ Meta Begin
# Application opunk::console 0.3.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
package require Tcl 8.6-
package require voo
package require punk::args
#opunk::Console - a voo (value-based) representation of a console: an in/out channel pair claimed to
#belong to one responding endpoint, together with settled capability facts about that endpoint.
#
#Motivation (see punk::console get_size / get_ansi_response_payload history):
#ANSI query mechanisms assume the input channel receives what the output channel's device emits in
#response. When stdio is redirected that pairing silently breaks - queries go to a terminal whose
#replies land in some other process's input. A console object makes the pairing an explicit,
#construction-time property instead of a per-query-site guess.
#
#Design notes:
# - Objects are voo values (plain lists). Consoles are entities, not values - so canonical instances
# are anchored at well-known namespace variables (::opunk::console::instances::<name>) and the value
# semantics serve as cheap snapshots. Mutation (settling capabilities) goes through the anchor via
# the lowercase ::opunk::console wrapper procs.
# - The class is -virtual: slot 0 of each value carries the concrete class namespace, so channel
# environments that respond like terminals but aren't platform consoles can subclass
# (-extends ::opunk::Console) and override the capability/size methods, with existing holders of
# console values dispatching correctly.
# - This first cut is standalone and passive: capability detection is heuristic (channel options,
# probed eof, terminal env hints) and size uses chan -winsize else the default size. Active ANSI
# query probing arrives with punk::console integration (which will delegate here rather than the
# class depending on punk::console).
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
#well-known cooperative store for bytes consumed by probe reads on pipe-like channels:
#an array keyed by channel name -> list of chunks. Readers taking over a channel should consume
#and clear any entry for that channel first.
#The store is PLUGGABLE via waiting_chunks_arrayvar: environments with an established cooperative
#store (e.g punk::console::input_chunks_waiting, which the punk repl reader consults) redirect it
#so probe-consumed bytes are never invisible to the active reader. The class itself stays free of
#any punk::console dependency - redirection is performed by the integrating layer.
variable waiting_chunks
if {![array exists waiting_chunks]} {
array set waiting_chunks {}
}
variable waiting_chunks_arrayvar
if {![info exists waiting_chunks_arrayvar]} {
set waiting_chunks_arrayvar ::opunk::console::waiting_chunks
}
#Pluggable size-query provider: a command prefix invoked as {*}$size_query_provider <consoleobj>
#returning a dict {columns <int> rows <int>} - or an empty dict/error when size cannot be
#determined. The base ::opunk::Console::size method consults it (after the fast -winsize path and
#capability gating) so channel-based consoles gain ANSI query mechanisms when an integrating layer
#registers one (punk::console registers console_size_provider) - while this class carries no
#dependency on that machinery, and non-channel subclasses simply override size and never touch it.
variable size_query_provider
if {![info exists size_query_provider]} {
set size_query_provider ""
}
}
voo::class ::opunk::Console -virtual {
private {
#o_ prefix per opunk voo convention (distinguishes fields from locals in -update methods,
#and matches tclOO-style implementations elsewhere for easier code movement).
#Note the class is -virtual: slot 0 of the object value is the concrete class namespace tag.
string_t o_in stdin
string_t o_out stdout
string_t o_terminal_class "" ;#e.g windows-console, tty, pipe - "" until classified
list_t o_size_mechanism [list] ;#preferred size mechanism try-order - empty until timed/settled
dict_t o_default_size [dict create columns 80 rows 24]
}
public {
#settled response capability: -1 unknown, 0 cannot respond, 1 can respond.
#public accessors (get.o_can_respond / set.o_can_respond) so the anchored-mutation wrappers in
#::opunk::console can settle it without reaching into private my.* accessors.
int_t o_can_respond -1
method in {} {
my.get.o_in $this
}
method out {} {
my.get.o_out $this
}
method channels {} {
list [my.get.o_in $this] [my.get.o_out $this]
}
method terminal_class {} {
my.get.o_terminal_class $this
}
method default_size {} {
my.get.o_default_size $this
}
#Certainty test: is the input channel closed or at eof (and so can never deliver a response)?
#A consumed/half-closed pipe may not flag eof until a read is attempted, so pipe-like channels
#get a non-blocking 1-byte probe. A probed byte is preserved in the cooperative waiting store
#(array named by ::opunk::console::waiting_chunks_arrayvar - redirectable by the integrating
#layer to e.g punk::console::input_chunks_waiting so active readers can find it).
#Console/tty channels are never probed (must not consume a keystroke).
method at_eof {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan eof $in} is_eof]} {
return 1 ;#closed/invalid channel - unusable
}
if {$is_eof} {
return 1
}
if {[catch {chan configure $in} conf]} {
return 1
}
if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} {
return 0
}
if {[catch {
set prior_blocking [dict get $conf -blocking]
chan configure $in -blocking 0
set probe [read $in 1]
chan configure $in -blocking $prior_blocking
}]} {
return 1
}
if {$probe ne ""} {
upvar #0 $::opunk::console::waiting_chunks_arrayvar wchunks
lappend wchunks($in) $probe
}
return [chan eof $in]
}
#Heuristic: could the input channel be connected to a terminal able to answer queries?
#Returns 0 only when reasonably confident it cannot. mintty without winpty presents a
#terminal's stdin as a plain pipe, so env hints (MSYSTEM, TERM_PROGRAM) prevent false
#negatives there at the cost of false positives for genuinely piped-but-open input.
method is_console_or_tty {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set in [my.get.o_in $this]
if {[catch {chan configure $in} conf]} {
return 0
}
if {[dict exists $conf -inputmode]} {
return 1
}
if {[dict exists $conf -mode]} {
return 1
}
if {[at_eof $this]} {
return 0
}
if {[info exists ::env(TERM_PROGRAM)] || [info exists ::env(MSYSTEM)]} {
return 1
}
return 0
}
#Response capability: settled value if known, else computed heuristically (without settling -
#this method is pure; use ::opunk::console::can_respond <name> to settle an anchored instance
#heuristically, or punk::console::settle_can_respond <spec> for active-probe settling - the
#probe machinery lives in punk::console so this class stays free of that dependency).
method can_respond {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set settled [get.o_can_respond $this]
if {$settled != -1} {
return $settled
}
return [is_console_or_tty $this]
}
#Size of the console. Resolution order for the base (channel-pair) class:
# 1. chan -winsize on the output channel (fast, no query)
# 2. capability gate: if the console cannot respond to queries (settled, or heuristically for
# an unsettled console) -> the configured default size, with no query emission
# 3. the pluggable ::opunk::console::size_query_provider when registered (e.g punk::console's
# ANSI cursor-report mechanisms)
# 4. the configured default size
#Non-channel subclasses (e.g a tk text widget acting as a terminal) override this method
#entirely - none of the channel/provider logic is imposed on them.
method size {} -virtual {
if {[llength $this] < 7} {
error "invalid object $this"
}
set out [my.get.o_out $this]
if {![catch {chan configure $out} oconf]} {
if {[dict exists $oconf -winsize]} {
lassign [dict get $oconf -winsize] cols lines
if {[string is integer -strict $cols] && [string is integer -strict $lines]} {
return [dict create columns $cols rows $lines]
}
}
}
if {![can_respond $this]} {
return [my.get.o_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 [my.get.o_default_size $this]
}
}
constructor {in out} {
#new() supplies the class defaults including the virtual class tag at slot 0
set obj [new()]
my.set.o_in obj $in
my.set.o_out obj $out
return $obj
}
}
#make introspection (with i and punk::ns::cmdinfo) easier by making the class namespace an ensemble - we can still access it as ::opunk::Console
namespace eval ::opunk::Console {
namespace ensemble create
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Anchored instances - the 'consoles are entities' layer
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval ::opunk::console {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
namespace eval instances {
#one variable per anchored console instance - the canonical location of each console object.
#Access via the sibling procs; methods needing to mutate an instance go through these anchors.
}
proc create {name in out} {
if {![string is wordchar -strict $name]} {
error "opunk::console::create name must be alphanumeric/underscore, got '$name'"
}
set [namespace current]::instances::$name [::opunk::Console::new $in $out]
return [namespace current]::instances::$name
}
proc instancevar {name} {
set v [namespace current]::instances::$name
if {![info exists $v]} {
error "opunk::console: no anchored console instance named '$name' (known: [names])"
}
return $v
}
proc instance {name} {
set [instancevar $name]
}
proc names {} {
set result [list]
foreach v [info vars [namespace current]::instances::*] {
lappend result [namespace tail $v]
}
return $result
}
proc forget {name} {
unset [instancevar $name]
return
}
#settle-and-cache response capability on the anchored instance.
#The class method is pure (value-in) - this wrapper owns the mutation via the anchor.
proc can_respond {name} {
upvar #0 [instancevar $name] obj
set settled [::opunk::Console::get.o_can_respond $obj]
if {$settled != -1} {
return $settled
}
set r [::opunk::Console::can_respond $obj]
::opunk::Console::set.o_can_respond obj $r
return $r
}
proc size {name} {
::opunk::Console::size [instance $name]
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval ::opunk::console {
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)opunk::console"
@package -name "opunk::console" -help\
"voo class ::opunk::Console representing a console as an in/out channel pair with settled
response-capability facts, plus anchored canonical instances under ::opunk::console::instances."
}]
namespace eval argdoc {
proc package_name {} {
return opunk::console
}
proc about_topics {} {
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package opunk::console
voo class for consoles as channel-pair objects with anchored canonical instances.
} \n]
}
proc get_topic_License {} {
return "BSD"
}
proc get_topic_Version {} {
return "$::opunk::console::version"
}
proc get_topic_Contributors {} {
set authors {{"Julian Noble" "julian@precisium.com.au"}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_classes {} {
punk::args::lib::tstr -return string {
opunk::Console "virtual class for consoles as in/out channel pairs"
}
}
}
set overrides [dict create]
dict set overrides @id -id "::opunk::console::about"
dict set overrides @cmd -name "opunk::console::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About opunk::console
}] \n]
dict set overrides topic -choices [list {*}[opunk::console::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [opunk::console::argdoc::default_topics]
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
set argd [punk::args::parse $args withid ::opunk::console::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::opunk::console::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
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 ::opunk::Console
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide opunk::console [tcl::namespace::eval ::opunk::console {
variable pkg opunk::console
variable version
set version 0.3.0
}]
return

4814
src/vfs/_vfscommon.vfs/modules/punk/console-0.1.7.tm
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save