|
|
|
@ -5,6 +5,9 @@ namespace eval punkrepl {
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#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. |
|
|
|
@ -67,6 +70,27 @@ namespace eval repl {
|
|
|
|
|
|
|
|
|
|
namespace eval punkrepl { |
|
|
|
|
variable debug_repl 0 |
|
|
|
|
|
|
|
|
|
proc has_script_var_bug {} { |
|
|
|
|
set script {set j [list spud] ; list} |
|
|
|
|
append script \n |
|
|
|
|
uplevel #0 $script |
|
|
|
|
set rep1 [tcl::unsupported::representation $::j] |
|
|
|
|
set script "" |
|
|
|
|
set rep2 [tcl::unsupported::representation $::j] |
|
|
|
|
|
|
|
|
|
set nostring1 [string match "*no string" $rep1] |
|
|
|
|
set nostring2 [string match "*no string" $rep1] |
|
|
|
|
|
|
|
|
|
#we assume it should have no string rep in either case |
|
|
|
|
#Review: check Tcl versions for behaviour/consistency |
|
|
|
|
if {!$nostring2} { |
|
|
|
|
return true |
|
|
|
|
} else { |
|
|
|
|
return false |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -118,7 +142,6 @@ interp alias {} smcup {} ::repl::term::screen_push_alt
|
|
|
|
|
interp alias {} rmcup {} ::repl::term::screen_pop_alt |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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]]] |
|
|
|
@ -150,7 +173,7 @@ set err [dict get $errdevice localchan]
|
|
|
|
|
# command, including the command name. |
|
|
|
|
|
|
|
|
|
proc ::unknown args { |
|
|
|
|
|
|
|
|
|
#puts stderr "unk>$args" |
|
|
|
|
variable ::tcl::UnknownPending |
|
|
|
|
global auto_noexec auto_noload env tcl_interactive errorInfo errorCode |
|
|
|
|
|
|
|
|
@ -533,6 +556,7 @@ proc repl::doprompt {prompt {col {green bold}}} {
|
|
|
|
|
} |
|
|
|
|
proc repl::get_prompt_config {} { |
|
|
|
|
if {$::tcl_interactive} { |
|
|
|
|
#todo make a+ stacking |
|
|
|
|
set resultprompt "[a+ green bold]-[a+] " |
|
|
|
|
set infoprompt "[a+ green bold]*[a+] " |
|
|
|
|
set debugprompt "[a+ purple bold]~[a+] " |
|
|
|
@ -544,12 +568,12 @@ proc repl::get_prompt_config {} {
|
|
|
|
|
return [list resultprompt $resultprompt infoprompt $infoprompt debugprompt $debugprompt] |
|
|
|
|
} |
|
|
|
|
proc repl::start {inchan} { |
|
|
|
|
variable command |
|
|
|
|
variable commandstr |
|
|
|
|
variable running |
|
|
|
|
variable reading |
|
|
|
|
variable done |
|
|
|
|
set running 1 |
|
|
|
|
set command "" |
|
|
|
|
set commandstr "" |
|
|
|
|
set prompt_config [get_prompt_config] |
|
|
|
|
doprompt "P% " |
|
|
|
|
fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] |
|
|
|
@ -729,7 +753,6 @@ proc repl::newout2 {} {
|
|
|
|
|
# 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 |
|
|
|
|
|
|
|
|
@ -810,6 +833,7 @@ proc repl::screen_needs_clearance {} {
|
|
|
|
|
|
|
|
|
|
proc repl::repl_handler {inputchan prompt_config} { |
|
|
|
|
variable prompt_reset_flag |
|
|
|
|
#catch {puts stderr "xx--->[rep $::arglej]"} |
|
|
|
|
if {$prompt_reset_flag == 1} { |
|
|
|
|
set prompt_config [get_prompt_config] |
|
|
|
|
set prompt_reset_flag 0 |
|
|
|
@ -817,7 +841,7 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
variable last_repl_char "" ;#last char emitted by this handler to stdout/stderr |
|
|
|
|
variable lastoutchar "" |
|
|
|
|
variable lasterrchar "" |
|
|
|
|
variable command |
|
|
|
|
variable commandstr |
|
|
|
|
variable running |
|
|
|
|
variable reading |
|
|
|
|
variable post_script |
|
|
|
@ -844,10 +868,11 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
set debugprompt [dict get $prompt_config debugprompt] |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
append command $line\n |
|
|
|
|
append commandstr $line\n |
|
|
|
|
#puts "=============>$commandstr" |
|
|
|
|
set ::repl::last_repl_char "\n" ;#this is actually the eol from stdin |
|
|
|
|
screen_last_char_add "\n" stdin $line |
|
|
|
|
if {[info complete $command]} { |
|
|
|
|
if {[info complete $commandstr]} { |
|
|
|
|
set ::repl::output_stdout "" |
|
|
|
|
set ::repl::output_stderr "" |
|
|
|
|
set outstack [list] |
|
|
|
@ -855,7 +880,7 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#oneshot repl debug |
|
|
|
|
set wordparts [regexp -inline -all {\S+} $command] |
|
|
|
|
set wordparts [regexp -inline -all {\S+} $commandstr] |
|
|
|
|
lassign $wordparts cmd_firstword cmd_secondword |
|
|
|
|
if {$cmd_firstword eq "debugrepl"} { |
|
|
|
|
if {[string is integer -strict $cmd_secondword]} { |
|
|
|
@ -863,7 +888,7 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
} else { |
|
|
|
|
incr ::punkrepl::debug_repl |
|
|
|
|
} |
|
|
|
|
set command "set ::punkrepl::debug_repl" |
|
|
|
|
set commandstr "set ::punkrepl::debug_repl" |
|
|
|
|
} |
|
|
|
|
if {$::punkrepl::debug_repl > 0} { |
|
|
|
|
proc debug_repl_emit {msg} [string map [list %p% [list $debugprompt]] { |
|
|
|
@ -889,7 +914,17 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
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 ::punk::last_run_display [list] |
|
|
|
|
set ::repl::last_unknown "" |
|
|
|
@ -907,16 +942,20 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
#chan configure stdout -buffering none |
|
|
|
|
fileevent $inputchan readable {} |
|
|
|
|
set reading 0 |
|
|
|
|
#don't let unknown use 'args' to convert command to list |
|
|
|
|
#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 " $command]} { |
|
|
|
|
if {[string equal -length [string length "repl_runraw "] "repl_runraw " $commandstr]} { |
|
|
|
|
#pass unevaluated command to runraw |
|
|
|
|
set status [catch {uplevel #0 [list runraw $command]} result] |
|
|
|
|
set status [catch {uplevel #0 [list runraw $commandstr]} result] |
|
|
|
|
} else { |
|
|
|
|
#puts stderr "repl uplevel 0 '$command'" |
|
|
|
|
set status [catch {uplevel #0 $command} result] |
|
|
|
|
set status [catch { |
|
|
|
|
#uplevel 1 $run_command_string |
|
|
|
|
uplevel 1 {namespace eval $punk::ns_current $run_command_string} |
|
|
|
|
} result] |
|
|
|
|
} |
|
|
|
|
#=============================================================================== |
|
|
|
|
flush stdout |
|
|
|
@ -928,7 +967,16 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
shellfilter::stack::remove stderr $s |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#----------------------------------------- |
|
|
|
|
#list/string-rep bug workaround part 2 |
|
|
|
|
#todo - set flag based on punkrepl::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] |
|
|
|
|
} |
|
|
|
|
#----------------------------------------- |
|
|
|
|
|
|
|
|
|
set lastoutchar [string index $::repl::output_stdout end] |
|
|
|
|
set lasterrchar [string index $::repl::output_stderr end] |
|
|
|
|
|
|
|
|
@ -942,7 +990,7 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
#also - unknown commands aren't the only things that can write directly to the os handles stderr & stdout |
|
|
|
|
if { |
|
|
|
|
[string length $::repl::last_unknown] && \ |
|
|
|
|
[string equal -length [string length $::repl::last_unknown] $::repl::last_unknown $command] |
|
|
|
|
[string equal -length [string length $::repl::last_unknown] $::repl::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 |
|
|
|
@ -992,18 +1040,19 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
# so may not be a well formed list e.g 'set x [list a "b"]' |
|
|
|
|
#- lindex will fail |
|
|
|
|
#if {[lindex $command 0] eq "runx"} {} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if { |
|
|
|
|
[string equal -length [string length "./ "] "./ " $command] || \ |
|
|
|
|
[string equal "./\n" $command] || \ |
|
|
|
|
[string equal -length [string length "../ "] "../ " $command] || \ |
|
|
|
|
[string equal "../\n" $command] || \ |
|
|
|
|
[string equal -length [string length "runx "] "runx " $command] || \ |
|
|
|
|
[string equal -length [string length "sh_runx "] "sh_runx " $command] || \ |
|
|
|
|
[string equal -length [string length "runout "] "runout " $command] || \ |
|
|
|
|
[string equal -length [string length "sh_runout "] "sh_runout " $command] || \ |
|
|
|
|
[string equal -length [string length "runerr "] "runerr " $command] || \ |
|
|
|
|
[string equal -length [string length "sh_runerr "] "sh_runerr " $command] |
|
|
|
|
[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 {[llength $last_run_display]} { |
|
|
|
@ -1012,12 +1061,20 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#an attempt to preserve underlying rep |
|
|
|
|
#this is not for performance - just to be less disruptive to underlying rep to aid in learning/debugging |
|
|
|
|
if {[catch {lrange $result 0 end} result_as_list]} { |
|
|
|
|
set is_result_empty [expr {$result eq ""}] |
|
|
|
|
|
|
|
|
|
} else { |
|
|
|
|
set is_result_empty [expr {[llength $result_as_list] == 0}] |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#catch {puts stderr "yy--->[rep $::arglej]"} |
|
|
|
|
|
|
|
|
|
set reading 1 |
|
|
|
|
if {$result ne ""} { |
|
|
|
|
if {!$is_result_empty} { |
|
|
|
|
if {$status == 0} { |
|
|
|
|
if {[screen_needs_clearance]} { |
|
|
|
|
rputs -nonewline stderr \n |
|
|
|
@ -1087,20 +1144,23 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
doprompt "P% " |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
set command "" |
|
|
|
|
#catch {puts stderr "zz1--->[rep $::arglej]"} |
|
|
|
|
#puts stderr "??? $commandstr" |
|
|
|
|
if {$::punkrepl::debug_repl > 0} { |
|
|
|
|
incr ::punkrepl::debug_repl -1 |
|
|
|
|
} |
|
|
|
|
set commandstr "" |
|
|
|
|
#catch {puts stderr "zz2---->[rep $::arglej]"} |
|
|
|
|
} else { |
|
|
|
|
#append command \n |
|
|
|
|
#append commandstr \n |
|
|
|
|
if {$::repl::signal_control_c} { |
|
|
|
|
set ::repl::signal_control_c 0 |
|
|
|
|
rputs stderr "* console_control: control-c" |
|
|
|
|
set c [a+ yellow bold] |
|
|
|
|
set n [a+] |
|
|
|
|
rputs stderr "${c}repl interrupted$n" |
|
|
|
|
#set command [list error "repl interrupted"] |
|
|
|
|
set command "" |
|
|
|
|
#set commandstr [list error "repl interrupted"] |
|
|
|
|
set commandstr "" |
|
|
|
|
doprompt ">_ " |
|
|
|
|
|
|
|
|
|
} else { |
|
|
|
@ -1108,6 +1168,8 @@ proc repl::repl_handler {inputchan prompt_config} {
|
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
fileevent $inputchan readable [list [namespace current]::repl_handler $inputchan $prompt_config] |
|
|
|
|
#fileevent $inputchan readable [list repl::repl_handler $inputchan $prompt_config] |
|
|
|
|
#catch {puts stderr "zend--->[rep $::arglej]"} |
|
|
|
|
} |
|
|
|
|
#repl::start stdin |
|
|
|
|
#exit 0 |
|
|
|
|