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.
2948 lines
134 KiB
2948 lines
134 KiB
|
|
#punk linerepl |
|
#todo - make repls configurable/pluggable packages |
|
|
|
|
|
#list/string-rep bug |
|
global run_commandstr "" |
|
|
|
set stdin_info [chan configure stdin] |
|
if {[dict exists $stdin_info -inputmode]} { |
|
#this is the only way I currently know to detect console on windows.. doesn't work on Alma linux. |
|
# tcl_interactive used by repl to determine if stderr output prompt to be printed. |
|
# (that way, piping commands into stdin should not produce prompts for each command) |
|
set tcl_interactive 1 |
|
} |
|
#however, the -mode option only seems to appear on linux when a terminal exists.. |
|
if {[dict exists $stdin_info -mode]} { |
|
set tcl_interactive 1 |
|
} |
|
#give up for now |
|
set tcl_interactive 1 |
|
|
|
|
|
|
|
|
|
|
|
|
|
package require Thread |
|
package require shellfilter |
|
#package require shellrun |
|
#package require punk |
|
package require punk::lib |
|
package require punk::aliascore |
|
if {[catch {punk::aliascore::init} errM]} { |
|
puts stderr "punk::aliascore::init error: $errM" |
|
} |
|
package require punk::config |
|
package require punk::ns |
|
package require punk::ansi |
|
package require punk::console |
|
package require textblock |
|
|
|
|
|
|
|
|
|
|
|
if {![info exists ::env(SHELL)]} { |
|
set ::env(SHELL) punk86 |
|
} |
|
if {![info exists ::env(TERM)]} { |
|
# tset -r seems to rely on env(TERM) - so this doesn't seem to work |
|
#if {![catch {exec tset -r} result]} { |
|
# #e.g Terminal type is xterm-256color. |
|
# set t [string trimright [lindex $result end] .] |
|
# set ::env(TERM) $t |
|
#} else { |
|
#fake it ? |
|
#set ::env(TERM) vt100 |
|
set ::env(TERM) xterm-256color |
|
#} |
|
} |
|
|
|
#todo - move to less generic namespace ie punk::repl |
|
namespace eval repl { |
|
variable codethread |
|
if {![info exists codethread]} { |
|
set codethread "" |
|
} |
|
variable codethread_cond |
|
|
|
variable screen_last_chars "" ;#a small sliding append buffer for last char of any screen output to detect \n vs string |
|
variable screen_last_char_list [list] |
|
|
|
#variable last_unknown "" |
|
tsv::set repl last_unknown "" |
|
variable output "" |
|
#important not to initialize - as it can be preset by cooperating package before app-punk has been package required |
|
#(this is an example of a deaddrop) |
|
variable post_script |
|
} |
|
|
|
namespace eval punk::repl { |
|
tsv::set repl runid 0 |
|
tsv::set repl runchunks-0 [list] ;#last_run_display |
|
|
|
|
|
variable debug_repl 0 |
|
variable signal_control_c 0 |
|
variable signal_control_c_msg "" |
|
variable prompt_reset_flag 0 ;#trigger repl to re-retrieve prompt settings |
|
|
|
proc todo {} { |
|
puts "tcl History" |
|
puts "repltelemetry package" |
|
puts "deaddrop package for a consistent way for modules to leave small notes to others that may come later." |
|
} |
|
|
|
#since we are targeting Tcl 8.6+ - we should be using 'interp bgerror .' |
|
#todo - make optional/configurable? |
|
proc bgerror2 {args} { |
|
puts stderr "====================" |
|
puts stderr "punk::repl::bgerror" |
|
puts stderr "====================" |
|
puts stderr "[lindex $args 0]" |
|
puts stderr "-------------------" |
|
puts stderr "[lrange $args 1 end]" |
|
puts stderr "====================" |
|
puts stderr "^^^^^^^^^^^^^^^^^^^" |
|
} |
|
proc bgerror {args} { |
|
set message [lindex $args 0] |
|
set errdict [lindex $args 1] |
|
puts stderr "\n*> repl background error: '$message'" |
|
#puts stderr "*> [set ::errorInfo]" |
|
puts stderr "*> errorinfo: [dict get $errdict -errorinfo]" |
|
set stdinreader [fileevent stdin readable] |
|
if {![string length $stdinreader]} { |
|
puts stderr "*> stdin reader inactive" |
|
} else { |
|
puts stderr "*> stdin reader active" |
|
} |
|
flush stderr |
|
} |
|
|
|
if {![llength [info commands ::bgerror]]} { |
|
#interp alias {} bgerror {} ::punk::repl::bgerror |
|
} |
|
interp bgerror "" ::punk::repl::bgerror |
|
|
|
} |
|
namespace eval repl { |
|
|
|
} |
|
|
|
proc ::punk::repl::init_signal_handlers {} { |
|
if {$::tcl_platform(platform) eq "windows"} { |
|
#puts stdout "===============repl loading twapi===========" |
|
if {![catch {package require twapi}]} { |
|
|
|
#If script launched with windows batch file - we have to be careful to stop a ctrl-c from eventually reaching the batch file when the program terminates, even if fully handled here. |
|
#This is done from within the launching batch file |
|
proc ::punk::repl::handler_console_control {args} { |
|
variable signal_control_c |
|
flush stderr |
|
variable signal_control_c_msg |
|
switch -- [lindex $args 0] { |
|
ctrl-c { |
|
#puts stderr "->event $args" |
|
flush stderr |
|
incr signal_control_c |
|
#rputs stderr "* console_control: $args" |
|
if {$::punk::console::is_raw} { |
|
if {[lindex $::errorCode 0] eq "CHILDKILLED"} { |
|
#rputs stderr "\n|repl> ctrl-c errorCode: $::errorCode" |
|
#avoid spurious triggers after interrupting a command.. |
|
#review - dodgy.. we just want to interrupt child processes but then still be able to interrupt repl |
|
set ::punk::repl::signal_control_c 0 |
|
set preverr [string map {"child killed" "child_killed"} $::errorInfo] |
|
catch {error $preverr} ;#for errorInfo display |
|
return 42 |
|
} else { |
|
#how to let rawmode loop handle it? It doesn't seem to get through if we return 0 |
|
#puts stderr "signal ctrl-c while in raw mode" |
|
#flush stderr |
|
set signal_control_c_msg "signal ctrl-c $signal_control_c rawmode" |
|
if {[catch { |
|
lassign [punk::console::get_size] _w console_width _h console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error get_size error:$errM" |
|
} |
|
|
|
if {$signal_control_c < 3} { |
|
set remaining [expr {3 - $signal_control_c}] |
|
if {[catch { |
|
punk::repl::console_controlnotification "[a+ web-orange]ctrl-c ($remaining more to quit, enter to continue)[a]" $console_width $console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error console_controlnotification error:$errM" |
|
} |
|
} elseif {$signal_control_c == 3} { |
|
#puts stderr "signal ctrl-c x3 received - quitting." |
|
if {[catch { |
|
punk::repl::console_controlnotification "ctrl-c x3 received - quitting punk shell" $console_width $console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error console_controlnotification error:$errM" |
|
} |
|
flush stderr |
|
after 25 |
|
quit |
|
return 1 |
|
} elseif {$signal_control_c > 5} { |
|
#fallback if quit didn't work |
|
#puts stderr "signal ctrl-c $signal_control_c received - sending to default handler" |
|
if {[catch { |
|
punk::repl::console_controlnotification "ctrl-c $signal_control_c received - sending to default handler" $console_width $console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error console_controlnotification error:$errM" |
|
} |
|
flush stderr |
|
punk::console::mode line |
|
return 0 |
|
} |
|
|
|
return 1 |
|
#after 200 {exit 42} ;#temp |
|
#return 42 |
|
} |
|
} |
|
|
|
|
|
if {[lindex $::errorCode 0] eq "CHILDKILLED"} { |
|
set signal_control_c 0 |
|
set preverr [string map {"child killed" "child_killed"} $::errorInfo] |
|
catch {error $preverr} ;#for errorInfo display |
|
return 42 |
|
} |
|
if {[catch { |
|
lassign [punk::console::get_size] _w console_width _h console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error get_size error:$errM" |
|
} |
|
|
|
#note - returning 0 means pass event to other handlers including OS default handler |
|
if {$signal_control_c <= 2} { |
|
set remaining [expr {3 - $signal_control_c}] |
|
#puts stderr "signal ctrl-c (perform $remaining more to quit, enter to return to repl)" |
|
#flush stderr |
|
if {[catch { |
|
punk::repl::console_controlnotification "ctrl-c ($remaining more to quit, enter to continue)" $console_width $console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error console_controlnotification error:$errM" |
|
} |
|
return 1 |
|
} elseif {$signal_control_c == 3} { |
|
#puts stderr "signal ctrl-c x3 received - quitting." |
|
if {[catch { |
|
punk::repl::console_controlnotification "ctrl-c x3 received - quitting punk shell" $console_width $console_height |
|
} errM]} { |
|
puts stderr "signal ctrl-c error console_controlnotification error:$errM" |
|
} |
|
flush stderr |
|
after 25 |
|
quit |
|
return 1 |
|
} elseif {$signal_control_c == 4} { |
|
puts stderr "signal ctrl-c x4 received - one more to hard exit" |
|
flush stderr |
|
return 1 |
|
} elseif {$signal_control_c >= 5} { |
|
#a script that allows events to be processed could still be running |
|
puts stderr "signal ctrl-c x5 received - hard exit" |
|
flush stderr |
|
after 25 |
|
exit 499 ;# HTTP 'client closed request' - just for the hell of it. |
|
} else { |
|
puts stderr "signal ctrl-c $signal_control_c received" |
|
flush stderr |
|
#return 0 to fall through to default handler |
|
return 0 |
|
} |
|
|
|
} |
|
default { |
|
puts stderr "unhandled console signal $args" |
|
return 1 |
|
} |
|
} |
|
} |
|
twapi::set_console_control_handler ::punk::repl::handler_console_control |
|
#we can't yet emit from an event with proper prompt handling - |
|
#repl::rputs stdout "twapi loaded" |
|
} else { |
|
#repl::rputs stderr " Failed to load twapi" |
|
} |
|
} else { |
|
#TODO |
|
} |
|
} |
|
|
|
#console handler may already be set, but in another thread/interp - so we can't use existence of proc to test |
|
#we're ok with an existing handler - just catch for now. REVIEW we should make sure it didn't fail the first time |
|
catch {punk::repl::init_signal_handlers} |
|
|
|
|
|
# moved to punk package.. |
|
#set outdevice [shellfilter::stack::new punkout -settings [list -tag "punkout" -buffering none -raw 1 -syslog [dict get $::punk::config::running syslog_stdout] -file [dict get $::punk::config::running logfile_stdout]]] |
|
#set out [dict get $outdevice localchan] |
|
#set errdevice [shellfilter::stack::new punkerr -settings [list -tag "punkerr" -buffering none -raw 1 -syslog [dict get $::punk::config::running syslog_stderr] -file [dict get $::punk::config::running logfile_stderr]]] |
|
#set err [dict get $errdevice localchan] |
|
|
|
|
|
|
|
# |
|
#set indevice [shellfilter::stack::new commandin -settings {-tag "commandin" -readbuffering line -writebuffering none -raw 1 -direction in}] |
|
#set program_read_stdin_pipe [dict get $indevice localchan] |
|
|
|
|
|
|
|
|
|
|
|
proc punk::repl::reset_prompt {} { |
|
variable prompt_reset_flag |
|
set prompt_reset_flag 1 |
|
} |
|
|
|
#aliases c and clear to this by ::punk |
|
proc punk::repl::reset_terminal {} { |
|
set prompt_reset_flag 1 |
|
#clear ;#call to external executable which may not be available |
|
puts -nonewline stdout [::punk::ansi::reset] |
|
} |
|
|
|
proc punk::repl::get_prompt_config {} { |
|
if {$::tcl_interactive} { |
|
set RST [a] |
|
set resultprompt "[a green bold]-$RST " |
|
set nlprompt "[a green bold].$RST " |
|
set infoprompt "[a green bold]*$RST " |
|
set debugprompt "[a purple bold]~$RST " |
|
} else { |
|
set resultprompt "" |
|
set nlprompt "" |
|
set infoprompt "" |
|
set debugprompt "" |
|
} |
|
return [list resultprompt $resultprompt nlprompt $nlprompt infoprompt $infoprompt debugprompt $debugprompt] |
|
} |
|
|
|
proc repl::start {inchan args} { |
|
puts stderr "-->repl::start $inchan $args" |
|
variable codethread |
|
#review |
|
if {$codethread eq ""} { |
|
error "start - no codethread. call init first. (options -safe 0|1)" |
|
} |
|
variable commandstr |
|
|
|
# --- |
|
variable editbuf |
|
variable editbuf_list ;#command history |
|
variable editbuf_linenum_submitted |
|
variable editbuf_active_index |
|
# --- |
|
|
|
variable reading |
|
variable done |
|
set done 0 |
|
variable startinstance |
|
variable loopinstance |
|
if {[namespace exists ::punkapp]} { |
|
#review - document ? |
|
if {[dict exists $args -defaultresult]} { |
|
set ::punkapp::default_result [dict get $args -defaultresult] |
|
} |
|
} |
|
incr startinstance |
|
set loopinstance 0 |
|
thread::send $codethread { |
|
#set ::punk::repl::codethread::running 1 |
|
|
|
#the interp in which commands such as d/ run |
|
#we need to namespace eval for the -safe interp which may not have the packages loaded (or be able to) but still needs default values |
|
#punk::repl::codethread::running is required whether safe or not. |
|
interp eval code { |
|
namespace eval ::punk::repl::codethread {} |
|
set ::punk::repl::codethread::running 1 |
|
namespace eval ::punk::ns::ns_current {} |
|
set ::punk::ns::ns_current :: |
|
} |
|
} |
|
set commandstr "" |
|
|
|
# --- |
|
set editbuf [punk::repl::class::class_editbuf new {}] |
|
lappend editbuf_list $editbuf ;#current editbuf is always in the history |
|
set editbuf_linenum_submitted 0 |
|
set editbuf_active_index 0 |
|
# --- |
|
|
|
if {$::punk::console::ansi_wanted == 2} { |
|
if {[::punk::console::test_can_ansi]} { |
|
set ::punk::console::ansi_wanted 1 |
|
} else { |
|
set ::punk::console::ansi_wanted -1 |
|
} |
|
} |
|
set prompt_config [punk::repl::get_prompt_config] |
|
doprompt "P% " |
|
fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] |
|
set reading 1 |
|
|
|
catch { |
|
#set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] |
|
} |
|
vwait [namespace current]::done |
|
fileevent $inchan readable {} |
|
|
|
|
|
#puts stderr "-->start done = $::repl::done" |
|
#todo - override exit? |
|
#after 0 ::repl::post_operations |
|
after idle ::repl::post_operations |
|
vwait repl::post_operations_done |
|
#puts stderr "-->start post_operations_done = $::repl::post_operations_done" |
|
if {[namespace exists ::punkapp]} { |
|
#todo check and get punkapp::result array - but what key? |
|
if {[info exists ::punkapp::result(shell)]} { |
|
set temp $::punkapp::result(shell) |
|
unset ::punkapp::result(shell) |
|
return $temp |
|
} elseif {[info exists ::punkapp::default_result]} { |
|
set temp $::punkapp::default_result |
|
unset ::punkapp::default_result |
|
return $temp |
|
} |
|
} |
|
|
|
|
|
variable codethread_cond |
|
if {[catch { |
|
tsv::unset codethread_$codethread |
|
} errM]} { |
|
puts stderr " repl::start temp warning - $errM" |
|
} |
|
thread::cancel $codethread |
|
thread::cond destroy $codethread_cond ;#race if we destroy cond before child thread has exited - as it can send a -async quit |
|
set codethread "" |
|
set codethread_cond "" |
|
punk::console::mode line ;#review - revert to line mode on final exit - but we may be exiting a nested repl |
|
puts "end repl::start" |
|
return 0 |
|
} |
|
proc repl::post_operations {} { |
|
if {[info exists ::repl::post_script] && [string length $::repl::post_script]} { |
|
#put aside post_script so the script has the option to add another post_script and restart the repl |
|
set ::repl::running_script $::repl::post_script |
|
set ::repl::post_script "" |
|
uplevel #0 {eval $::repl::running_script} |
|
} |
|
#todo - tidyup so repl could be restarted |
|
set ::repl::post_operations_done 0 |
|
} |
|
|
|
|
|
proc repl::reopen_stdin {} { |
|
#variable reopen_stdin_attempts |
|
if {$::tcl_platform(platform) eq "windows"} { |
|
puts stderr "|repl> Attempting reconnection of console to stdin by opening 'CON'" |
|
} else { |
|
puts stderr "|repl> Attempting reconnection of console to stdin by opening '/dev/tty'" |
|
} |
|
#puts stderr "channels:[chan names]" |
|
#flush stderr |
|
#catch {chan close stdin} |
|
chan close stdin |
|
|
|
if {$::tcl_platform(platform) eq "windows"} { |
|
#set s [open "CON" r] |
|
set s [open {CONIN$} r] |
|
if {[package provide twapi] ne ""} { |
|
set h [twapi::get_tcl_channel_handle $s in] |
|
twapi::SetStdHandle -10 $h |
|
} |
|
puts stderr "restarting repl on inputchannel:$s" |
|
return [repl::start $s -title "reopen_stdin a"] |
|
} else { |
|
#/dev/tty - reference to the controlling terminal for a process |
|
#review/test |
|
set s [open "/dev/tty" r] |
|
} |
|
|
|
repl::start stdin -title "reopen_stdin b" |
|
} |
|
|
|
#todo - avoid putting this in gobal namespace? |
|
#collisions with other libraries apps? |
|
proc punk::repl::quit {args} { |
|
set ::repl::done "quit {*}$args" |
|
#puts stderr "quit called" |
|
return "" ;#make sure to return nothing so "quit" doesn't land on stdout |
|
} |
|
|
|
#just a failed experiment.. tried various things |
|
proc repl::reopen_stdinX {} { |
|
#windows - todo unix |
|
package require twapi |
|
|
|
if 0 { |
|
if {[catch {package require Memchan} errM]} { |
|
#package require tcl::chan::fifo2 |
|
#lassign [tcl::chan::fifo2] a b |
|
package require tcl::chan::fifo |
|
set x [tcl::chan::fifo] |
|
} else { |
|
#lassign [fifo2] a b |
|
set x [fifo] |
|
} |
|
#first channel opened after stdin closed becomes stdin |
|
#use a fifo or fifo2 because [chan pipe] assigns the wrong end first! |
|
#a will be stdin |
|
} |
|
#these can't replace proper stdin (filehandle 0) because they're not 'file backed' or 'os level' |
|
#try opening a named pipe server to become stdin |
|
set pipename {\\.\pipe\stdin_%id%} |
|
set pipename [string map [list %id% [pid]] $pipename] |
|
|
|
|
|
|
|
package require tcl::chan::fifo |
|
|
|
chan close stdin |
|
lassign [tcl::chan::fifo] a |
|
|
|
|
|
puts stderr "newchan: $a" |
|
puts stderr "|test> $a [chan conf $a]" |
|
|
|
#set server [twapi::namedpipe_server $pipename] |
|
#set client [twapi::namedpipe_client $pipename] ;#open a client and connect to the server we just made |
|
|
|
puts stderr "chan names: [chan names]" |
|
|
|
#by now $server not valid? |
|
#set server stdin |
|
|
|
#chan configure $server -buffering line -encoding unicode |
|
#chan configure $client -buffering line -encoding unicode |
|
|
|
#puts stderr "|test>ns-server $server [chan conf $server]" |
|
#puts stderr "|test>ns-client $client [chan conf $client]" |
|
|
|
set conin [twapi::get_console_handle stdin] |
|
twapi::set_standard_handle stdin $conin |
|
|
|
set h_in [twapi::get_standard_handle stdin] |
|
|
|
puts stderr "|test> $a [chan conf $a]" |
|
|
|
#chan configure $client -blocking 0 |
|
after 2 repl::start $a |
|
|
|
} |
|
|
|
#add to sliding buffer of last x chars emmitted to screen by repl |
|
#(we could maintain only one char - more kept merely for debug assistance) |
|
#will not detect emissions from exec with stdout redirected and presumably some extensions etc |
|
proc repl::screen_last_char_add {c what {why ""}} { |
|
variable screen_last_chars |
|
variable screen_last_char_list |
|
if {![string length $c]} { |
|
return [string index $screen_last_chars end] |
|
} |
|
if {[string length $screen_last_chars] > 10} { |
|
set screen_last_chars [string range $screen_last_chars 1 end] ;#evict first char |
|
set screen_last_char_list [lrange $screen_last_char_list 1 end] |
|
} |
|
append screen_last_chars $c |
|
lappend screen_last_char_list [list $c $what $why] |
|
#return [string index $screen_last_chars end] |
|
#return [lindex $screen_last_char_list 0 0] |
|
return [lindex $screen_last_char_list end 0] |
|
} |
|
proc repl::screen_last_char_get {} { |
|
variable screen_last_char_list |
|
return [lindex $screen_last_char_list end 0] |
|
} |
|
proc repl::screen_last_char_getinfo {} { |
|
variable screen_last_char_list |
|
return [lindex $screen_last_char_list end] |
|
} |
|
|
|
#-------------------------------------- |
|
#another experiment |
|
proc repl::newout {} { |
|
namespace eval ::replout { |
|
namespace ensemble create -map { |
|
initialize init |
|
finalize close |
|
watch watch |
|
write write |
|
} |
|
} |
|
proc ::replout::init {id mode} { |
|
return {initialize finalize watch write} |
|
} |
|
proc ::replout::close {id} { |
|
|
|
} |
|
proc ::replout::watch {id spec} { |
|
|
|
} |
|
proc ::replout::write {id data} { |
|
puts -nonewline stderr $data |
|
return [string length $data] |
|
} |
|
|
|
close stdout |
|
set fd [chan create write ::replout] |
|
chan configure $fd -buffering none |
|
return $fd |
|
} |
|
interp alias {} newout {} repl::newout |
|
proc repl::newout2 {} { |
|
close stdout |
|
set s [open "CON" w] |
|
chan configure $s -buffering none |
|
} |
|
#-------------------------------------- |
|
|
|
proc repl::doprompt {prompt {col {green bold}}} { |
|
#prompt to stderr. |
|
#We can pipe commands into repl's stdin without the prompt interfering with the output. |
|
#Although all command output for each line goes to stdout - not just what is emmited with puts |
|
|
|
if {$::tcl_interactive} { |
|
set last_char_info [screen_last_char_getinfo] |
|
if {![llength $last_char_info]} { |
|
set needs_clearance 1 |
|
} else { |
|
lassign $last_char_info c what why |
|
if {$why eq "prompt"} { |
|
set needs_clearance 0 |
|
} else { |
|
set needs_clearance [screen_needs_clearance] |
|
#puts -nonewline "-->$needs_clearance $last_char_info" |
|
} |
|
} |
|
if {$needs_clearance == 1} { |
|
set c \n |
|
} else { |
|
set c "" |
|
} |
|
set pre "" |
|
if {[string first \n $prompt] >=0} { |
|
set plines [split $prompt \n] |
|
set pre [join [lrange $plines 0 end-1] \n]\n |
|
set prompt [lindex $plines end] |
|
} |
|
|
|
#this sort of works - but steals some of our stdin data ? review |
|
# |
|
#lassign [punk::console::get_cursor_pos_list] column row |
|
#if {$row != 1} { |
|
# set c "\n" |
|
#} |
|
|
|
set o [a {*}$col] |
|
set r [a] |
|
puts -nonewline stderr $c$pre$o$prompt$r |
|
screen_last_char_add " " "prompt-stderr" prompt |
|
flush stderr |
|
} |
|
} |
|
|
|
#use rputs in repl_handler instead of puts |
|
# - to help ensure we don't emit extra blank lines in info or debug output |
|
#rputs expects the standard tcl 'puts' command to be in place. |
|
# all bets are off if this has been redefined with some other api |
|
# rputs deliberately doesn't check screen_last_chars before emitting data (unless reporting an error in rputs itself) |
|
proc repl::rputs {args} { |
|
variable screen_last_chars |
|
variable last_out_was_newline |
|
variable last_repl_char |
|
|
|
set pseudo_map [dict create\ |
|
debug stderr\ |
|
debugreport stderr\ |
|
] |
|
|
|
if {[::tcl::mathop::<= 1 [llength $args] 3]} { |
|
set out [lindex $args end] |
|
append out ""; #copy on write |
|
if {([llength $args] > 1) && [lindex $args 0] ne "-nonewline"} { |
|
set this_tail \n |
|
set rputschan [lindex $args 0] |
|
#map pseudo-channels to real |
|
if {$rputschan in [dict keys $pseudo_map]} { |
|
lset args 0 [dict get $pseudo_map $rputschan] |
|
} |
|
} elseif {[llength $args] == 1} { |
|
set this_tail \n |
|
set rputschan "stdout" |
|
} else { |
|
#>1 arg with -nonewline |
|
set this_tail [string index $out end] |
|
set rputschan [lindex $args 1] |
|
#map pseudo-channels to real |
|
if {$rputschan in [dict keys $pseudo_map]} { |
|
lset args 0 [dict get $pseudo_map $rputschan] |
|
} |
|
} |
|
set last_char_info_width 60 |
|
#review - string shouldn't be truncated prior to stripcodes - could chop ansi codes! |
|
#set summary "[::shellfilter::ansi::stripcodes [string range $out 0 $last_char_info_width]]" |
|
set out_plain_text [punk::ansi::ansistrip $out] |
|
set summary [string range $out_plain_text 0 $last_char_info_width] |
|
if {[string length $summary] > $last_char_info_width} { |
|
append summary " ..." |
|
} |
|
|
|
#make sure we use supplied rputschan in the screen_las_char_add 'what' - which may not be the underlying chan if it was a pseudo |
|
screen_last_char_add $this_tail repl-$rputschan $summary |
|
|
|
try { |
|
puts {*}$args |
|
} on error {repl_error erropts} { |
|
#possible error depending on -encoding and -profile of the channel |
|
#(e.g -profile strict) |
|
|
|
#REVIEW |
|
#TODO - something better |
|
#failure case: |
|
#set x \ud83c\udf1e |
|
#(2 surrogate pairs - treated as single char in tcl8 - fixed in 9 but won't/can't be backported) - |
|
#see also: https://core.tcl-lang.org/tips/doc/trunk/tip/619.md |
|
puts stderr "$repl_error" |
|
} |
|
} else { |
|
#looks like an invalid puts call - use the normal error produced by the puts command |
|
#This should only occur if the repl itself is being rewritten/debugged, |
|
#so we will use red "!" and not worry about the extra newlines before and after |
|
if {[catch { puts {*}$args } err]} { |
|
set c [a yellow bold] |
|
set n [a] |
|
#possibly non punk-compliant output because we're assuming the repl was the most recent emitter |
|
#could be wrong, in which case we may emit an extra newline |
|
#- shouldn't matter in this case |
|
#set last_char [string range $screen_last_chars end] |
|
set last_char [screen_last_char_get] |
|
if {$last_char eq "\n"} { |
|
set clear "" |
|
} else { |
|
set clear "\n" |
|
} |
|
puts -nonewline stderr "$clear[a red bold]! REPL ERROR IN rputs $c$err$n\n" |
|
screen_last_char_add "\n" replerror "rputs err: '$err'" |
|
return |
|
} else { |
|
#?? shouldn't happen with standard puts command |
|
#do our best and assume final arg is still the data being emitted |
|
#worst that will happen is we won't detect a trailing newline and will later emit an extra blank line. |
|
set out [lindex $args end] |
|
set this_tail [string index $out end] |
|
screen_last_char_add $this_tail replunknown "rputs $args" |
|
return |
|
} |
|
} |
|
} |
|
#whether we need a newline as clearance from previous output |
|
#review - race with copy pasted data, hold-down of enter key |
|
# and data from external process or background script that doesn't go through our stdout filter |
|
#we probably can't use get_cursor_pos - as that needs to emit to stdout and read-loop on stdin which will possibly? make things worse |
|
proc repl::screen_needs_clearance {} { |
|
variable screen_last_chars |
|
|
|
#set last_char [string index $screen_last_chars end] |
|
set last_char_info [screen_last_char_getinfo] |
|
if {![llength $last_char_info]} { |
|
#assumption |
|
return 1 |
|
} |
|
lassign $last_char_info c what why |
|
switch -- $what { |
|
stdout - stderr - stdout/stderr { |
|
return 1 |
|
} |
|
} |
|
return [expr {$c ne "\n"}] |
|
} |
|
|
|
namespace eval repl { |
|
variable startinstance 0 |
|
variable loopinstance 0 |
|
variable in_repl_handler [list] |
|
variable last_controlc_count 0 |
|
} |
|
|
|
namespace eval punk::repl::class { |
|
oo::class create class_bufman { |
|
|
|
} |
|
|
|
#multiline editing buffer |
|
oo::class create class_editbuf { |
|
variable o_context |
|
variable o_config |
|
|
|
variable o_rendered_lines |
|
variable o_remaining ;#? |
|
|
|
#o_chunk_list & o_chunk_info should make timed viewing of replays possible |
|
variable o_chunk_list |
|
variable o_chunk_info ;#arrival timing etc |
|
variable o_cursor_row |
|
variable o_cursor_col |
|
variable o_insert_mode |
|
constructor {configdict {contextdict {}}} { |
|
my clear |
|
set o_config $configdict |
|
if {[dict exists $configdict rendered_initialchunk]} { |
|
#pre-rendered initial chunk |
|
#-- |
|
set o_chunk_list "" ;#replace empty chunk from 'clear' call |
|
set o_chunk_info [dict create] |
|
#-- |
|
set ch [dict get $configdict rendered_initialchunk] |
|
my add_rendered_chunk $ch |
|
} |
|
|
|
set o_context $contextdict |
|
#error "[self class].constructor Unable to interpret config '$o_config'" |
|
} |
|
method cursor_row {} { |
|
return $o_cursor_row |
|
} |
|
method cursor_column {} { |
|
return $o_cursor_col |
|
} |
|
method insert_mode {} { |
|
return $o_insert_mode |
|
} |
|
method clear {} { |
|
set o_rendered_lines [list ""] |
|
set o_chunk_list [list] |
|
set o_chunk_info [dict create] |
|
set o_cursor_row 1 |
|
set o_cursor_col 1 |
|
set o_insert_mode 1 ;#default to insert mode |
|
lappend o_chunk_list "" |
|
dict set o_chunk_info 0 [dict create micros [clock microseconds] type rendered] |
|
} |
|
method add_chunk {chunk} { |
|
#we still split on lf - but each physical line may contain horizontal or vertical movements so we need to feed each line in and possibly get an overflow_right and unapplied and cursor-movent return info |
|
lappend o_chunk_list $chunk ;#may contain newlines,horizontal/vertical movements etc - all ok |
|
dict set o_chunk_info [expr {[llength $o_chunk_list] -1}] [dict create micros [clock microseconds] type raw] |
|
if {$chunk eq ""} { |
|
return |
|
} |
|
|
|
set firstnl [string first \n $chunk] |
|
set newparts [split $chunk \n] |
|
#attempt to render new 'lines' into the editbuffer - taking account of active cursor row & col & insertmode |
|
|
|
#merge based on current cursor row and col |
|
#set lastrline [lindex $o_rendered_lines end] |
|
#set n0 [lindex $newparts 0] |
|
#set merged0 [string cat $lastrline $n0] |
|
|
|
#we should merge first row of newparts differently in case our chunks split a grapheme-combination? |
|
# |
|
if {$o_cursor_row < 1} { |
|
puts stderr "add_chunk warning cursor_row < 1 - changing to minimum value 1" |
|
set o_cursor_row 1 |
|
} |
|
set cursor_row_idx [expr {$o_cursor_row -1}] |
|
set activeline [lindex $o_rendered_lines $cursor_row_idx] |
|
set new0 [lindex $newparts 0] |
|
#set combined [string cat $activeline $new0] |
|
#use -cursor_row to tell renderline it's row context. |
|
if {$firstnl >=0} { |
|
#append combined \n |
|
append new0 \n |
|
} |
|
set underlay [punk::ansi::ansistrip $activeline] |
|
set line_nextchar_col [expr {[punk::char::string_width $underlay] + 1}] |
|
if {$o_cursor_col > $line_nextchar_col} { |
|
set o_cursor_col $line_nextchar_col |
|
} |
|
|
|
set mergedinfo [overtype::renderline -info 1 -expand_right 1 -insert_mode $o_insert_mode -cursor_column $o_cursor_col -cursor_row $o_cursor_row $underlay $new0] |
|
|
|
set result [dict get $mergedinfo result] |
|
set o_insert_mode [dict get $mergedinfo insert_mode] |
|
set result_col [dict get $mergedinfo cursor_column] |
|
set result_row [dict get $mergedinfo cursor_row] |
|
set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v |
|
set unapplied [dict get $mergedinfo unapplied] |
|
set instruction [dict get $mergedinfo instruction] |
|
|
|
set insert_lines_below [dict get $mergedinfo insert_lines_below] |
|
set insert_lines_above [dict get $mergedinfo insert_lines_above] |
|
|
|
# -- --- --- --- --- --- |
|
set debug_first_row 2 |
|
#puts "merged: $mergedinfo" |
|
set debug "add_chunk0" |
|
append debug \n $mergedinfo |
|
append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $result_row before col:$o_cursor_col after col:$result_col" |
|
package require textblock |
|
set debug [textblock::frame -buildcache 0 $debug] |
|
catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} |
|
# -- --- --- --- --- --- |
|
|
|
set o_cursor_col $result_col |
|
set cursor_row_idx [expr {$o_cursor_row-1}] |
|
lset o_rendered_lines $cursor_row_idx $result |
|
|
|
set nextrow $result_row |
|
switch -- $instruction { |
|
lf_start { |
|
#for normal commandline - we just add a line below |
|
lappend o_rendered_lines "" |
|
incr nextrow |
|
set o_cursor_col 1 |
|
} |
|
} |
|
|
|
if {$insert_lines_below == 1} { |
|
if {[string length $overflow_right]} { |
|
lappend o_rendered_lines $overflow_right |
|
set o_cursor_col [expr {[punk::ansi::printing_length $overflow_right] +1}] |
|
} else { |
|
lappend o_rendered_lines "" |
|
set o_cursor_col 1 |
|
} |
|
} elseif {$insert_lines_above == 1} { |
|
#for {set i 0} {$i < $insert_lines_above} {incr i} { |
|
# set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""] |
|
# incr nextrow -1 |
|
#} |
|
set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""] |
|
set o_cursor_col 1 |
|
} |
|
|
|
set o_cursor_row $nextrow |
|
set cursor_row_idx [expr {$o_cursor_row-1}] |
|
if {$cursor_row_idx < [llength $o_rendered_lines]} { |
|
set activeline [lindex $o_rendered_lines $cursor_row_idx] |
|
} else { |
|
lappend o_rendered_lines "" |
|
set activeline "" |
|
} |
|
|
|
|
|
set i 1 |
|
foreach p [lrange $newparts 1 end] { |
|
if {$i < [llength $newparts]-1} { |
|
append p \n |
|
} else { |
|
if {$p eq ""} { |
|
break |
|
} |
|
} |
|
#puts stderr "overtype::renderline -info 1 -expand_right 1 -insert_mode $o_insert_mode -cursor_column $o_cursor_col -cursor_row $o_cursor_row $activeline '$p'" |
|
set underlay $activeline |
|
set line_nextchar_col [expr {[punk::char::string_width $underlay] + 1}] |
|
if {$o_cursor_col > $line_nextchar_col} { |
|
set o_cursor_col $line_nextchar_col |
|
} |
|
set mergedinfo [overtype::renderline -info 1 -expand_right 1 -insert_mode $o_insert_mode -cursor_column $o_cursor_col -cursor_row $o_cursor_row $underlay $p] |
|
set debug "add_chunk$i" |
|
append debug \n $mergedinfo |
|
append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $p]" |
|
set debug [textblock::frame -buildcache 0 $debug] |
|
#catch {punk::console::move_emitblock_return [expr {$debug_first_row + ($i * 6)}] 1 $debug} |
|
|
|
set result [dict get $mergedinfo result] |
|
set o_insert_mode [dict get $mergedinfo insert_mode] |
|
set o_cursor_col [dict get $mergedinfo cursor_column] |
|
set cmove [dict get $mergedinfo cursor_row] |
|
set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v |
|
set unapplied [dict get $mergedinfo unapplied] |
|
set insert_lines_below [dict get $mergedinfo insert_lines_below] |
|
if {[string is integer -strict $cmove]} { |
|
if {$cmove == 0} { |
|
set nextrow [expr {$o_cursor_row + 1}] |
|
set o_cursor_col 1 |
|
} elseif {$cmove == 1} { |
|
#check for overflow_right and unapplied |
|
#leave cursor_column |
|
} elseif {$cmove >= 1} { |
|
|
|
} |
|
|
|
} else { |
|
# =<int> - absolute |
|
set nextrow [string range $cmove 1 end] |
|
} |
|
if {$nextrow eq $o_cursor_row} { |
|
incr nextrow |
|
} |
|
set o_cursor_row $nextrow |
|
if {$insert_lines_below} { |
|
|
|
} |
|
|
|
set cursor_row_idx [expr {$o_cursor_row-1}] |
|
if {$cursor_row_idx < [llength $o_rendered_lines]} { |
|
set activeline [lindex $o_rendered_lines $cursor_row_idx] |
|
} else { |
|
lappend o_rendered_lines "" |
|
set activeline "" |
|
} |
|
lset o_rendered_lines $cursor_row_idx $result |
|
|
|
incr i |
|
} |
|
|
|
} |
|
method add_rendered_chunk {rchunk} { |
|
#split only on lf newlines - movement codes and \b \v \r not expected |
|
#check only for \v \r as chars we don't expect/want in rendered lines |
|
#chunk as been pre-rendered (or is known to be plain ascii without ANSI or \b \v \r) |
|
#but we don't yet have grapheme split info for it |
|
|
|
if {[regexp {[\v\b\r]} $rchunk]} { |
|
error "[self class].add_rendered_chunk chunk contains \\v or \\b or \\r. Rendered chunk shouldn't contain these characters or ANSI movement codes" |
|
} |
|
lappend o_chunk_list $rchunk ;#rchunk may contain newlines - that's ok |
|
dict set o_chunk_info [expr {[llength $o_chunk_list] -1}] [dict create micros [clock microseconds] type rendered] |
|
|
|
set newparts [split $rchunk \n] |
|
#lappend o_chunk_list $rchunk |
|
set lastrline [lindex $o_rendered_lines end] |
|
|
|
#in renderedlines list merge last line of old with first line of new |
|
#we can't just cat the newpart on to existing rendered line - the chunk could have split a grapheme (e.g char+combiner(s)) |
|
#we |
|
#todo - redo grapheme split on merged line |
|
set merged [string cat $lastrline [lindex $newparts 0]] |
|
lset o_rendered_lines end $merged |
|
|
|
#todo |
|
#each newpart needs its grapheme split info to be stored |
|
set o_rendered_lines [concat $o_rendered_lines [lrange $newparts 1 end]] |
|
|
|
} |
|
method linecount {} { |
|
return [llength $o_rendered_lines] |
|
} |
|
method line {idx} { |
|
if {[string is integer -strict $idx]} { |
|
incr idx -1 |
|
} |
|
return [lindex $o_rendered_lines $idx] |
|
} |
|
method lines {args} { |
|
switch -- [llength $args] { |
|
0 {return $o_rendered_lines} |
|
1 { |
|
set idx [lindex $args 0] |
|
if {[string is integer -strict $idx]} { |
|
incr idx -1 |
|
} |
|
return [list [lindex $o_rendered_lines $idx]] |
|
} |
|
2 { |
|
lassign $args idx1 idx2 |
|
if {[string is integer -strict $idx1]} { |
|
incr idx1 -1 |
|
} |
|
if {[string is integer -strict $idx2]} { |
|
incr idx2 -1 |
|
} |
|
return [lrange $o_rendered_lines $idx1 $idx2] |
|
} |
|
default {error "lines expected 0,1 or 2 indices"} |
|
} |
|
} |
|
|
|
#todo - index base??? |
|
method lines_numbered {args} { |
|
#build a paired list so we don't have to do various calcs on end+ end- etc checking llength |
|
#punk::lib::range will use lseq if available - else use it's own slower code |
|
set max [llength $o_rendered_lines] ;#assume >=1 |
|
set nums [punk::lib::range 1 $max] |
|
set numline_list [list] |
|
foreach n $nums ln $o_rendered_lines { |
|
lappend numline_list [list $n $ln] |
|
} |
|
|
|
switch -- [llength $args] { |
|
0 {return $numline_list} |
|
1 {return [lindex $numline_list [lindex $args 0]]} |
|
2 {return [lrange $numline_list {*}$args]} |
|
default {error "lines expected 0,1 or 2 indices"} |
|
} |
|
} |
|
|
|
#1-based |
|
method delete_line {linenum} { |
|
error "unimplemented" |
|
if {$linenum eq "end"} { |
|
set linenum [llength $o_rendered_lines] |
|
} |
|
if {![string is integer -strict $linenum]} { |
|
error "delete_line accepts only end or an integer from 1 to linecount" |
|
} |
|
if {$linenum == 0} { |
|
error "minimum line is 1" |
|
} |
|
set o_rendered_lines [lreplace $o_rendered_lines $index $index] |
|
} |
|
#clear data from last line only |
|
method clear_tail {} { |
|
set o_cursor_row [llength $o_rendered_lines] |
|
set o_cursor_col 1 |
|
lset o_rendered_lines end "" |
|
} |
|
#1-based |
|
method view_lines {args} { |
|
set llist [my lines {*}$args] |
|
return [join $llist \n] |
|
} |
|
method view_lines_numbered {args} { |
|
set ANSI_linenum [a+ green] |
|
set RST [a] |
|
set llist [my lines_numbered {*}$args] |
|
set nums [lsearch -all -inline -index 0 -subindices $llist *] |
|
lset nums $o_cursor_row-1 "[a+ bold underline]$o_cursor_row${RST}$ANSI_linenum" |
|
set lines [lsearch -all -inline -index 1 -subindices $llist *] |
|
|
|
set cursorline [lindex $lines $o_cursor_row-1] |
|
set charindex_at_cursor [ansistring COLUMNINDEX $cursorline $o_cursor_col] |
|
if {$charindex_at_cursor ne ""} { |
|
lassign [ansistring INDEXCOLUMNS $cursorline $charindex_at_cursor] col0 col1 |
|
#we now have the column extents of the possibly double-wide character at the cursor |
|
#we can apply ansi just to those columns using a transparent overtype |
|
set prefix [string repeat " " [expr {$col0 -1}]] |
|
set linecols [punk::ansi::printing_length $cursorline] |
|
set suffix [string repeat " " [expr {$linecols -$col1}]] |
|
#capitalised INDEX - for grapheme/control-char index e.g a with diacritic a\u0300 has a single index |
|
set char_at_cursor [ansistring INDEX $cursorline $charindex_at_cursor] ;#this is the char with appropriate ansireset codes |
|
set rawchar [punk::ansi::ansistrip $char_at_cursor] |
|
if {$rawchar eq " "} { |
|
set charhighlight "[punk::ansi::a+ White]_[a]" |
|
} else { |
|
set charhighlight [punk::ansi::a+ reverse]$char_at_cursor[a] |
|
} |
|
set cursorline [overtype::renderline -transparent 1 -insert_mode 0 -expand_right 0 $cursorline $prefix$charhighlight$suffix] |
|
lset lines $o_cursor_row-1 $cursorline |
|
} |
|
|
|
set numcol "$ANSI_linenum[join $nums \n][a]" |
|
set linecol [join $lines \n] |
|
return [textblock::join -- $numcol " " $linecol] |
|
} |
|
method debugview_lines {} { |
|
set result "" |
|
foreach ln $o_rendered_lines { |
|
append result [ansistring VIEW -lf 1 -vt 1 $ln] \n ;#should be no lf or vt - but if there is.. we'd better show it |
|
} |
|
append result \n "cursor row: $o_cursor_row col: $o_cursor_col" |
|
return $result |
|
} |
|
method last_char {} { |
|
return [string index [lindex $o_chunk_list end] end] |
|
} |
|
|
|
#more strictly - last non-ansi? |
|
method last_grapheme {} { |
|
set lastchunk [lindex $o_chunk_list end] |
|
set plaintext_parts [punk::ansi::ta::split_at_codes $lastchunk] |
|
set pt [lindex $plaintext_parts end] |
|
if {$pt eq ""} { |
|
set pt [lindex $plaintext_parts end-1] |
|
} |
|
set graphemes [punk::char::grapheme_split $pt] |
|
return [lindex $graphemes end] |
|
} |
|
method last_ansi {} { |
|
set lastchunk [lindex $o_chunk_list end] |
|
set parts [punk::ansi::ta::split_codes_single $lastchunk] |
|
set lastcode [lindex $parts end-1] |
|
return $lastcode |
|
#return [ansistring VIEW -lf 1 $lastcode] |
|
} |
|
method chunks {args} { |
|
switch -- [llength $args] { |
|
0 {return $o_chunk_list} |
|
1 {return [lindex $o_chunk_list [lindex $args 0]]} |
|
2 {return [lrange $o_chunk_list {*}$args]} |
|
default {error "chunks expected 0,1 or 2 arguments (index or range)"} |
|
} |
|
} |
|
method view_chunks {} { |
|
set result "" |
|
set dashes [string repeat - 20] |
|
foreach arrival_chunk $o_chunk_list chunk_id [dict keys $o_chunk_info] { |
|
set chunk_info [dict get $o_chunk_info $chunk_id] |
|
append result $dashes \n |
|
set micros [dict get $chunk_info micros] |
|
append result "$chunk_id arrival: [clock format [expr {$micros / 1000000}] -format "%Y-%m-%d %H:%M:%S"] ($micros)" \n |
|
append result $dashes \n |
|
append result $arrival_chunk \n |
|
} |
|
return $result |
|
} |
|
|
|
method debugview_chunks {} { |
|
set result "" |
|
foreach ln $o_chunk_list { |
|
append result [ansistring VIEW -lf 1 -vt 1 $ln] \n |
|
} |
|
append result \n "cursor row: $o_cursor_row col: $o_cursor_col" |
|
return $result |
|
} |
|
method view_raw {} { |
|
return [join $o_chunk_list ""] |
|
} |
|
method debugview_raw {} { |
|
set sublf [ansistring VIEW -lf 1 \n] |
|
#set subvt [ansistring VIEW -lvt 1 \v] ;#vt replacement with $subvt\v will not align accurately.. todo ? |
|
return [string map [list $sublf $sublf\n] [ansistring VIEW -lf 1 -vt 0 [join $o_chunk_list ""]]] |
|
} |
|
} |
|
|
|
} |
|
|
|
proc ::punk::repl::repl_handler_checkchannel {inputchan} { |
|
if {[catch {chan eof $inputchan} is_eof]} { |
|
::repl::rputs stderr "\n|repl> repl_handler_checkchannel error on $inputchan. (closed?) msg:$is_eof" |
|
} else { |
|
if {$is_eof} { |
|
if {$::tcl_interactive} { |
|
::repl::rputs stderr "\n|repl> repl_handler_checkchannel EOF on $inputchan." |
|
} |
|
} |
|
} |
|
} |
|
proc ::punk::repl::repl_handler_checkcontrolsignal_linemode {inputchan} { |
|
#todo - what? |
|
return |
|
variable signal_control_c |
|
if {$signal_control_c > 0} { |
|
if {$::tcl_interactive} { |
|
::repl::rputs stderr "\n|repl> repl_handler_checkcontrolsignal_linemode ctrl-c errorCode 0: [lindex $::errorCode 0]" |
|
} |
|
} |
|
} |
|
|
|
#This is not called from the signal handler - so we can't affect the signal handling with return |
|
# |
|
proc ::punk::repl::repl_handler_checkcontrolsignal_rawmode {inputchan} { |
|
variable signal_control_c |
|
variable signal_control_c_msg |
|
if {$signal_control_c > 0 && $signal_control_c_msg ne "" } { |
|
#if {$::tcl_interactive} { |
|
# ::repl::rputs stderr "\n|repl> repl_handler_checkcontrolsignal_rawmode ctrl-c errorCode 0: [lindex $::errorCode 0]" |
|
#} |
|
set msg $signal_control_c_msg |
|
set signal_control_c_msg "" |
|
} else { |
|
set msg "" |
|
} |
|
return [list count $signal_control_c msg $msg] |
|
} |
|
|
|
|
|
proc punk::repl::repl_handler_restorechannel_if_not_eof {inputchan previous_input_state} { |
|
if {$inputchan ni [chan names] || [eof $inputchan]} { |
|
return |
|
} |
|
if {[chan conf $inputchan] ne $previous_input_state} { |
|
set restore_input_conf [dict remove $previous_input_state -inputmode] ;#Attempting to set input mode often gives permission denied on windows - why? |
|
if {[catch { |
|
chan conf $inputchan {*}$restore_input_conf |
|
} errM]} { |
|
rputs stderr "|repl>original: [ansistring VIEW $previous_input_state]" |
|
rputs stderr "|repl>current : [ansistring VIEW [chan conf $inputchan]]" |
|
rputs stderr "\n|repl> Failed to return $inputchan to original state" |
|
rputs stderr "|repl>ERR: $errM" |
|
} |
|
} |
|
return [chan conf $inputchan] |
|
} |
|
proc repl::repl_handler {inputchan prompt_config} { |
|
# -- review |
|
variable in_repl_handler |
|
set in_repl_handler [list $inputchan $prompt_config] |
|
# -- |
|
variable last_controlc_count |
|
|
|
upvar ::punk::repl::prompt_reset_flag prompt_reset_flag |
|
if {$prompt_reset_flag == 1} { |
|
set prompt_config [punk::repl::get_prompt_config] |
|
set prompt_reset_flag 0 |
|
} |
|
|
|
fileevent $inputchan readable {} |
|
upvar ::punk::console::input_chunks_waiting input_chunks_waiting |
|
#note -inputmode not available in Tcl 8.6 for chan configure! |
|
#According to DKF - -buffering option doesn't affect input channels |
|
set rawmode 0 |
|
set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state |
|
if {[dict exists $original_input_conf -inputmode]} { |
|
if {[dict get $original_input_conf -inputmode] eq "raw"} { |
|
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match |
|
set rawmode 1 |
|
set ::punk::console::is_raw 1 |
|
} else { |
|
set ::punk::console::is_raw 0 |
|
} |
|
#what about enable/disable virtualTerminal ? |
|
#using stdin -inputmode to switch modes won't set virtualterminal input state appropriately |
|
#we expect the state of -inputmode to be 'normal' even though we flip it during the read part of our repl loop |
|
#if it's been set to raw - assume it is deliberately done this way as the user could have alternatively called punk::mode raw or punk::console::enableVirtualTerminal |
|
#by not doing this automatically - we assume the caller has a reason. |
|
} else { |
|
#JMN FIX! |
|
#this returns 0 in rawmode on 8.6 after repl thread changes |
|
set rawmode [set ::punk::console::is_raw] |
|
} |
|
|
|
if {!$rawmode} { |
|
#linemode |
|
|
|
#stdin with line-mode readable events (at least on windows for Tcl 8.7a6 to 9.0a) can get stuck with bytes pending when input longer than 100chars - even though there is a linefeed further on than that. |
|
#This potentially affects a reasonable number of Tcl8.7 kit/tclsh binaries out in the wild. |
|
#see bug https://core.tcl-lang.org/tcl/tktview/bda99f2393 (gets stdin problem when non-blocking - Windows) |
|
#when in non-blocking mode we will have to read that in to get further - but we don't know if that was the end of line or if there is more - and we may not get a newline even though one was present originally on stdin. |
|
#presence of 8.7 buffering bug will result in unrecoverable situation - even switching to raw and using read will not be able to retrieve tail data. |
|
#the readable event only gives us 200 bytes (same problem may be at 4k/8k in other versions) |
|
#This occurs whether we use gets or read - |
|
set stdinlines [list] |
|
if {[dict get $original_input_conf -blocking] ne "0"} { |
|
chan configure $inputchan -blocking 0 |
|
} |
|
|
|
set waitingchunk "" |
|
#review - input_chunks_waiting in line mode - |
|
if {[info exists input_chunks_waiting($inputchan)] && [llength $input_chunks_waiting($inputchan)]} { |
|
#puts stderr "repl_handler input_chunks_waiting($inputchan) while in line mode. Had data:[ansistring VIEW -lf 1 $input_chunks_waiting($inputchan)]" |
|
set allwaiting [join $input_chunks_waiting($inputchan) ""] |
|
set input_chunks_waiting($inputchan) [list] |
|
set yellow [punk::ansi::a+ yellow bold] |
|
set waitinglines [split $allwaiting \n] |
|
foreach ln [lrange $waitinglines 0 end-1] { |
|
lappend stdinlines $ln |
|
} |
|
set waitingchunk [lindex $waitinglines end] |
|
# -- |
|
#set chunksize [gets $inputchan chunk] |
|
set chunk [read $inputchan] |
|
set chunksize [string length $chunk] |
|
# -- |
|
if {$chunksize > 0} { |
|
if {[string index $chunk end] eq "\n"} { |
|
lappend stdinlines $waitingchunk[string range $chunk 0 end-1] |
|
#punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" |
|
|
|
punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf |
|
uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] |
|
} else { |
|
set input_chunks_waiting($inputchan) [list $allwaiting] |
|
lappend input_chunks_waiting($inputchan) $chunk |
|
} |
|
} else { |
|
if {[fblocked $inputchan]} { |
|
#REVIEW - need to und |
|
#todo - figure out why we're here. |
|
#can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) |
|
#punk::console::get_size is problematic if -winsize not available on the stdout channel - which is the case for certain 8.6 versions at least.. platform variances? |
|
## can't do this: set screeninfo [punk::console::get_size]; lassign $screeninfo _c cols _r rows |
|
set outconf [chan configure stdout] |
|
set RED [punk::ansi::a+ red bold]; set RST [punk::ansi::a] |
|
if {"windows" eq $::tcl_platform(platform)} { |
|
set msg "${RED}$inputchan fblocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" |
|
} else { |
|
set msg "${RED}$inputchan fblocked is true.$RST \{$allwaiting\}" |
|
} |
|
set cols "" |
|
set rows "" |
|
if {[dict exists $outconf -winsize]} { |
|
lassign [dict get $outconf -winsize] cols rows |
|
} else { |
|
#fallback - try external executable. Which is a bit ugly |
|
#tput can work on windows too if it's installed e.g from msys2 |
|
#but can be *slow* compared to unix e.g 400ms+ vs <2ms on FreeBSD ! |
|
|
|
set tputcmd [auto_execok tput] |
|
if {$tputcmd ne ""} { |
|
if {![catch {exec {*}$tputcmd cols lines} values]} { |
|
lassign $values cols rows |
|
} |
|
} |
|
} |
|
if {[string is integer -strict $cols] && [string is integer -strict $rows]} { |
|
#got_dimensions - todo - try spinner? |
|
#puts -nonewline stdout [punk::ansi::move $rows 4]$msg |
|
#use cursorsave_ version which avoids get_cursor_pos_list call |
|
set msglen [ansistring length $msg] |
|
punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg |
|
} else { |
|
#no mechanism to get console dimensions |
|
#we are reduced to continuously spewing lines. |
|
puts stderr $msg |
|
} |
|
|
|
after 100 |
|
} |
|
set input_chunks_waiting($inputchan) [list $allwaiting] |
|
} |
|
|
|
} else { |
|
punk::repl::repl_handler_checkchannel $inputchan |
|
punk::repl::repl_handler_checkcontrolsignal_linemode $inputchan |
|
# -- --- --- |
|
#set chunksize [gets $inputchan chunk] |
|
# -- --- --- |
|
set chunk [read $inputchan] |
|
set chunksize [string length $chunk] |
|
# -- --- --- |
|
if {$chunksize > 0} { |
|
#punk::console::cursorsave_move_emitblock_return 35 120 "chunk: [ansistring VIEW -lf 1 "...[string range $chunk end-10 end]"]" |
|
set ln $chunk ;#temp |
|
#punk::console::cursorsave_move_emitblock_return 25 30 [textblock::frame -title line "[a+ green]$waitingchunk[a][a+ red][ansistring VIEW -lf 1 $ln][a+ green]pending:[chan pending input stdin][a]"] |
|
if {[string index $ln end] eq "\n"} { |
|
lappend stdinlines [string range $ln 0 end-1] |
|
punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf |
|
uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] |
|
} else { |
|
lappend input_chunks_waiting($inputchan) $ln |
|
} |
|
} |
|
} |
|
|
|
} else { |
|
#rawmode |
|
if {[info exists input_chunks_waiting($inputchan)] && [llength $input_chunks_waiting($inputchan)]} { |
|
#we could concat and process as if one chunk - but for now at least - we want to preserve the 'chunkiness' |
|
set chunkwaiting_zero [lpop input_chunks_waiting($inputchan) 0] ;#pop off lhs of wait list (tcl 8.6 is tcl imp of lpop - a little slower) |
|
uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $chunkwaiting_zero [list] $prompt_config] |
|
} else { |
|
|
|
punk::repl::repl_handler_checkchannel $inputchan |
|
set signalinfo [punk::repl::repl_handler_checkcontrolsignal_rawmode $inputchan] |
|
if {[dict get $signalinfo count] > $last_controlc_count} { |
|
set continue 0 |
|
set last_controlc_count [dict get $signalinfo count] |
|
} else { |
|
set continue 1 |
|
} |
|
|
|
if {$continue} { |
|
if {[dict get $original_input_conf -blocking] ne "0" || [dict get $original_input_conf -translation] ne "lf"} { |
|
chan configure $inputchan -blocking 0 |
|
chan configure $inputchan -translation lf |
|
} |
|
set chunk [read $inputchan] |
|
|
|
punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf |
|
uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] |
|
while {[llength $input_chunks_waiting($inputchan)]} { |
|
set chunkzero [lpop input_chunks_waiting($inputchan) 0] |
|
if {$chunkzero eq ""} {continue} ;#why empty waiting - and is there any point passing on? |
|
uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $chunkzero [list] $prompt_config] |
|
} |
|
} |
|
} |
|
} |
|
|
|
if {![chan eof $inputchan]} { |
|
################################################################################## |
|
#Re-enable channel read handler only if no waiting chunks - must process in order |
|
################################################################################## |
|
if {![llength $input_chunks_waiting($inputchan)]} { |
|
fileevent $inputchan readable [list ::repl::repl_handler $inputchan $prompt_config] |
|
} else { |
|
after idle [list ::repl::repl_handler $inputchan $prompt_config] |
|
} |
|
#################################################### |
|
} else { |
|
#repl_handler_checkchannel $inputchan |
|
fileevent $inputchan readable {} |
|
set reading 0 |
|
thread::send -async $::repl::codethread {set ::punk::repl::codethread::running 0} |
|
if {$::tcl_interactive} { |
|
rputs stderr "\nrepl_handler EOF inputchannel:[chan conf $inputchan]" |
|
#rputs stderr "\n|repl> ctrl-c EOF on $inputchan." |
|
} |
|
set [namespace current]::done 1 |
|
after 1 [list repl::reopen_stdin] |
|
} |
|
set in_repl_handler [list] |
|
} |
|
|
|
proc punk::repl::editbuf {index args} { |
|
set editbuf [lindex $::repl::editbuf_list $index] |
|
if {$editbuf ne ""} { |
|
$editbuf {*}$args |
|
} else { |
|
return "No such index in editbuf list" |
|
} |
|
} |
|
interp alias {} editbuf {} ::punk::repl::editbuf |
|
|
|
|
|
proc punk::repl::console_debugview {editbuf consolewidth args} { |
|
package require textblock |
|
variable debug_repl |
|
if {$debug_repl <= 0} { |
|
return [dict create width 0 height 0 topleft {}] |
|
} |
|
set defaults {-row 10 -rightmargin 2 -chunktype raw-read} |
|
#dict for {k v} $args { |
|
# switch -- $k { |
|
# -row - -chunktype {} |
|
# default { |
|
# error "console_debugview unrecognised option '$k'. Known-options [dict keys $defaults]" |
|
# } |
|
# } |
|
#} |
|
set opts [dict merge $defaults $args] |
|
set opt_row [dict get $opts -row] |
|
set opt_chunktype [dict get $opts -chunktype] |
|
set opt_rightmargin [dict get $opts -rightmargin] |
|
|
|
#debugview_raw frame |
|
set RST [a] |
|
if {[catch { |
|
set info [$editbuf debugview_raw] |
|
if {$opt_chunktype eq "raw-waiting"} { |
|
set info [a+ bold yellow]$info$RST |
|
} else { |
|
set info [a+ green]$info$RST |
|
} |
|
#set lines [lines_as_list -ansireplays 1 $info] |
|
set lines [lines_as_list -ansireplays 0 $info] |
|
if {[llength $lines] > 20} { |
|
set lines [lrange $lines end-19 end] |
|
set info [::join $lines \n] |
|
} |
|
set debug_height [expr {[llength $lines]+2}] ;#framed height |
|
} errM]} { |
|
set info [textblock::frame -buildcache 0 -title "[a red]error$RST" $errM] |
|
set debug_height [textblock::height $info] |
|
} else { |
|
#treat as ephemeral (unreusable) frames due to varying width & height - therefore set -buildcache 0 |
|
set info [textblock::frame -buildcache 0 -ansiborder [a+ bold green] -title "[a cyan]debugview_raw$RST" $info] |
|
} |
|
|
|
set debug_width [textblock::widthtopline $info] |
|
set patch_height [expr {2 + $debug_height + 2}] |
|
set spacepatch [textblock::block $debug_width $patch_height " "] |
|
puts -nonewline [punk::ansi::cursor_off] |
|
#use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. |
|
set debug_offset [[expr {$consolewidth - $debug_width - $opt_rightmargin}]] |
|
set row_clear [expr {$opt_row -2}] |
|
punk::console::move_emitblock_return $row_clear $debug_offset $spacepatch |
|
punk::console::move_emitblock_return $opt_row $debug_offset $info |
|
set topleft [list $debug_offset $opt_row] ;#col,row REVIEW |
|
puts -nonewline [punk::ansi::cursor_on] |
|
flush stdout |
|
|
|
return [dict create width $debug_width height $debug_height topleft $topleft] |
|
} |
|
proc punk::repl::console_editbufview {editbuf consolewidth args} { |
|
package require textblock |
|
upvar ::repl::editbuf_list editbuf_list |
|
|
|
set defaults {-row 10 -rightmargin 0} |
|
set opts [dict merge $defaults $args] |
|
set opt_row [dict get $opts -row] |
|
set opt_rightmargin [dict get $opts -rightmargin] |
|
|
|
if {[catch { |
|
set info [$editbuf view_lines_numbered] |
|
set lines [lines_as_list -ansireplays 1 $info] |
|
if {[llength $lines] > 20} { |
|
set lines [lrange $lines end-19 end] |
|
set info [punk::lib::list_as_lines $lines] |
|
} |
|
} editbuf_error]} { |
|
set info [textblock::frame -buildcache 0 -title "[a red]error[a]" "$editbuf_error\n$::errorInfo"] |
|
} else { |
|
set title "[a cyan]editbuf [expr {[llength $editbuf_list]-1}] lines [$editbuf linecount][a]" |
|
append title "[a+ yellow bold] col:[format %3s [$editbuf cursor_column]] row:[$editbuf cursor_row][a]" |
|
set row1 " lastchar:[ansistring VIEW -lf 1 [$editbuf last_char]] lastgrapheme:[ansistring VIEW -lf 1 [$editbuf last_grapheme]]" |
|
set row2 " lastansi:[ansistring VIEW -lf 1 [$editbuf last_ansi]]" |
|
set info [a+ green bold]$row1\n$row2[a]\n$info |
|
set info [textblock::frame -buildcache 0 -ansiborder [a+ green bold] -title $title $info] |
|
} |
|
set editbuf_width [textblock::widthtopline $info] |
|
set spacepatch [textblock::block $editbuf_width 2 " "] |
|
|
|
#set editbuf_offset [expr {$consolewidth - $editbuf_width - $debug_width - 2}] |
|
set editbuf_offset [expr {$consolewidth - $editbuf_width - $opt_rightmargin}] |
|
|
|
set row_clear [expr {$opt_row -2}] |
|
punk::console::cursorsave_move_emitblock_return $row_clear $editbuf_offset $spacepatch |
|
punk::console::cursorsave_move_emitblock_return $opt_row $editbuf_offset $info |
|
|
|
return [dict create width $editbuf_width] |
|
} |
|
proc punk::repl::console_controlnotification {message consolewidth consoleheight args} { |
|
package require textblock |
|
set defaults {-bottommargin 0 -rightmargin 0} |
|
set opts [dict merge $defaults $args] |
|
set opt_bottommargin [dict get $opts -bottommargin] |
|
set opt_rightmargin [dict get $opts -rightmargin] |
|
set messagelines [split $message \n] |
|
set message [lindex $messagelines 0] ;#only allow single line |
|
set info "[a+ bold red]$message[a]" |
|
set hlt [dict get [textblock::framedef light] hlt] |
|
set box [textblock::frame -boxmap [list tlc $hlt trc $hlt] -title $message -height 1] |
|
set notification_width [textblock::widthtopline $info] |
|
set box_offset [expr {$consolewidth - $notification_width - $opt_rightmargin}] |
|
set row [expr {$consoleheight - $opt_bottommargin}] |
|
punk::console::cursorsave_move_emitblock_return $row $box_offset $info |
|
return [dict create width $notification_width] |
|
} |
|
|
|
proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config} { |
|
variable loopinstance |
|
incr loopinstance |
|
upvar ::punk::console::input_chunks_waiting input_chunks_waiting |
|
|
|
upvar ::punk::repl::prompt_reset_flag prompt_reset_flag |
|
|
|
variable last_repl_char "" ;#last char emitted by this handler to stdout/stderr |
|
variable lastoutchar "" |
|
variable lasterrchar "" |
|
variable commandstr |
|
# --- |
|
variable editbuf |
|
variable editbuf_list |
|
variable editbuf_linenum_submitted |
|
|
|
# --- |
|
variable reading |
|
variable id_outstack |
|
upvar ::punk::config::running running_config |
|
|
|
try { |
|
#catch {puts stderr "xx--->[rep $::arglej]"} |
|
if {$prompt_reset_flag == 1} { |
|
set prompt_config [punk::repl::get_prompt_config] |
|
set prompt_reset_flag 0 |
|
} |
|
|
|
set resultprompt [dict get $prompt_config resultprompt] |
|
set nlprompt [dict get $prompt_config nlprompt] |
|
set infoprompt [dict get $prompt_config infoprompt] |
|
set debugprompt [dict get $prompt_config debugprompt] |
|
|
|
|
|
set rawmode [set ::punk::console::is_raw] |
|
if {!$rawmode} { |
|
#puts stderr "-->got [ansistring VIEW -lf 1 $stdinlines]<--" |
|
|
|
} else { |
|
#raw |
|
set chunklen [string length $chunk] |
|
set onetime 1 |
|
#single loop while to allow break on escape |
|
while {$onetime && [string length $chunk] >= 0 } { |
|
set onetime 0 |
|
#punk::console::move_emitblock_return 20 120 $chunklen-->[chan conf stdin]<-- |
|
|
|
#if {$chunklen == 0} { |
|
# #document examples of when we expect zero-byte chunk |
|
# #1) ctrl-z |
|
# #review |
|
# rputs stderr "->0byte read stdin" |
|
# if {[chan eof $inputchan]} { |
|
# fileevent $inputchan readable {} |
|
# set reading 0 |
|
# #set running 0 |
|
# if {$::tcl_interactive} { |
|
# rputs stderr "\n|repl> EOF on $inputchan." |
|
# } |
|
# set [namespace current]::done 1 |
|
# #test |
|
# #JMN |
|
# #tailcall repl::reopen_stdin |
|
# } |
|
# break |
|
#} |
|
|
|
#set info1 "read $chunklen bytes->[ansistring VIEW -lf 1 -vt 1 $chunk]" |
|
#consider also the terminal linefeed mode. |
|
#https://vt100.net/docs/vt510-rm/LNM.html |
|
# terminals (by default) generally use a lone cr to represent enter (LNM reset ie CSI 20l) |
|
#(as per above doc: "For compatibility with Digital's software you should keep LNM reset (line feed)") |
|
|
|
#You can insert an lf using ctrl-j - and of course stdin could have crlf or lf |
|
#pasting from notepad++ with mixed line endings seems to paste everything ok |
|
#we don't really know the source of input keyboard vs paste vs pipe - and whether a read has potentially chopped a crl in half.. |
|
#possibly no real way to determine that. We could wait a small time to see if there's more data coming.. and potentially impact performance. |
|
#Instead we'll try to make sense of it here. |
|
|
|
if {$chunklen == 1} { |
|
#presume it's a keypress from terminal |
|
set chunk [string map {\r \n} $chunk] |
|
} else { |
|
#maybe a paste? (or stdin to active shell loop - possibly with no terminal ? ) |
|
#we'd better check for crlf and/or plain lf. If found - presume any lone CR is to be left as is. |
|
if {[string first \n $chunk] < 0} { |
|
set chunk [string map {\r \n} $chunk] |
|
} |
|
#else - |
|
#has lf - but what if last char is cr? |
|
#It may require user to hit enter - probably ok. |
|
#could be a sequence of cr's from holding enter key |
|
} |
|
|
|
#review - we can receive chars such as escapes or arrow inline with other data even from keyboard if keys are pushed quickly (or automated?) |
|
# - so we probably shouldn't really rely on whether a char arrives alone in a chunk as a factor in its behaviour |
|
#On the other hand - timing of keystrokes could be legitimate indications of intention in a cli ? |
|
|
|
#esc or ctrl-lb |
|
if {$chunk eq "\x1b"} { |
|
#return |
|
set stdinlines [list "\x1b"] |
|
set commandstr "" |
|
set chunk "" |
|
$editbuf clear_tail |
|
screen_last_char_add \x1b stdin escape |
|
break |
|
} |
|
|
|
#if ProcessedInput is disabled - we can get ctrl-c, but then we wouldn't be in raw mode and wouldn't be here. |
|
#e.g with punk::console::disableProcessedInput |
|
#if we get just ctrl-c in one chunk |
|
#ctrl-c |
|
if {$chunk eq "\x03"} { |
|
#::punk::repl::handler_console_control "ctrl-c_via_rawloop" |
|
error "character 03 -> ctrl-c" |
|
} |
|
|
|
|
|
#review - configurable? |
|
#translate raw del to backspace del for those terminals that send plain del |
|
if {$chunk eq "\x7f"} { |
|
set chunk "\b\x7f" |
|
} |
|
#ctrl-bslash |
|
if {$chunk eq "\x1c"} { |
|
#try to brutally terminate process |
|
#attempt to leave terminal in a reasonable state |
|
punk::mode line |
|
after 250 {exit 42} |
|
return |
|
} |
|
#for now - exit with small delay for tidyup |
|
#ctrl-z |
|
if {$chunk eq "\x1a"} { |
|
#::punk::repl::handler_console_control "ctrl-z_via_rawloop" |
|
punk::mode line |
|
after 1000 {exit 43} |
|
return |
|
} |
|
|
|
#we *could* intercept arrow keys here before they are handled in the editbuf |
|
#but there should only be the need to do so for situations where we aren't editing a commandline |
|
#if {$chunk eq "\x1b\[D"} { |
|
# #rputs stderr "${debugprompt}arrow-left D" |
|
# #set commandstr "" |
|
# #punk::console::move_back 1 ;#terminal does it anyway? |
|
#} |
|
#if {$chunk eq "\x1b\[C"} { |
|
#} |
|
|
|
$editbuf add_chunk $chunk |
|
|
|
#-------------------------- |
|
# editbuf and debugview rhs frames |
|
if {[set ::punk::console::ansi_available]} { |
|
#experimental - use punk::console::get_size to determine current visible width. |
|
#This should ideally be using sigwinch or some equivalent to set a value somewhere. |
|
#testing each time is very inefficient (1+ms) |
|
#unfortunately there isn't an easy way to get such an event on windows console based systems - REVIEW. |
|
set do_checkwidth 1 ;#make configurable if performance hit is too severe? TODO |
|
set consolewidth 132 |
|
if {$do_checkwidth} { |
|
if {[catch {set consolewidth [dict get [punk::console::get_size] columns]} errM]} { |
|
puts stderr "repl_process_data failed on call to punk::console::get_size :$errM" |
|
} |
|
} |
|
set debug_width 0 |
|
set rightmargin 0 |
|
set space_occupied [punk::repl::console_debugview $editbuf $consolewidth -row 10 -chunktype $chunktype -rightmargin $rightmargin] ;#contains cursor movements |
|
set debug_width [dict get $space_occupied width] |
|
set clearance [expr {$debug_width + $rightmargin}] |
|
set space_occupied [punk::repl::console_editbufview $editbuf $consolewidth -row 10 -rightmargin $clearance] |
|
} |
|
#-------------------------- |
|
|
|
|
|
set lines_unsubmitted [expr {[$editbuf linecount] - $editbuf_linenum_submitted}] |
|
#there is always one 'line' unsubmitted - although it may be the current one being built, which may be empty string |
|
if {$lines_unsubmitted < 1} { |
|
puts stderr "repl editbuf_linenum_submitted out of sync with editbuf" |
|
} |
|
|
|
#set trailing_line_index [expr {[$editbuf linecount] -1}] |
|
set last_line_num [$editbuf linecount] |
|
#set nextsubmit_index [expr {$editbuf_lineindex_submitted + 1}] |
|
set nextsubmit_line_num [expr {$editbuf_linenum_submitted + 1}] |
|
|
|
set cursor_row [$editbuf cursor_row] |
|
set cursor_index [expr {$cursor_row -1}] |
|
set lastansi [$editbuf last_ansi] |
|
if {$lastansi eq "\x1b\[A"} { |
|
if {$cursor_row > 1} { |
|
puts -nonewline stdout "\x1b\[A" |
|
} |
|
} elseif {$lastansi eq "\x1b\[B"} { |
|
puts -nonewline stdout "\x1b\[B" |
|
} |
|
flush stdout |
|
|
|
|
|
|
|
set leftmargin 3 |
|
puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$leftmargin +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$leftmargin + [$editbuf cursor_column]}]] |
|
#puts -nonewline stdout $chunk |
|
flush stdout |
|
if {[$editbuf last_char] eq "\n"} { |
|
set linelen [punk::ansi::printing_length [$editbuf line $nextsubmit_line_num]] |
|
puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$leftmargin + $linelen +1}]] |
|
#screen_last_char_add "\n" input inputline |
|
puts -nonewline stdout [punk::ansi::erase_eol]\n |
|
#puts -nonewline stdout \n |
|
screen_last_char_add "\n" input inputline |
|
set waiting [$editbuf line end] |
|
if {[string length $waiting] > 0} { |
|
set waiting [a+ yellow bold]$waiting[a] |
|
#puts stderr "waiting $waiting" |
|
$editbuf clear_tail |
|
lappend input_chunks_waiting($inputchan) $waiting |
|
} |
|
} |
|
if {$editbuf_linenum_submitted == 0} { |
|
#(there is no line 0 - lines start at 1) |
|
if {[$editbuf last_char] eq "\n"} { |
|
lappend stdinlines [$editbuf line 1] |
|
set editbuf_linenum_submitted 1 |
|
} |
|
} else { |
|
if {$nextsubmit_line_num < $last_line_num} { |
|
foreach ln [$editbuf lines $nextsubmit_line_num end-1] { |
|
lappend stdinlines $ln |
|
incr editbuf_linenum_submitted |
|
} |
|
} |
|
} |
|
set last_cursor_column [$editbuf cursor_column] |
|
} |
|
} |
|
|
|
} trap {POSIX} {e eopts} { |
|
rputs stderr "trap1 POSIX '$e' eopts:'$eopts" |
|
flush stderr |
|
} on error {repl_error erropts} { |
|
rputs stderr "error1 in repl_handler: $repl_error" |
|
rputs stderr "-------------" |
|
rputs stderr "$::errorInfo" |
|
rputs stderr "-------------" |
|
set stdinreader [fileevent $inputchan readable] |
|
if {![string length $stdinreader]} { |
|
rputs stderr "*> $inputchan reader inactive" |
|
} else { |
|
rputs stderr "*> $inputchan reader active" |
|
} |
|
if {[chan eof $inputchan]} { |
|
rputs stderr "todo - attempt restart of repl on input channel: $inputchan in next loop" |
|
catch {set ::punk::ns::ns_current "::"} |
|
#todo set flag to restart repl ? |
|
} else { |
|
rputs stderr "continuing.." |
|
} |
|
flush stderr |
|
} |
|
|
|
|
|
try { |
|
set maxlinenum [expr {[llength $stdinlines] -1}] |
|
set linenum 0 |
|
foreach line $stdinlines { |
|
#puts stderr "----->line: [ansistring VIEW -lf 1 $line] commandstr:[ansistring VIEW -lf 1 $commandstr]" |
|
set last_repl_char "" ;#last char emitted by this handler to stdout/stderr |
|
set lastoutchar "" |
|
set lasterrchar "" |
|
|
|
|
|
#consider \x1b as text on console vs \x1b the character |
|
#review - if we're getting these actual escape characters in line mode.. something is off - let's emit something instead of trying to interpret as a command and failing. |
|
#This tends to happen when some sort of readline not avaialbe ie on unix or mintty in windows |
|
#this only captures leading escape.. as an aid to diagnosis e.g <sp><right-arrow> won't be caught and the user will need to close the right bracket to complete the bogus command |
|
#we may need to think about legitimate raw escapes in commands e.g from pipes or script files, vs via console? |
|
|
|
#esc key or ctrl-lb followed by enter |
|
if {$line eq "\x1b"} { |
|
#abort current command |
|
if {$linenum == 0} { |
|
doprompt "E% " {yellow bold} |
|
set line "" |
|
#screen_last_char_add " " empty empty |
|
} else { |
|
doprompt "\nE% " {yellow bold} |
|
#screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required |
|
} |
|
incr linenum |
|
continue |
|
} else { |
|
if {$line eq "\x1b\[C"} { |
|
rputs stderr "${debugprompt}arrow-right C" |
|
#set commandstr "" |
|
} |
|
if {$line eq "\x1b\[D"} { |
|
#rputs stderr "${debugprompt}arrow-left D" |
|
#set commandstr "" |
|
#punk::console::move_back 1 |
|
} |
|
if {$line eq "\x1b\[A"} { |
|
rputs stderr "${debugprompt}arrow-up A" |
|
} |
|
if {$line eq "\x1b\[B"} { |
|
rputs stderr "arrow-down B" |
|
} |
|
if {[string match "\x1b*" $line]} { |
|
rputs stderr "${debugprompt}esc - '[punk::ansi::ansistring::VIEW $line]'" |
|
#set commandstr [punk::ansi::ansistrip $commandstr] |
|
} |
|
} |
|
|
|
if {$commandstr ne ""} { |
|
append commandstr \n |
|
} |
|
|
|
set stdinconf [fconfigure $inputchan] |
|
if {$::tcl_platform(platform) eq "windows" && [dict get $stdinconf -encoding] ni [list unicode utf-16 utf-8]} { |
|
#some long console inputs are split weirdly when -encoding and -translation are left at defaults - requiring extra enter-key to get repl to process. |
|
#experiment to see if using iso8859-1 (raw bytes) and handling line endings manually gives insight. |
|
# - do: chan conf stdin -encoding iso859-1 -translation lf |
|
|
|
#first command after configuring stdin this way seems to be interpreted with wrong encoding - subsequent commands work - review |
|
|
|
#this branch only works on tcl8.7+ |
|
#It seems to fix the issue with holding down enter-key and getting extra blank lines, but |
|
# it breaks copy-paste (encoding issue?) |
|
|
|
|
|
#puts "--inputchan:$inputchan> [fconfigure $inputchan]" |
|
|
|
append commandstr $line |
|
puts "1=============>[string length $commandstr] bytes , [ansistring VIEW $commandstr] , info complete:[info complete $line] stdinconf:$stdinconf" |
|
set commandstr [string range $commandstr 0 end-3] |
|
set commandstr [encoding convertfrom utf-16be $commandstr] ;#This is weird - but it seems to be big endian? |
|
set commandstr [string trimright $commandstr] |
|
#puts "2=============>[string length $commandstr] bytes , [string map [list \r -r- \n -n-] $commandstr] , info complete:[info complete $line]" |
|
} else { |
|
#append commandstr $line |
|
#puts "0=============>[string length $commandstr] bytes , [string map [list \r -r- \n -n-] $commandstr] , info complete:[info complete $line]" |
|
append commandstr $line |
|
} |
|
|
|
#puts "=============>[string length $commandstr] bytes , [string map [list \r -r- \n -n-] $commandstr] , info complete:[info complete $line]" |
|
set last_repl_char "\n" ;#this is actually the eol from stdin |
|
screen_last_char_add "\n" stdin $line |
|
|
|
|
|
|
|
#append commandstr \n |
|
|
|
|
|
if {[info complete $commandstr] && [string index $commandstr end] ne "\\"} { |
|
#set commandstr [overtype::renderline -expand_right 1 "" $commandstr] |
|
|
|
|
|
set ::repl::output_stdout "" |
|
set ::repl::output_stderr "" |
|
set outstack [list] |
|
set errstack [list] |
|
|
|
|
|
#oneshot repl debug |
|
set wordparts [regexp -inline -all {\S+} $commandstr] |
|
lassign $wordparts cmd_firstword cmd_secondword |
|
if {$cmd_firstword eq "debugrepl"} { |
|
if {$cmd_secondword in [list 0 cancel]} { |
|
set ::punk::repl::debug_repl 0 |
|
} else { |
|
if {[string is integer -strict $cmd_secondword]} { |
|
incr ::punk::repl::debug_repl $cmd_secondword |
|
} else { |
|
incr ::punk::repl::debug_repl |
|
} |
|
} |
|
#set commandstr "set ::punk::repl::debug_repl" |
|
set commandstr "" |
|
} |
|
if {$::punk::repl::debug_repl > 100} { |
|
proc debug_repl_emit {msg} [string map [list %p% [list $debugprompt]] { |
|
set p %p% |
|
#don't auto-append \n even if missing. |
|
#we may want to use debug_repl_emit with multiple calls for one output line |
|
#if {[string index $msg end] ne "\n"} { |
|
# set msg "$msg\n" |
|
#} |
|
#set last_char [string index $::repl::screen_last_chars end] |
|
set last_char [screen_last_char_get] |
|
if {$last_char ne "\n"} { |
|
set clearance "\n" |
|
} else { |
|
set clearance "" |
|
} |
|
#use pseudo-channel debugreport |
|
rputs debugreport $clearance$p[string map [list \n \n$p] $msg] |
|
}] |
|
set info "" |
|
append info "repl loopinstance: $loopinstance debugrepl remaining: [expr {[set ::punk::repl::debug_repl]-1}]\n" |
|
append info "commandstr: [punk::ansi::ansistring::VIEW $commandstr]\n" |
|
set lastrunchunks [tsv::get repl runchunks-[tsv::get repl runid]] |
|
append info "lastrunchunks\n" |
|
append info "chunks: [llength $lastrunchunks]\n" |
|
append info "namespace: $::punk::ns::ns_current" |
|
debug_repl_emit $info |
|
} else { |
|
proc debug_repl_emit {msg} {return} |
|
} |
|
|
|
#----------------------------------------- |
|
#review! |
|
#work around weird behaviour in tcl 8.6 & 8.7a5 (at least) part1 |
|
#https://wiki.tcl-lang.org/page/representation |
|
#/scriptlib/tests/listrep_bug.tcl |
|
#after the uplevel #0 $commandstr call |
|
# vars within the script that were set to a list, and have no string-rep, will generate a string-rep once the script (commandstr) is unset, or set to another value |
|
global run_command_string |
|
set run_command_string "$commandstr\n" ;#add anything that won't affect script. |
|
global run_command_cache |
|
#----------------------------------------- |
|
|
|
set repl_runid [tsv::incr repl runid] |
|
tsv::set repl runchunks-$repl_runid [list] ;#last_run_display |
|
catch { |
|
tsv::unset repl runchunks-[expr {$repl_runid - 10}] |
|
} |
|
|
|
#set ::repl::last_unknown "" |
|
tsv::set repl last_unknown "" |
|
#*********************************************************** |
|
#don't use puts,rputs or debug_repl_emit in this block |
|
#*********************************************************** |
|
|
|
#if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { |
|
# lappend outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] |
|
#} |
|
#lappend outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output_stdout}] |
|
#if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { |
|
# lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] |
|
#} |
|
|
|
variable codethread |
|
variable codethread_cond |
|
variable codethread_mutex |
|
|
|
lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::repl::output_stderr}] |
|
#thread::transfer $codethread stderr |
|
|
|
#chan configure stdout -buffering none |
|
#JMN |
|
fileevent $inputchan readable {} |
|
set reading 0 |
|
#don't let unknown use 'args' to convert commandstr to list |
|
#=============================================================================== |
|
#Actual command call |
|
#puts "____>[rep $commandstr]" |
|
#=============================================================================== |
|
if {[string equal -length [string length "repl_runraw "] "repl_runraw " $commandstr]} { |
|
#pass unevaluated command to runraw |
|
set status [catch {uplevel #0 [list runraw $commandstr]} raw_result] |
|
} else { |
|
#puts stderr "repl uplevel 0 '$run_command_string'" |
|
#JMN |
|
#puts stderr "sending to codethread::runscript $run_command_string" |
|
tsv::set codethread_$codethread status -1 |
|
thread::send -async $codethread [list punk::repl::codethread::runscript $run_command_string] |
|
thread::mutex lock $codethread_mutex |
|
while {[set status [tsv::get codethread_$codethread status]] == -1} { |
|
thread::cond wait $codethread_cond $codethread_mutex 50 |
|
update ;#we need a full update here to allow interrupts to be processed |
|
#While update is often considered risky - here we know our input channel readable event has been disabled - so re-entrancy shouldn't be possible. |
|
#however - child thread can send quit - transferring processing from here back to repl::start - which then ends - making a mess (child not yet finished when trying to tidy up) |
|
#we should give the child a way to quit by setting a tsv we pick up here *after the while loop* - and then we can set done. |
|
} |
|
thread::mutex unlock $codethread_mutex |
|
set raw_result [tsv::get codethread_$codethread result] |
|
lassign [tsv::get codethread_$codethread info] _o lastoutchar_codethread _e lasterrchar_codethread |
|
|
|
#set status [catch { |
|
# thread::send $ |
|
# uplevel 1 {namespace inscope $::punk::ns::ns_current $run_command_string} |
|
#} raw_result] |
|
|
|
} |
|
#puts stderr "repl raw_result: $raw_result" |
|
#set result $raw_result |
|
#append result ""; #copy on write |
|
#copy on write |
|
|
|
#append result $raw_result "" |
|
set result [string cat $raw_result ""] |
|
#puts stderr "-->>$result<--" |
|
#=============================================================================== |
|
|
|
flush stdout |
|
flush stderr |
|
#foreach s [lreverse $outstack] { |
|
# shellfilter::stack::remove stdout $s |
|
#} |
|
#foreach s [lreverse $errstack] { |
|
# shellfilter::stack::remove stderr $s |
|
#} |
|
|
|
#----------------------------------------- |
|
#list/string-rep bug workaround part 2 |
|
#todo - set flag based on punk::lib::system::has_script_var_bug |
|
lappend run_command_cache $run_command_string |
|
#puts stderr "run_command_string rep: [rep $run_command_string]" |
|
if {[llength $run_command_cache] > 2000} { |
|
set run_command_cache [lrange $run_command_cache 1750 end] |
|
} |
|
#----------------------------------------- |
|
|
|
#screen_last_char_add [string index $lastoutchar_codethread$lasterrchar_codethread end] "stdout/stderr" |
|
|
|
|
|
#set lastoutchar [string index [punk::ansi::ansistrip $::repl::output_stdout] end] |
|
#set lasterrchar [string index [punk::ansi::ansistrip $::repl::output_stderr] end] |
|
|
|
#to determine whether cursor is back at col0 of newline |
|
#screen_last_char_add [string index $lastoutchar$lasterrchar end] "stdout/stderr" |
|
|
|
|
|
#??? |
|
#screen_last_char_add [string index $lastoutchar$lastoutchar_codethread$lasterrchar$lasterrchar_codethread end] "stdout/stderr" |
|
screen_last_char_add [string index $lastoutchar_codethread$lasterrchar_codethread end] "stdout/stderr" |
|
|
|
|
|
set result_is_chunk_list 0 |
|
#------ |
|
#todo - fix. It doesn't make much sense to only detect if the unknown command occurred in first word. |
|
#e.g set x [something arg] not detected vs something arg |
|
#also - unknown commands aren't the only things that can write directly to the os handles stderr & stdout |
|
set last_unknown [tsv::get repl last_unknown] |
|
if { |
|
[string length $last_unknown] && \ |
|
[string equal -length [string length $last_unknown] $last_unknown $line] |
|
} { |
|
#can't currently detect stdout/stderr writes from unknown's call to exec |
|
#add a clearance newline for direct unknown calls for now |
|
#there is usually output anyway - but we will get an extra blank line now even for a call that only had an exit code |
|
# |
|
# |
|
set unknown_clearance "\n* repl newline" |
|
screen_last_char_add "\uFFFF" clearance "clearance after direct unknown call" |
|
if {[tsv::llength repl runchunks-$repl_runid]} { |
|
if {$status == 0} { |
|
set result [tsv::get repl runchunks-$repl_runid] ;#last_run_display |
|
} else { |
|
|
|
} |
|
set result_is_chunk_list 1 |
|
} |
|
} |
|
#------ |
|
#ok to use repl::screen_needs_clearance from here down.. (code smell - proc only valid use in narrow context) |
|
#*********************************************************** |
|
#rputs -nonewline stderr $unknown_clearance |
|
if {$::punk::repl::debug_repl > 0} { |
|
set lastcharinfo "\n" |
|
set whatcol [string repeat " " 12] |
|
foreach cinfo $::repl::screen_last_char_list { |
|
lassign $cinfo c whatinfo whyinfo |
|
set cdisplay [punk::ansi::ansistring::VIEW -lf 1 -vt 1 $c] |
|
#assertion cdisplay has no raw newlines |
|
if {[punk::char::ansifreestring_width $cdisplay] == 1} { |
|
set cdisplay "$cdisplay " ;#make 2 wide |
|
} |
|
if {[string match repl-debugreport* $whatinfo]} { |
|
#exclude noise debug_repl_emit - but still show the last_char |
|
set whysummary "" |
|
} else { |
|
#set whysummary [string map [list \n "-n-"] $whyinfo] |
|
set whysummary [punk::ansi::ansistring::VIEW -lf 1 -vt 1 $whyinfo] |
|
} |
|
set whatinfo [string range $whatinfo$whatcol 0 [string length $whatcol]] |
|
append lastcharinfo "$cdisplay $whatinfo $whysummary\n" |
|
} |
|
debug_repl_emit "screen_last_chars: $lastcharinfo" |
|
} |
|
|
|
debug_repl_emit "lastoutchar:'$lastoutchar' lasterrchar: '$lasterrchar'" |
|
if {$status == 0} { |
|
debug_repl_emit "command call status: $status OK" |
|
} else { |
|
debug_repl_emit "command call status: $status ERR" |
|
} |
|
|
|
|
|
|
|
|
|
#puts stderr "<output>'$::repl::output_stdout' lastoutchar:'$lastoutchar' result:'$result'" |
|
#$command is an unevaluated script at this point |
|
# so may not be a well formed list e.g 'set x [list a "b"]' |
|
#- lindex $command would sometimes fail |
|
#if {[lindex $command 0] eq "runx"} {} |
|
|
|
|
|
if { |
|
[string equal -length [string length "d/ "] "d/ " $commandstr] || \ |
|
[string equal "d/\n" $commandstr] || \ |
|
[string equal -length [string length "dd/ "] "dd/ " $commandstr] || \ |
|
[string equal "dd/\n" $commandstr] || \ |
|
[string equal -length [string length "./ "] "./ " $commandstr] || \ |
|
[string equal "./\n" $commandstr] || \ |
|
[string equal -length [string length "../ "] "../ " $commandstr] || \ |
|
[string equal "../\n" $commandstr] || \ |
|
[string equal -length [string length "runx "] "runx " $commandstr] || \ |
|
[string equal -length [string length "sh_runx "] "sh_runx " $commandstr] || \ |
|
[string equal -length [string length "runout "] "runout " $commandstr] || \ |
|
[string equal -length [string length "sh_runout "] "sh_runout " $commandstr] || \ |
|
[string equal -length [string length "runerr "] "runerr " $commandstr] || \ |
|
[string equal -length [string length "sh_runerr "] "sh_runerr " $commandstr] |
|
|
|
} { |
|
if {[tsv::llength repl runchunks-$repl_runid]} { |
|
set result [tsv::get repl runchunks-$repl_runid] ;#last_run_display |
|
set result_is_chunk_list 1 |
|
} |
|
} |
|
|
|
# -- --- --- --- --- --- --- --- --- --- |
|
##an attempt to preserve underlying rep |
|
##this is not for performance - just to be less disruptive to underlying rep to aid in learning/debugging |
|
# -- --- --- --- --- --- --- --- --- --- |
|
# JN 2023 - The lrange operation is destructive to path internal representation |
|
# The lrange operation is destructive to strings with leading/trailing newlines |
|
# -- --- --- --- --- --- --- --- --- --- |
|
#set saved_errorCode $::errorCode |
|
#set saved_errorInfo $::errorInfo |
|
#if {[catch {lrange $result 0 end} result_as_list]} { |
|
# set is_result_empty [expr {$result eq ""}] |
|
# set ::errorCode $saved_errorCode |
|
# set ::errorInfo $saved_errorInfo |
|
#} else { |
|
# set is_result_empty [expr {[llength $result_as_list] == 0}] |
|
#} |
|
# -- --- --- --- --- --- --- --- --- --- |
|
#set resultrep [::tcl::unsupported::representation $result] |
|
|
|
set is_result_empty [expr {$result eq ""}] |
|
|
|
#catch {puts stderr "yy--->[rep $::arglej]"} |
|
|
|
set reading 1 |
|
if {!$is_result_empty} { |
|
if {$status == 0} { |
|
if {[screen_needs_clearance]} { |
|
rputs -nonewline stderr \n |
|
} |
|
if {$result_is_chunk_list} { |
|
foreach c $result { |
|
lassign $c termchan text |
|
if {[string length $text]} { |
|
switch -- $termchan { |
|
result { |
|
#rputs stdout $resultprompt[string map [list \n "\n$resultprompt"] $text] |
|
set h [textblock::height $text] |
|
set promptcol [string repeat $resultprompt\n $h] |
|
set promptcol [string range $promptcol 0 end-1] |
|
rputs [textblock::join_basic -- $promptcol $text] |
|
|
|
#puts -nonewline stdout $text |
|
} |
|
resulterr { |
|
rputs stderr $resultprompt[string map [list \n "\n$resultprompt"] $text] |
|
} |
|
info { |
|
rputs stderr $infoprompt[string map [list \n "\n$infoprompt"] $text] |
|
} |
|
default { |
|
#rputs -nonewline $termchan $text |
|
set chanprompt "_ " |
|
rputs $termchan ${chanprompt}[string map [list \n "\n${chanprompt}"] $text] |
|
} |
|
} |
|
} |
|
} |
|
|
|
} else { |
|
#----------------------------------------------------------- |
|
# avoid repl forcing string rep of simple results. This is just to aid analysis using tcl::unsupported::representation |
|
#set rparts [split $result {}] |
|
#if {[lsearch $rparts \n] < 0} { |
|
# #type of $result unaffected |
|
# rputs "$resultprompt $result" |
|
#} else { |
|
# #$result will be a string due to use of string map |
|
# rputs $resultprompt[string map [list \n "\n$resultprompt"] $result] |
|
#} |
|
#----------------------------------------------------------- |
|
|
|
#we have copied rawresult using append with empty string - so our string interaction with result var here shouldn't affect the returned value |
|
#empty-string result handled in other branch |
|
if {![tsv::llength repl runchunks-$repl_runid]} { |
|
#write back to tsv var for use by punk::get_runchunks (underscore command) |
|
tsv::set repl runchunks-$repl_runid [list [list result $result]] |
|
} |
|
set flat [string map [list \r\n "" \n ""] $result] |
|
if {[string length $flat] == [string length $result]} { |
|
#no line-endings in data |
|
rputs "$resultprompt$result" |
|
} else { |
|
#if {[string index $result end] eq "\n"} { |
|
# set result [string range $result 0 end-1] |
|
#} |
|
if {[string length $flat] == 0} { |
|
if {[string range $result end-1 end] eq "\r\n"} { |
|
set result [string range $result 0 end-2] |
|
} else { |
|
set result [string range $result 0 end-1] |
|
} |
|
} |
|
#NOTE - textblock::height is the line height - not reflective of height of data with ansi-moves or things like sixels |
|
set h [textblock::height $result] |
|
set promptcol [string repeat $resultprompt\n $h] |
|
set promptcol [string range $promptcol 0 end-1] |
|
#promptcol is uniform-width lines, result may not be. We are ok to join with ragged rhs col here, so use join_basic instead of join |
|
rputs [textblock::join_basic -- $promptcol $result] |
|
|
|
#orig |
|
#rputs $resultprompt[string map [list \r\n "\n$resultprompt" \n "\n$resultprompt"] $result] |
|
} |
|
} |
|
doprompt "P% " |
|
} else { |
|
#tcl err |
|
if {$result_is_chunk_list} { |
|
foreach c [tsv::get repl runchunks-$repl_runid] { |
|
#last_run_display |
|
lassign $c termchan text |
|
if {[string length $text]} { |
|
switch -- $termchan { |
|
result { |
|
rputs stdout $resultprompt[string map [list \n "\n$resultprompt"] $text] |
|
#puts -nonewline stdout $text |
|
} |
|
resulterr { |
|
rputs stderr $resultprompt[string map [list \n "\n$resultprompt"] $text] |
|
} |
|
info { |
|
rputs stderr $infoprompt[string map [list \n "\n$infoprompt"] $text] |
|
} |
|
default { |
|
rputs -nonewline $termchan $text |
|
} |
|
} |
|
} |
|
} |
|
} |
|
|
|
set c [a yellow bold] |
|
set n [a] |
|
rputs stderr $c$result$n |
|
#tcl err hint prompt - lowercase |
|
doprompt "p% " |
|
} |
|
} else { |
|
#doprompt "P% " "green normal" |
|
if {$linenum == 0} { |
|
doprompt "P% " "green normal" |
|
screen_last_char_add " " empty empty |
|
} else { |
|
doprompt "\nP% " "green normal" |
|
screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required |
|
} |
|
} |
|
#catch {puts stderr "zz1--->[rep $::arglej]"} |
|
#puts stderr "??? $commandstr" |
|
if {$::punk::repl::debug_repl > 0} { |
|
incr ::punk::repl::debug_repl -1 |
|
} |
|
set commandstr "" |
|
#catch {puts stderr "zz2---->[rep $::arglej]"} |
|
|
|
set lines [$editbuf lines] |
|
set buf_has_data 0 |
|
foreach ln $lines { |
|
if {[string trim $ln] ne ""} { |
|
set buf_has_data 1 |
|
} |
|
} |
|
if {$buf_has_data} { |
|
set editbufnext [punk::repl::class::class_editbuf new {}] |
|
lappend editbuf_list $editbufnext |
|
set editbuf_linenum_submitted 0 |
|
set editbuf $editbufnext |
|
} |
|
#editbuf |
|
|
|
} else { |
|
#append commandstr \n |
|
if {$::punk::repl::signal_control_c} { |
|
set ::punk::repl::signal_control_c 0 |
|
fileevent $inputchan readable {} |
|
rputs stderr "* console_control: control-c" |
|
flush stderr |
|
set c [a yellow bold] |
|
set n [a] |
|
rputs stderr "${c}repl interrupted$n" |
|
#set commandstr [list error "repl interrupted"] |
|
set commandstr "" |
|
doprompt ">_ " |
|
flush stdout |
|
|
|
} else { |
|
#Incomplete command |
|
# parse and determine outermost unclosed quote/bracket and include in prompt |
|
if {$linenum == $maxlinenum} { |
|
if {$rawmode} { |
|
#review |
|
#we haven't put the data following last le into commandstr - but we want to display proper completion status prior to enter being hit or more data coming in. |
|
#this could give spurious results for large pastes where buffering chunks it in odd places.? |
|
#it does however give sensible output for the common case of a small paste where the last line ending wasn't included |
|
set waiting [punk::lib::system::incomplete $commandstr[$editbuf line end]] |
|
} else { |
|
set waiting [punk::lib::system::incomplete $commandstr] |
|
} |
|
if {[llength $waiting]} { |
|
set c [lindex $waiting end] |
|
} else { |
|
#set c " " |
|
set c \u240a |
|
} |
|
doprompt ">$c " |
|
} |
|
} |
|
} |
|
|
|
incr linenum |
|
} |
|
|
|
|
|
if {$maxlinenum == -1} { |
|
#when in raw mode - no linefeed yet received |
|
#rputs stderr "repl: no complete input line: $commandstr" |
|
#screen_last_char_add "\n" empty empty |
|
|
|
screen_last_char_add [string index [$editbuf line end] end] stdinchunk stdinchunk |
|
|
|
} |
|
|
|
|
|
#fileevent $inputchan readable [list repl::repl_handler $inputchan $prompt_config] |
|
#catch {puts stderr "zend--->[rep $::arglej]"} |
|
|
|
|
|
} trap {POSIX} {e eopts} { |
|
rputs stderr "trap POSIX '$e' eopts:'$eopts" |
|
flush stderr |
|
} on error {repl_error erropts} { |
|
rputs stderr "error in repl_handler: $repl_error" |
|
rputs stderr "-------------" |
|
rputs stderr "$::errorInfo" |
|
rputs stderr "-------------" |
|
set stdinreader [fileevent $inputchan readable] |
|
if {![string length $stdinreader]} { |
|
rputs stderr "*> $inputchan reader inactive" |
|
} else { |
|
rputs stderr "*> $inputchan reader active" |
|
} |
|
if {[chan eof $inputchan]} { |
|
rputs stderr "todo - attempt restart of repl on input channel: $inputchan in next loop" |
|
catch {set ::punk::ns::ns_current "::"} |
|
#todo set flag to restart repl ? |
|
} else { |
|
rputs stderr "continuing.." |
|
} |
|
flush stderr |
|
} |
|
} |
|
|
|
proc repl::completion {context ebuf} { |
|
|
|
} |
|
|
|
namespace eval repl { |
|
proc init {args} { |
|
if {![info exists ::argv0]} { |
|
#error out before we create a thread - punk requires this - review |
|
error "::argv0 not set" |
|
} |
|
#in case -callback_interp wasn't explicitly defined - we make a guess based on how init was called as to whether this is being launched from a 'code' or root ("") interp. |
|
if {[catch {info level -1} caller]} { |
|
puts "repl::init from: global" |
|
set default_callback_interp "" |
|
} else { |
|
#puts "repl::init from: $caller" |
|
set default_callback_interp "code" |
|
} |
|
variable codethread |
|
variable codethread_cond |
|
variable codethread_mutex |
|
|
|
set opts [list -force 0 -safe 0 -safelog 0 -paths {} -callback_interp $default_callback_interp] |
|
foreach {k v} $args { |
|
switch -- $k { |
|
-force - -safe - -safelog - -paths - -callback_interp { |
|
dict set opts $k $v |
|
} |
|
default { |
|
error "repl::init unknown option '$k'. Known-options: [dict keys $opts]" |
|
} |
|
} |
|
} |
|
set opt_force [dict get $opts -force] |
|
set opt_safe [dict get $opts -safe] |
|
set opt_safelog [dict get $opts -safelog] |
|
if {$opt_safelog eq "0"} { |
|
set opt_safelog "" |
|
} |
|
if {[string is boolean -strict $opt_safelog]} { |
|
if {$opt_safelog} { |
|
set opt_safelog ::repl::interpextras::safe_msg |
|
} |
|
} |
|
dict set opts -safelog $opt_safelog |
|
|
|
#If we are launching a repl from within an interp - we need to tell the childthread how to call-back to the parent repl |
|
set opt_callback_interp [dict get $opts -callback_interp] |
|
|
|
if {$codethread ne "" && !$opt_force && [thread::exists $codethread] } { |
|
error "repl:init codethread: $codethread already exists. use -force 1 to override" |
|
} |
|
set codethread [thread::create -preserved] |
|
|
|
#review - naming of the possibly 2 cond variables parent and child thread |
|
set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) |
|
set codethread_mutex [thread::mutex create] |
|
|
|
thread::send $codethread [string map [list %args% [list $opts]\ |
|
%argv0% [list $::argv0]\ |
|
%argv% [list $::argv]\ |
|
%argc% [list $::argc]\ |
|
%replthread% [thread::id]\ |
|
%replthread_cond% $codethread_cond\ |
|
%replthread_interp% [list $opt_callback_interp]\ |
|
%tmlist% [list [tcl::tm::list]]\ |
|
%autopath% [list $::auto_path]\ |
|
] { |
|
set ::argv0 %argv0% |
|
set ::argv %argv% |
|
set ::argc %argc% |
|
tcl::tm::remove {*}[tcl::tm::list] |
|
tcl::tm::add {*}[lreverse %tmlist%] ;#Must be added in reverse order to get same order as original list! |
|
|
|
#this sets the auto_path in the thread but outside of the code interp that will be created. |
|
#It will also need to be added in that interp |
|
set ::auto_path %autopath% |
|
set tclmajorv [lindex [split [tcl::info::tclversion] .] 0] |
|
#jmn2 |
|
#puts stdout "CODETHREAD tm list" |
|
#puts stdout [join [tcl::tm::list] \n] |
|
#puts stdout "====================" |
|
#flush stdout |
|
#puts stdout "CODETHREAD autopath" |
|
#puts stdout [join $::auto_path \n] |
|
#puts stdout "====================" |
|
#flush stdout |
|
#if {[llength [info commands tcl::zipfs::root]]} { |
|
# set zipbase [file join [tcl::zipfs::root] app] ;#zipfs root has trailing slash - but file join does the right thing |
|
# if {"$zipbase" in [tcl::zipfs::mount]} { |
|
# puts stdout "//zipfs:/app/modules_tcl$tclmajorv exists: [file exists //zipfs:/app/modules_tcl$tclmajorv]" |
|
# } |
|
#} |
|
#puts stdout "====================" |
|
|
|
package require punk::console |
|
package require punk::repl::codethread |
|
package require shellfilter |
|
#package require shellrun |
|
package require textblock |
|
|
|
#md5 uses open so can't be directly called in a safe interp |
|
#it will need to delegate to a call here in the main interp of the codethread using an installed alias |
|
set md5version [package require md5] |
|
#we also need to 'package provide md5 $md5version' in the safe interp itself so that it won't override |
|
|
|
|
|
#punk::configure_unknown ;#must be called because we hacked the tcl 'unknown' proc |
|
|
|
#child codethread (outside of code interp) needs to know details of the calling repl |
|
set ::punk::repl::codethread::replthread %replthread% ;#point to thread id of parent thread (repl) |
|
set ::punk::repl::codethread::replthread_cond %replthread_cond% |
|
set ::punk::repl::codethread::replthread_interp %replthread_interp% |
|
|
|
# -- --- --- --- |
|
#procs to alias into the codethread interp |
|
#as we are doing string substitution on the whole block anyway, and these values are contant for the life of the thread, we may as well substitute hard values for things like replthread into these procs where possible |
|
# -- --- --- --- |
|
namespace eval ::repl::interphelpers { |
|
proc quit {args} { |
|
#child codethreads run in a 'code' interp therefore if they started another repl - it is within the 'code' interp in that thread |
|
# whereas the first repl launched in the process runs in root interp "" |
|
thread::send -async %replthread% [list interp eval %replthread_interp% ::punk::repl::quit] |
|
} |
|
proc editbuf args { |
|
thread::send %replthread% [list punk::repl::editbuf {*}$args] |
|
} |
|
proc escapeeval {script} { |
|
eval $script |
|
} |
|
proc do_after {args} { |
|
if {[llength $args] == 1} { |
|
return after {*}$args |
|
} |
|
set scr [lindex $args 1] |
|
after [lindex $args 0] [list punk::repl::codethread::runscript $scr] |
|
} |
|
proc repl_ensemble_unknown args { |
|
puts $args |
|
if {[llength $args] == 1} { |
|
return [namespace ensemble configure ::repl::interphelpers::repl_ensemble] |
|
} |
|
} |
|
proc colour args { |
|
set colour_state [thread::send %replthread% [list punk::console::colour]] |
|
if {[llength $args]} { |
|
#colour call was not a query |
|
set new_state [thread::send %replthread% [list punk::console::colour {*}$args]] |
|
if {[expr {$new_state}] ne [expr {$colour_state}]} { |
|
interp eval code [list punk::console::colour {*}$args] ;#align code interp's view of colour state with repl thread |
|
interp eval code [string map [list <cstate> $new_state] { |
|
#adjust channel transform stack |
|
set docolour [expr {<cstate>}] |
|
if {!$docolour} { |
|
set s [lindex $::codeinterp::outstack end] |
|
if {$s ne ""} { |
|
shellfilter::stack::remove stdout $s |
|
} |
|
set s [lindex $::codeinterp::errstack end] |
|
if {$s ne ""} { |
|
shellfilter::stack::remove stderr $s |
|
} |
|
} else { |
|
set running_config $::punk::config::running |
|
if {[string length [dict get $running_config color_stdout]]} { |
|
lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] |
|
} |
|
if {[string length [dict get $running_config color_stderr]]} { |
|
lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] |
|
} |
|
|
|
} |
|
}] |
|
} |
|
return $new_state |
|
} else { |
|
return $colour_state |
|
} |
|
#todo - add/remove shellfilter stacked ansiwrap |
|
} |
|
proc mode args { |
|
thread::send %replthread% [list punk::console::mode {*}$args] |
|
interp eval code [list ::punk::console::mode {*}$args] |
|
} |
|
proc cmdtype cmd { |
|
code invokehidden tcl:info:cmdtype $cmd |
|
} |
|
|
|
#punk repl tsv wrappers |
|
proc set_repl_last_unknown args { |
|
tsv::set repl last_unknown {*}$args |
|
} |
|
proc get_repl_runid args { |
|
if {[tsv::exists repl runid]} { |
|
return [tsv::get repl runid] |
|
} else { |
|
return 0 |
|
} |
|
} |
|
proc md5 args { |
|
::md5::md5 {*}$args |
|
} |
|
} |
|
namespace eval ::repl::interpextras { |
|
#install using safe::setLogCmd |
|
proc safe_msg {msg} { |
|
puts stderr "safebase: $msg" |
|
} |
|
} |
|
|
|
namespace eval ::repl::interphelpers::repl_ensemble { |
|
namespace export {[a-z]*} |
|
namespace ensemble create |
|
namespace ensemble configure [namespace current] -unknown ::repl::interphelpers::repl_ensemble_unknown |
|
variable replinfo |
|
set replinfo [dict create thread %replthread% interp %replthread_interp%] |
|
proc thread {} { |
|
return %replthread% |
|
} |
|
proc info {} { |
|
variable replinfo |
|
return $replinfo |
|
} |
|
proc eval {script} { |
|
thread::send %replthread% $script |
|
} |
|
proc stack {} { |
|
set iname %replthread_interp% |
|
set tid %replthread% |
|
lappend stack [list thread $tid interp $iname] |
|
while {$iname eq "code"} { |
|
set iname [thread::send $tid {set ::punk::repl::codethread::replthread_interp}] |
|
set tid [thread::send $tid {set ::punk::repl::codethread::replthread}] |
|
lappend stack [list thread $tid interp $iname] |
|
} |
|
return $stack |
|
} |
|
} |
|
namespace eval ::repl::interphelpers::subshell_ensemble { |
|
namespace export {[a-z]*} |
|
namespace ensemble create |
|
proc punk {} { |
|
interp eval code { |
|
package require punk::repl |
|
repl::init |
|
repl::start stdin |
|
} |
|
} |
|
proc safe {args} { |
|
interp eval code { |
|
package require punk::repl |
|
} |
|
interp eval code [list repl::init -safe 1 {*}$args] |
|
interp eval code [list repl::start stdin] |
|
} |
|
proc safebase {args} { |
|
interp eval code { |
|
package require punk::repl |
|
} |
|
interp eval code [list repl::init -safe 2 {*}$args] |
|
interp eval code [list repl::start stdin] |
|
} |
|
} |
|
# -- --- --- --- --- |
|
|
|
#puts "codethread:[thread::id] parent replthread:%replthread%" |
|
#flush stdout |
|
|
|
set args %args% |
|
set safe [dict get $args -safe] |
|
set safelog [dict get $args -safelog] |
|
set paths [list] |
|
if {[dict exists $args -paths]} { |
|
set paths [dict get $args -paths] |
|
} |
|
|
|
if {$safe == 1} { |
|
interp create -safe -- code |
|
if {[llength $paths]} { |
|
package require punk::island |
|
foreach p $paths { |
|
punk::island::add code $p |
|
} |
|
} |
|
|
|
#review argv0,argv,argc |
|
interp eval code { |
|
namespace eval ::codeinterp { |
|
variable errstack {} |
|
variable outstack {} |
|
} |
|
set ::argv0 %argv0% |
|
set ::auto_path %autopath% |
|
#puts stdout "safe interp" |
|
#flush stdout |
|
} |
|
interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] |
|
interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] |
|
interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] |
|
if {"stdout" in [chan names]} { |
|
interp share {} stdout code |
|
} else { |
|
interp share {} [shellfilter::stack::item_tophandle stdout] code |
|
} |
|
if {"stderr" in [chan names]} { |
|
interp share {} stderr code |
|
} else { |
|
interp share {} [shellfilter::stack::item_tophandle stderr] code |
|
} |
|
|
|
code alias ::md5::md5 ::repl::interphelpers::md5 |
|
code alias exit ::repl::interphelpers::quit |
|
} elseif {$safe == 2} { |
|
safe::interpCreate code -nested 1 |
|
#safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* |
|
#while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. |
|
if {[llength $paths]} { |
|
package require punk::island |
|
foreach p $paths { |
|
punk::island::add code $p |
|
} |
|
} |
|
interp eval code { |
|
set ::argv0 %argv0% |
|
set ::argc 0 |
|
set ::argv {} |
|
set ::auto_path %autopath% |
|
#puts stdout "safe interp" |
|
#flush stdout |
|
namespace eval ::codeinterp { |
|
variable errstack {} |
|
variable outstack {} |
|
} |
|
} |
|
interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] |
|
interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] |
|
interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] |
|
|
|
#code invokehidden package require punk::lib |
|
if {"stdout" in [chan names]} { |
|
interp share {} stdout code |
|
} else { |
|
interp share {} [shellfilter::stack::item_tophandle stdout] code |
|
} |
|
if {"stderr" in [chan names]} { |
|
interp share {} stderr code |
|
} else { |
|
interp share {} [shellfilter::stack::item_tophandle stderr] code |
|
} |
|
#work around bug in safe base which won't load Tcl libs that have deeper nesting |
|
#(also affects tcllib page/plugins folder) |
|
set termversions [package versions term] |
|
set termv [lindex $termversions end] |
|
if {$termv ne ""} { |
|
set path [lindex [package ifneeded term $termv] end] ;#assuming path at end of something like "source .../term.tcl" |
|
set termbase [file dirname $path] |
|
safe::interpAddToAccessPath code [file join $termbase ansi] |
|
safe::interpAddToAccessPath code [file join $termbase ansi code] |
|
} |
|
#safe::interpAddToAccessPath code NUL |
|
if {$safelog ne ""} { |
|
#setting setLogCmd here gives some feedback for potentially interesting feedback regarding behaviour of things such as glob |
|
safe::setLogCmd $safelog |
|
} |
|
#code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm |
|
|
|
code alias detok ::safe::DetokPath code |
|
|
|
#review - exit should do something slightly different |
|
# see ::safe::interpDelete |
|
code alias exit ::repl::interphelpers::quit |
|
|
|
code alias ::md5::md5 ::repl::interphelpers::md5 |
|
interp eval code [list package provide md5 $md5version] |
|
} else { |
|
interp create code |
|
interp eval code { |
|
#safe !=1 and safe !=2, tmlist: %tmlist% |
|
set ::argv0 %argv0% |
|
set ::argv %argv% |
|
set ::argc %argc% |
|
set ::auto_path %autopath% |
|
tcl::tm::remove {*}[tcl::tm::list] |
|
tcl::tm::add {*}[lreverse %tmlist%] |
|
puts "code interp chan names-->[chan names]" |
|
namespace eval ::codeinterp { |
|
variable errstack {} |
|
variable outstack {} |
|
} |
|
|
|
# -- --- |
|
#review |
|
#we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) |
|
#review - can we speed that scan up? |
|
##catch {package require flobrudder-nonexistant} |
|
# -- --- |
|
|
|
if {[catch { |
|
package require vfs |
|
package require vfs::zip |
|
} errM]} { |
|
puts stderr "repl code interp can't load vfs,vfs::zip" |
|
} |
|
|
|
#puts stderr ----- |
|
#puts stderr [join $::auto_path \n] |
|
#puts stderr ----- |
|
|
|
if {[catch { |
|
package require punk::config |
|
package require punk::ns |
|
#puts stderr "loading natsort" |
|
#natsort has 'application mode' which can exit. |
|
#Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions |
|
package require natsort |
|
#catch {package require packageTrace} |
|
package require punk |
|
package require shellrun |
|
|
|
package require shellfilter |
|
set running_config $::punk::config::running |
|
if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { |
|
lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] |
|
} |
|
if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { |
|
lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] |
|
} |
|
|
|
package require textblock |
|
} errM]} { |
|
puts stderr "========================" |
|
puts stderr "code interp error:" |
|
puts stderr $errM |
|
puts stderr $::errorInfo |
|
puts stderr "========================" |
|
error "$errM" |
|
} |
|
} |
|
} |
|
code alias repl ::repl::interphelpers::repl_ensemble |
|
code alias subshell ::repl::interphelpers::subshell_ensemble |
|
code alias quit ::repl::interphelpers::quit |
|
code alias editbuf ::repl::interphelpers::editbuf |
|
code alias colour ::repl::interphelpers::colour |
|
code alias mode ::repl::interphelpers::mode |
|
#code alias after ::repl::interphelpers::do_after |
|
|
|
code alias ::punk::set_repl_last_unknown ::repl::interphelpers::set_repl_last_unknown |
|
code alias ::punk::get_repl_runid ::repl::interphelpers::get_repl_runid |
|
|
|
#JMN |
|
#code alias cmdtype ::repl::interphelpers::cmdtype |
|
#temporary debug aliases - deliberate violation of safety provided by safe interp |
|
code alias escapeeval ::repl::interphelpers::escapeeval |
|
|
|
#puts stderr "returning threadid" |
|
#puts stderr [thread::id] |
|
|
|
return [thread::id] |
|
}] |
|
} |
|
#init - don't auto init - require init with possible options e.g -safe |
|
} |
|
package provide punk::repl [namespace eval punk::repl { |
|
variable version |
|
set version 0.1 |
|
}] |
|
|
|
#repl::start $program_read_stdin_pipe |
|
|
|
|
|
|
|
|