108 changed files with 7968 additions and 1086 deletions
@ -0,0 +1,287 @@ |
|||||||
|
# -*- 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 0.1.1 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license <unspecified> |
||||||
|
# @@ 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] |
||||||
|
} |
||||||
|
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] |
||||||
|
|
||||||
@ -1,3 +1,3 @@ |
|||||||
0.1.0 |
0.1.1 |
||||||
#First line must be a semantic version number |
#First line must be a semantic version number |
||||||
#all other lines are ignored. |
#all other lines are ignored. |
||||||
|
|||||||
@ -0,0 +1,322 @@ |
|||||||
|
# -*- 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.3.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::sixel 999999.0a1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license <unspecified> |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# doctools header |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#*** !doctools |
||||||
|
#[manpage_begin punkshell_module_punk::sixel 0 999999.0a1.0] |
||||||
|
#[copyright "2024"] |
||||||
|
#[titledesc {punk::sixel API}] [comment {-- Name section and table of contents description --}] |
||||||
|
#[moddesc {experimental sixel functions}] [comment {-- Description at end of page heading --}] |
||||||
|
#[require punk::sixel] |
||||||
|
#[keywords module experimental] |
||||||
|
#[description] |
||||||
|
#[para] Experimental support functions for working with sixel data |
||||||
|
#[para] For real sixel work a version written in a systems language such as c or zig may be required. |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[section Overview] |
||||||
|
#[para] overview of punk::sixel |
||||||
|
#[subsection Concepts] |
||||||
|
#[para] - |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Requirements |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[subsection dependencies] |
||||||
|
#[para] packages used by punk::sixel |
||||||
|
#[list_begin itemized] |
||||||
|
|
||||||
|
package require Tcl 8.6- |
||||||
|
package require punk::args |
||||||
|
package require punk::console |
||||||
|
package require punk::ansi |
||||||
|
#*** !doctools |
||||||
|
#[item] [package {Tcl 8.6}] |
||||||
|
#[item] [package {punk::args}] |
||||||
|
#[item] [package {punk::console}] |
||||||
|
#[item] [package {punk::ansi}] |
||||||
|
|
||||||
|
|
||||||
|
# #package require frobz |
||||||
|
# #*** !doctools |
||||||
|
# #[item] [package {frobz}] |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[section API] |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# oo::class namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#tcl::namespace::eval punk::sixel::class { |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::sixel::class}] |
||||||
|
#[para] class definitions |
||||||
|
#if {[tcl::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 ---}] |
||||||
|
#} |
||||||
|
#} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#reading |
||||||
|
#https://www.reddit.com/r/linux/comments/t3m7zm/quick_roundup_of_bitmap_graphics_availability_in/ |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# Base namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
tcl::namespace::eval punk::sixel { |
||||||
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||||
|
#variable xyz |
||||||
|
|
||||||
|
set sixelstart_re {\x1bP([;0-9]*)q} ;#7-bit - todo 8bit |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::sixel}] |
||||||
|
#[para] Core API functions for punk::sixel |
||||||
|
#[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" |
||||||
|
#} |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#terminated by ST |
||||||
|
#some older terminals may terminate at first other esc encountered. |
||||||
|
#non-sixel characters ignored (? review) |
||||||
|
#we will for now consume all to final ST |
||||||
|
#TODO - sixel row/col info is dependent on terminal - pass in -terminalobject or -inoutchannels (for use with punk::console::cell_size) |
||||||
|
punk::args::definition { |
||||||
|
*id punk::sixel::get_info |
||||||
|
-cache -default 1 -type boolean -help\ |
||||||
|
"Cached result based on sha1 hash." |
||||||
|
-cell_size -default "" -help\ |
||||||
|
"override terminal cell_size. |
||||||
|
If left empty, attempt to use value from querying terminal." |
||||||
|
*values -min 1 -max 1 |
||||||
|
sixelstring -type string -help "A single sixel image - currently only 7-bit supported" |
||||||
|
} |
||||||
|
variable sixelinfo_cache |
||||||
|
set sixelinfo_cache [dict create] |
||||||
|
proc get_info {args} { |
||||||
|
set argd [punk::args::get_by_id punk::sixel::get_info $args] |
||||||
|
set sixelstring [dict get $argd values sixelstring] |
||||||
|
set do_cache [dict get $argd opts -cache] |
||||||
|
set cell_size_override [dict get $argd opts -cell_size] |
||||||
|
|
||||||
|
if {$do_cache} { |
||||||
|
if {[catch {package require sha1}]} { |
||||||
|
set do_cache 0 |
||||||
|
} |
||||||
|
} |
||||||
|
if {$do_cache} { |
||||||
|
variable sixelinfo_cache |
||||||
|
set cacheid ${cell_size_override}_[sha1::sha1 $sixelstring] |
||||||
|
if {[dict exists $sixelinfo_cache $cacheid]} { |
||||||
|
return [dict get $sixelinfo_cache $cacheid] |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
#relatively slow because a) we parse each sixel line in case it is ragged width b) should probably be written in a systems language or be a library call |
||||||
|
set raster_lines [split $sixelstring -] |
||||||
|
set height_pixels [expr {[llength $raster_lines] * 6}] |
||||||
|
if {$cell_size_override ne ""} { |
||||||
|
lassign [split [string tolower $cell_size_override] x] cwidth cheight |
||||||
|
if {![string is integer -strict $cwidth] || ![string is integer -strict $cheight]} { |
||||||
|
error "punk::sixel::get_info -cell_sixe must be of the form WxH where W and H are positive integers" |
||||||
|
} |
||||||
|
set cell_size $cell_size_override |
||||||
|
} else { |
||||||
|
set cell_size [punk::console::cell_size] |
||||||
|
} |
||||||
|
lassign [split $cell_size x] cwidth cheight |
||||||
|
set height_cells [expr {int(ceil($height_pixels /double($cheight)))}] |
||||||
|
set sixelparams "" |
||||||
|
set sixel_extents [list] ;#number of sixes in each line taking into account retraces due to $ |
||||||
|
|
||||||
|
set line0 [lindex $raster_lines 0] |
||||||
|
if {[regexp -indices {^\x1bP([;0-9]*)q} $line0 i_match]} { |
||||||
|
#todo - 8bit |
||||||
|
#set params [string range $line0 {*}$i_params] ;#may be empty |
||||||
|
set linedata [string range $line0 [lindex $i_match 1]+1 end] |
||||||
|
if {[string index $linedata 0] eq {"}} { |
||||||
|
if {[regexp -indices {\"([;0-9]*)} $linedata i_match]} { |
||||||
|
#i_params is raster info (todo?) |
||||||
|
set linedata [string range $linedata [lindex $i_match 1]+1 end] |
||||||
|
} else { |
||||||
|
#lone quote? |
||||||
|
set linedata [string range $linedata 1 end] |
||||||
|
} |
||||||
|
} |
||||||
|
lset raster_lines 0 $linedata |
||||||
|
} else { |
||||||
|
error "punk::sixel::get_info failed to recognise first line as a sixel string" |
||||||
|
} |
||||||
|
|
||||||
|
foreach linedata $raster_lines { |
||||||
|
set line_sixelrun 0 |
||||||
|
set line_sixelrun_max 0 ;#max encountered for this line |
||||||
|
for {set s 0} {$s < [string length $linedata]} {incr s} { |
||||||
|
#set cdec [scan [string index $linedata $s] %c] ;#scanning each char and switching on cdec is slower |
||||||
|
set c [string index $linedata $s] |
||||||
|
switch -- $c { |
||||||
|
{#} { |
||||||
|
#colour palette select or set |
||||||
|
if {[regexp -start $s -indices {#([;0-9]*)} $linedata i_match]} { |
||||||
|
#set colour_info [string range $linedata {*}$i_colour] |
||||||
|
set s [lindex $i_match 1] |
||||||
|
} |
||||||
|
#if no number following.. ignore |
||||||
|
} |
||||||
|
{$} { |
||||||
|
#retrace |
||||||
|
set line_sixelrun_max [expr {max($line_sixelrun_max,$line_sixelrun)}] |
||||||
|
set line_sixelrun 0 |
||||||
|
} |
||||||
|
{!} { |
||||||
|
#repeat #<num><char> |
||||||
|
set repeat [regexp -inline -start $s+1 {[0-9]*} $linedata] |
||||||
|
if {[string is integer -strict $repeat] && $repeat >= 0} { |
||||||
|
incr s [expr {[string length $repeat]+1}] ;#add one for the repeated sixel char |
||||||
|
incr line_sixelrun $repeat |
||||||
|
} |
||||||
|
} |
||||||
|
default { |
||||||
|
#don't use escape in switch selector - ensures jump table is used. |
||||||
|
if {$c eq "\x1b"} { |
||||||
|
if {[string index $linedata $s+1] eq "\\"} { |
||||||
|
#7bit ST |
||||||
|
break |
||||||
|
} |
||||||
|
} else { |
||||||
|
incr line_sixelrun |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
lappend sixel_extents [expr {max($line_sixelrun_max,$line_sixelrun)}] |
||||||
|
} |
||||||
|
set width_pixels [tcl::mathfunc::max 0 {*}$sixel_extents] |
||||||
|
set width_cells [expr {int(ceil($width_pixels/double($cwidth)))}] |
||||||
|
|
||||||
|
set result [dict create rasterlines [llength $raster_lines] columns $width_cells rows $height_cells cell_size $cell_size width_pixels $width_pixels height_pixels $height_pixels sixel_extents $sixel_extents] |
||||||
|
#return [dict create rasterlines [llength $raster_lines] columns $width_cells rows $height_cells width_pixels $width_pixels height_pixels $height_pixels] |
||||||
|
if {$do_cache} { |
||||||
|
dict set sixelinfo_cache $cacheid $result |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] [comment {--- end definitions namespace punk::sixel ---}] |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# Secondary API namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
tcl::namespace::eval punk::sixel::lib { |
||||||
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||||
|
tcl::namespace::path [tcl::namespace::parent] |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::sixel::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 |
||||||
|
#} |
||||||
|
proc ascii_to_sixelvalue {a} { |
||||||
|
set dec [scan $a %c] |
||||||
|
if {$dec < 63 || $dec > 127} {error "ascii character to convert to sixel value must be from 63 to 126 (chars '?' through to '~')"} |
||||||
|
incr dec -63 |
||||||
|
} |
||||||
|
proc ascii_from_sixelvalue {sv} { |
||||||
|
if {$sv < 0 || $sv > 63} {error "sixel value must be from 0 to 63 inclusive"} |
||||||
|
format %c [expr {$sv + 63}] |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] [comment {--- end definitions namespace punk::sixel::lib ---}] |
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
package provide punk::sixel [tcl::namespace::eval punk::sixel { |
||||||
|
variable pkg punk::sixel |
||||||
|
variable version |
||||||
|
set version 999999.0a1.0 |
||||||
|
}] |
||||||
|
return |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[manpage_end] |
||||||
|
|
||||||
@ -0,0 +1,3 @@ |
|||||||
|
0.1.0 |
||||||
|
#First line must be a semantic version number |
||||||
|
#all other lines are ignored. |
||||||
@ -0,0 +1,287 @@ |
|||||||
|
# -*- 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 0.1.1 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license <unspecified> |
||||||
|
# @@ 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] |
||||||
|
} |
||||||
|
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] |
||||||
|
|
||||||
@ -0,0 +1,287 @@ |
|||||||
|
# -*- 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 0.1.1 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license <unspecified> |
||||||
|
# @@ 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] |
||||||
|
} |
||||||
|
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] |
||||||
|
|
||||||
|
Before Width: | Height: | Size: 11 MiB After Width: | Height: | Size: 11 MiB |
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in new issue