# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt # module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.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) 2024 # # @@ Meta Begin # Application punk::repl::codethread 0.1.1 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[manpage_begin punkshell_module_punk::repl::codethread 0 0.1.1] #[copyright "2024"] #[titledesc {Module repl codethread}] [comment {-- Name section and table of contents description --}] #[moddesc {codethread for repl - root interpreter}] [comment {-- Description at end of page heading --}] #[require punk::repl::codethread] #[keywords module repl] #[description] #[para] This is part of the infrastructure required for the punk::repl to operate # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Overview] #[para] overview of punk::repl::codethread #[subsection Concepts] #[para] - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[subsection dependencies] #[para] packages used by punk::repl::codethread #[list_begin itemized] package require Tcl 8.6- package require punk::config #*** !doctools #[item] [package {Tcl 8.6}] # #package require frobz # #*** !doctools # #[item] [package {frobz}] #*** !doctools #[list_end] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section API] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # oo::class namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #tcl::namespace::eval punk::repl::codethread::class { #*** !doctools #[subsection {Namespace punk::repl::codethread::class}] #[para] class definitions #if {[info commands [tcl::namespace::current]::interface_sample1] eq ""} { #*** !doctools #[list_begin enumerated] # oo::class create interface_sample1 { # #*** !doctools # #[enum] CLASS [class interface_sample1] # #[list_begin definitions] # method test {arg1} { # #*** !doctools # #[call class::interface_sample1 [method test] [arg arg1]] # #[para] test method # puts "test: $arg1" # } # #*** !doctools # #[list_end] [comment {-- end definitions interface_sample1}] # } #*** !doctools #[list_end] [comment {--- end class enumeration ---}] #} #} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::repl::codethread { tcl::namespace::export * variable replthread variable replthread_cond variable running 0 variable output_stdout "" variable output_stderr "" #variable xyz #*** !doctools #[subsection {Namespace punk::repl::codethread}] #[para] Core API functions for punk::repl::codethread #[list_begin definitions] #proc sample1 {p1 n args} { # #*** !doctools # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] # #[para]Description of sample1 # #[para] Arguments: # # [list_begin arguments] # # [arg_def tring p1] A description of string argument p1. # # [arg_def integer n] A description of integer argument n. # # [list_end] # return "ok" #} variable run_command_cache proc is_running {} { variable running return $running } proc runscript {script} { #puts stderr "->runscript" variable replthread_cond #variable output_stdout "" #variable output_stderr "" #expecting to be called from a thread::send in parent repl - ie in the toplevel interp so that the sub-interp "code" is available #if a thread::send is done from the commandline in a codethread - Tcl will if {"code" ni [interp children] || ![info exists replthread_cond]} { #in case someone tries calling from codethread directly - don't do anything or change any state #(direct caller could create an interp named code at the level "" -> "code" -"code" and add a replthread_cond value to avoid this check - but it probably won't do anything useful) #if called directly - the context will be within the first 'code' interp. #inappropriate caller could add superfluous entries to shellfilter stack if function errors out #inappropriate caller could affect tsv vars (if their interp allows that anyway) puts stderr "runscript is meant to be called from the parent repl thread via a thread::send to the codethread" return } interp eval code [list set ::punk::repl::codethread::output_stdout ""] interp eval code [list set ::punk::repl::codethread::output_stderr ""] set outstack [list] set errstack [list] upvar ::punk::config::running running_config if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } lappend errstack [interp eval code [list ::shellfilter::stack add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] #an experiment #set errhandle [shellfilter::stack::item_tophandle stderr] #interp transfer "" $errhandle code set status [catch { #shennanigans to keep compiled script around after call. #otherwise when $script goes out of scope - internal rep of vars set in script changes. #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible. interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone interp eval code { lappend ::codeinterp::run_command_cache $::codeinterp::clonescript if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } if {[string first ":::" $::punk::ns::ns_current]} { #support for browsing 'odd' (inadvisable) namespaces #don't use 'namespace exists' - will conflate ::test::x with ::test:::x #if {$::punk::ns::ns_current in [namespace children [punk::ns::nsprefix $::punk::ns::ns_current]} { #} package require punk::ns punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript } else { tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript } } } result] flush stdout flush stderr #interp transfer code $errhandle "" #flush $errhandle #set lastoutchar [string index [punk::ansi::ansistrip [interp eval code set ::punk::repl::codethread::output_stdout]] end] #set lastoutchar [string index [punk::ansi::ansistrip [interp eval code [list set ::punk::repl::codethread::output_stdout]]] end] set lastoutpart [interp eval code {string range $::punk::repl::codethread::output_stdout end-100 end}] #note we could be in a *large* ansi segment such as sixel data #review - why do we need to ansistrip? set lastoutchar [string index [punk::ansi::ansistrip $lastoutpart] end] #set lasterrchar [string index [punk::ansi::ansistrip [interp eval code set ::punk::repl::codethread::output_stderr]] end] set lasterrpart [interp eval code {string range $::punk::repl::codethread::output_stderr end-100 end}] set lasterrchar [string index [punk::ansi::ansistrip $lasterrpart] end] #puts stderr "-->[ansistring VIEW -lf 1 $lastoutchar$lasterrchar]" set tid [thread::id] tsv::set codethread_$tid info [list lastoutchar $lastoutchar lasterrchar $lasterrchar] tsv::set codethread_$tid status $status tsv::set codethread_$tid result $result tsv::set codethread_$tid errorcode $::errorCode #only remove from shellfilter::stack the items we added to stack in this function foreach s [lreverse $outstack] { interp eval code [list ::shellfilter::stack remove stdout $s] } foreach s [lreverse $errstack] { interp eval code [list ::shellfilter::stack remove stderr $s] } thread::cond notify $replthread_cond } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::repl::codethread ---}] } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::repl::codethread::lib { tcl::namespace::export * tcl::namespace::path [tcl::namespace::parent] #*** !doctools #[subsection {Namespace punk::repl::codethread::lib}] #[para] Secondary functions that are part of the API #[list_begin definitions] #proc utility1 {p1 args} { # #*** !doctools # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] # #[para]Description of utility1 # return 1 #} #*** !doctools #[list_end] [comment {--- end definitions namespace punk::repl::codethread::lib ---}] } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] tcl::namespace::eval punk::repl::codethread::system { #*** !doctools #[subsection {Namespace punk::repl::codethread::system}] #[para] Internal functions that are not part of the API } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::repl::codethread [tcl::namespace::eval punk::repl::codethread { variable pkg punk::repl::codethread variable version set version 0.1.1 }] return #*** !doctools #[manpage_end]