You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
296 lines
11 KiB
296 lines
11 KiB
# -*- 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: 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 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# doctools header |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#*** !doctools |
|
#[manpage_begin punkshell_module_punk::repl::codethread 0 999999.0a1.0] |
|
#[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 999999.0a1.0 |
|
}] |
|
return |
|
|
|
#*** !doctools |
|
#[manpage_end] |
|
|
|
|