# -*- 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 999999.0a1.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 999999.0a1.0
}]
return