jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

patternmatch and pipeline fixes for booleans dicts and lists. Namespace navigation, env(path) display etc

master
Julian Noble 1 year ago
parent
5ac8a99794
commit
2d4def515e
2 changed files with 1482 additions and 438 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 1790
      src/modules/punk-0.1.tm
  2. 130
      src/punk86.vfs/lib/app-punk/repl.tcl

1790
src/modules/punk-0.1.tm
View File

File diff suppressed because it is too large Load Diff

130
src/punk86.vfs/lib/app-punk/repl.tcl
Unescape View File

@ -5,6 +5,9 @@ namespace eval punkrepl {
} }
#list/string-rep bug
global run_commandstr ""
set stdin_info [chan configure stdin] set stdin_info [chan configure stdin]
if {[dict exists $stdin_info -inputmode]} { 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. #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 { namespace eval punkrepl {
variable debug_repl 0 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 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 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 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 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. # command, including the command name.
proc ::unknown args { proc ::unknown args {
#puts stderr "unk>$args"
variable ::tcl::UnknownPending variable ::tcl::UnknownPending
global auto_noexec auto_noload env tcl_interactive errorInfo errorCode 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 {} { proc repl::get_prompt_config {} {
if {$::tcl_interactive} { if {$::tcl_interactive} {
#todo make a+ stacking
set resultprompt "[a+ green bold]-[a+] " set resultprompt "[a+ green bold]-[a+] "
set infoprompt "[a+ green bold]*[a+] " set infoprompt "[a+ green bold]*[a+] "
set debugprompt "[a+ purple 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] return [list resultprompt $resultprompt infoprompt $infoprompt debugprompt $debugprompt]
} }
proc repl::start {inchan} { proc repl::start {inchan} {
variable command variable commandstr
variable running variable running
variable reading variable reading
variable done variable done
set running 1 set running 1
set command "" set commandstr ""
set prompt_config [get_prompt_config] set prompt_config [get_prompt_config]
doprompt "P% " doprompt "P% "
fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] 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) # rputs deliberately doesn't check screen_last_chars before emitting data (unless reporting an error in rputs itself)
proc repl::rputs {args} { proc repl::rputs {args} {
variable screen_last_chars variable screen_last_chars
variable last_out_was_newline variable last_out_was_newline
variable last_repl_char variable last_repl_char
@ -810,6 +833,7 @@ proc repl::screen_needs_clearance {} {
proc repl::repl_handler {inputchan prompt_config} { proc repl::repl_handler {inputchan prompt_config} {
variable prompt_reset_flag variable prompt_reset_flag
#catch {puts stderr "xx--->[rep $::arglej]"}
if {$prompt_reset_flag == 1} { if {$prompt_reset_flag == 1} {
set prompt_config [get_prompt_config] set prompt_config [get_prompt_config]
set prompt_reset_flag 0 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 last_repl_char "" ;#last char emitted by this handler to stdout/stderr
variable lastoutchar "" variable lastoutchar ""
variable lasterrchar "" variable lasterrchar ""
variable command variable commandstr
variable running variable running
variable reading variable reading
variable post_script variable post_script
@ -844,10 +868,11 @@ proc repl::repl_handler {inputchan prompt_config} {
set debugprompt [dict get $prompt_config debugprompt] 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 set ::repl::last_repl_char "\n" ;#this is actually the eol from stdin
screen_last_char_add "\n" stdin $line screen_last_char_add "\n" stdin $line
if {[info complete $command]} { if {[info complete $commandstr]} {
set ::repl::output_stdout "" set ::repl::output_stdout ""
set ::repl::output_stderr "" set ::repl::output_stderr ""
set outstack [list] set outstack [list]
@ -855,7 +880,7 @@ proc repl::repl_handler {inputchan prompt_config} {
#oneshot repl debug #oneshot repl debug
set wordparts [regexp -inline -all {\S+} $command] set wordparts [regexp -inline -all {\S+} $commandstr]
lassign $wordparts cmd_firstword cmd_secondword lassign $wordparts cmd_firstword cmd_secondword
if {$cmd_firstword eq "debugrepl"} { if {$cmd_firstword eq "debugrepl"} {
if {[string is integer -strict $cmd_secondword]} { if {[string is integer -strict $cmd_secondword]} {
@ -863,7 +888,7 @@ proc repl::repl_handler {inputchan prompt_config} {
} else { } else {
incr ::punkrepl::debug_repl incr ::punkrepl::debug_repl
} }
set command "set ::punkrepl::debug_repl" set commandstr "set ::punkrepl::debug_repl"
} }
if {$::punkrepl::debug_repl > 0} { if {$::punkrepl::debug_repl > 0} {
proc debug_repl_emit {msg} [string map [list %p% [list $debugprompt]] { 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} 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 ::punk::last_run_display [list]
set ::repl::last_unknown "" set ::repl::last_unknown ""
@ -907,16 +942,20 @@ proc repl::repl_handler {inputchan prompt_config} {
#chan configure stdout -buffering none #chan configure stdout -buffering none
fileevent $inputchan readable {} fileevent $inputchan readable {}
set reading 0 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 #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 #pass unevaluated command to runraw
set status [catch {uplevel #0 [list runraw $command]} result] set status [catch {uplevel #0 [list runraw $commandstr]} result]
} else { } else {
#puts stderr "repl uplevel 0 '$command'" #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 flush stdout
@ -928,7 +967,16 @@ proc repl::repl_handler {inputchan prompt_config} {
shellfilter::stack::remove stderr $s 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 lastoutchar [string index $::repl::output_stdout end]
set lasterrchar [string index $::repl::output_stderr 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 #also - unknown commands aren't the only things that can write directly to the os handles stderr & stdout
if { if {
[string length $::repl::last_unknown] && \ [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 #can't currently detect stdout/stderr writes from unknown's call to exec
#add a clearance newline for direct unknown calls for now #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"]' # so may not be a well formed list e.g 'set x [list a "b"]'
#- lindex will fail #- lindex will fail
#if {[lindex $command 0] eq "runx"} {} #if {[lindex $command 0] eq "runx"} {}
if { if {
[string equal -length [string length "./ "] "./ " $command] || \ [string equal -length [string length "./ "] "./ " $commandstr] || \
[string equal "./\n" $command] || \ [string equal "./\n" $commandstr] || \
[string equal -length [string length "../ "] "../ " $command] || \ [string equal -length [string length "../ "] "../ " $commandstr] || \
[string equal "../\n" $command] || \ [string equal "../\n" $commandstr] || \
[string equal -length [string length "runx "] "runx " $command] || \ [string equal -length [string length "runx "] "runx " $commandstr] || \
[string equal -length [string length "sh_runx "] "sh_runx " $command] || \ [string equal -length [string length "sh_runx "] "sh_runx " $commandstr] || \
[string equal -length [string length "runout "] "runout " $command] || \ [string equal -length [string length "runout "] "runout " $commandstr] || \
[string equal -length [string length "sh_runout "] "sh_runout " $command] || \ [string equal -length [string length "sh_runout "] "sh_runout " $commandstr] || \
[string equal -length [string length "runerr "] "runerr " $command] || \ [string equal -length [string length "runerr "] "runerr " $commandstr] || \
[string equal -length [string length "sh_runerr "] "sh_runerr " $command] [string equal -length [string length "sh_runerr "] "sh_runerr " $commandstr]
} { } {
if {[llength $last_run_display]} { 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 set reading 1
if {$result ne ""} { if {!$is_result_empty} {
if {$status == 0} { if {$status == 0} {
if {[screen_needs_clearance]} { if {[screen_needs_clearance]} {
rputs -nonewline stderr \n rputs -nonewline stderr \n
@ -1087,20 +1144,23 @@ proc repl::repl_handler {inputchan prompt_config} {
doprompt "P% " doprompt "P% "
} }
} }
set command "" #catch {puts stderr "zz1--->[rep $::arglej]"}
#puts stderr "??? $commandstr"
if {$::punkrepl::debug_repl > 0} { if {$::punkrepl::debug_repl > 0} {
incr ::punkrepl::debug_repl -1 incr ::punkrepl::debug_repl -1
} }
set commandstr ""
#catch {puts stderr "zz2---->[rep $::arglej]"}
} else { } else {
#append command \n #append commandstr \n
if {$::repl::signal_control_c} { if {$::repl::signal_control_c} {
set ::repl::signal_control_c 0 set ::repl::signal_control_c 0
rputs stderr "* console_control: control-c" rputs stderr "* console_control: control-c"
set c [a+ yellow bold] set c [a+ yellow bold]
set n [a+] set n [a+]
rputs stderr "${c}repl interrupted$n" rputs stderr "${c}repl interrupted$n"
#set command [list error "repl interrupted"] #set commandstr [list error "repl interrupted"]
set command "" set commandstr ""
doprompt ">_ " doprompt ">_ "
} else { } 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 [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 #repl::start stdin
#exit 0 #exit 0

Write Preview
Loading…
Cancel
Save