Browse Source

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

master
Julian Noble 2 years ago
parent
commit
2d4def515e
  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

File diff suppressed because it is too large Load Diff

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

@ -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

Loading…
Cancel
Save