diff --git a/src/modules/patternpunk-1.1.tm b/src/modules/patternpunk-1.1.tm
new file mode 100644
index 00000000..fc2349f4
--- /dev/null
+++ b/src/modules/patternpunk-1.1.tm
@@ -0,0 +1,265 @@
+#
+#
+#
+#
+#
+# 2004 - Public Domain
+#
+# PatternPunk - DIALECT
+#Dynamic Instance Accumulation Language Extending Classic Tcl
+#The goofy acronym is a fancy way of not referring to PatternPunk as yet another OO system.
+
+
+package require pattern
+package require overtype
+pattern::init
+
+package provide patternpunk [namespace eval punk {
+ variable version
+
+ set version 1.1
+}]
+
+
+::>pattern .. Create ::>punk
+::>punk .. Property license {Public Domain}
+::>punk .. Property logo2 {
++-----------------------+
+| Pattern PUNK |
+| . \\\_ . |
+| .*. \@ > .=. |
+| .*.*. | ~ .=.=. |
+|.*.*.*.\_- -_/.=.=.=.|
+| .*.*. \\ .=.=. |
+| .*. / \ .=. |
+| . _+ +_ . |
++-----------------------+
+}
+set ::punk::bannerTemplate {
++-----------------------+
+| .000000000000000. |
+| .*. \\\_ .=. |
+| .*.*. \@ > .=.=. |
+|.*.*.*. | ~ .=.=.=.|
+| .*.*. \_- -_/ .=.=. |
+| .*. \\ .=. |
+| . / \ . |
+|111111111_+ +_2222222|
++-----------------------+
+}
+
+>punk .. Method banner {args} {
+ set defaults [list -title "Pattern PUNK" -left "" -right ""]
+ if {[catch {set opts [dict merge $defaults $args]} ]} {
+ error "usage: banner \[-title \$title -left \$left -right \$right\]"
+ }
+
+ set word1 [overtype::left [string repeat " " 9] [dict get $opts -left]]
+ set word2 [overtype::right [string repeat " " 7] [dict get $opts -right]]
+ set title [overtype::centre [string repeat " " 15] [dict get $opts -title]]
+
+ return [string map [list 111111111 $word1 2222222 $word2 000000000000000 $title] $punk::bannerTemplate]
+}
+
+
+
+>punk .. Property logo [>punk . banner]
+>punk .. Property versionLogo [>punk . banner -left " Ver" -right "$::punk::version "]
+>punk .. Property version $::punk::version
+
+>punk .. Property front {
+ _|_
+ @ v @
+ ~
+ - -
+ |_\ /_|
+ / \
+ _+ +_
+}
+>punk .. Property back {
+ |
+ ( | )
+ |
+ - -
+ |_\ /_|
+ / \
+ _- -_
+}
+>punk .. Property rhs {
+ \\\_
+ \@ >
+ | ~
+ \_- -_
+ \\ /
+ / \
+ _+ +_
+}
+>punk .. Property right
+>punk .. PropertyRead right {} {
+ return $o_rhs
+}
+
+
+>punk .. Property lhs {
+ _///
+ < @/
+ ~ |
+ _- -_/
+ \ //
+ / \
+ _+ +_
+}
+>punk .. Property left
+>punk .. PropertyRead left {} {
+ return $o_lhs
+}
+
+>punk .. Property rhs_air {
+ \\\_
+ \@ >
+ | ~
+ \_- -_/
+ \\
+ / \
+ _+ +_
+}
+>punk .. Property lhs_air {
+ _///
+ < @/
+ ~ |
+ \_- -_/
+ //
+ / \
+ _+ +_
+}
+
+>punk .. Property lhs_hips {
+ _///
+ < @/
+ ~ |
+ _- -_
+ \ | | /
+ / \
+ _+ +_
+}
+>punk .. Property rhs_hips {
+ \\\_
+ \@ >
+ | ~
+ _- -_
+ \ | | /
+ / \
+ _+ +_
+}
+
+
+>punk .. Property piss {
+ \\\_
+ \@ >
+ | ~
+ \_- -_/
+ \\_ ..
+ / \ ..
+ _+ +_ .
+}
+
+>punk .. Property poop {
+ _///
+ < @/
+ ^ |
+ _- -_
+ \ \\ /
+ //. ~
+ _+_+ @
+}
+
+>punk .. Method dumpProperties {{object ::>punk}} {
+ foreach {p v} [$object .. Properties . pairs] {
+ puts $p
+ puts [set $v]
+ puts \n
+ }
+}
+>punk .. Method listProperties {{object ::>punk}} {
+ set result {}
+ foreach {p v} [$object .. Properties . pairs] {
+ lappend result $p [set $v]
+ }
+ return $result
+}
+
+
+##########################################################
+#CANDY-CODE
+#
+#!todo - unset etc.
+if {[info proc ::punk::_unknown] eq ""} {rename unknown ::punk::_unknown}
+
+proc ::punk::var {varname {= {}} args} {
+ if {${=} == "="} {
+ if {[llength $args] > 1} {
+ uplevel 1 [list set $varname [uplevel 1 $args]]
+ } else {
+ uplevel 1 [list set $varname [lindex $args 0]]
+ }
+ } else {
+ uplevel 1 [list set $varname]
+ }
+}
+proc unknown {args} {
+ if {[lindex $args 1] eq "="} {
+ set n [lindex $args 0]
+ set v [lindex $args 2]
+ #uplevel 1 [string map [list @n@ $n @v@ $v] {proc @n@ {= val} {uplevel 1 set @n@ $val}}]
+ uplevel 1 [list interp alias {} $n {} ::punk::var $n]
+
+ #uplevel 1 [list trace add variable $n unset [string map [list @n@ $n] {uplevel 1 [list interp alias {} @n@ {}]}]]
+ uplevel 1 [list trace add variable $n unset [list interp alias {} $n {}]]
+
+ if {[llength $args] > 3} {
+ #RHS consists of multiple args; evaluate
+ return [uplevel 1 [list set $n [uplevel 1 [lrange $args 2 end]]]]
+ } else {
+ #RHS is single arg; treat as value
+ return [uplevel 1 [list set $n $v]]
+ }
+ } else {
+ #delegate to original 'unknown' command
+ uplevel 1 ::punk::_unknown $args
+ }
+}
+
+
+#Cute names for file I/O
+proc <- filename {
+ set fp [open $filename]
+ ::pattern::K [read $fp] [close $fp]
+}
+proc -> {filename string} {
+ set fp [open $filename w]
+ puts $fp $string
+ close $fp
+}
+proc ->> {filename string} {
+ set fp [open $filename a]
+ puts $fp $string
+ close $fp
+}
+
+#presumably this is to allow calling of standard objects using dotted notation?
+::>pattern .. Create ::>
+::> .. Method item {args} {
+ #uplevel #0 $args
+ #uplevel #0 [join $args]
+
+ uplevel #0 $args
+}
+
+#]]>
+#
+#
+#
+#
+#
+
diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm
new file mode 100644
index 00000000..0258fb9f
--- /dev/null
+++ b/src/modules/punk-0.1.tm
@@ -0,0 +1,539 @@
+package provide punk [namespace eval punk {
+ variable version
+ set version 0.1
+}]
+
+namespace eval punk::config {
+ variable loaded
+ variable startup ;#include env overrides
+ variable running
+
+ set vars [list \
+ scriptlib \
+ color_stdout \
+ color_stderr \
+ logfile_stdout \
+ logfile_stderr \
+ syslog_stdout \
+ syslog_stderr \
+ exec_unknown \
+ ]
+ #todo pkg punk::config
+
+ #defaults
+ dict set startup exec_unknown true ;#whether to use exec instead of experimental shellfilter::run
+ dict set startup color_stdout [list cyan bold]
+ dict set startup color_stderr [list red bold]
+ dict set startup syslog_stdout "127.0.0.1:514"
+ dict set startup syslog_stderr "127.0.0.1:514"
+ #default file logs to logs folder at same location as exe if writable, or empty string
+ dict set startup logfile_stdout ""
+ dict set startup logfile_stderr ""
+ set exefolder [file dirname [info nameofexecutable]]
+ set log_folder $exefolder/logs
+ dict set startup scriptlib $exefolder/scriptlib
+ if {[file exists $log_folder]} {
+ if {[file isdirectory $log_folder] && [file writable $log_folder]} {
+ dict set startup logfile_stdout $log_folder/repl-exec-stdout.txt
+ dict set startup logfile_stderr $log_folder/repl-exec-stderr.txt
+ }
+ }
+
+
+ #todo - load/write config file
+
+ #env vars override the configuration
+
+ #todo - define which configvars are settable in env
+ set known_punk_env_vars [list \
+ PUNK_SCRIPTLIB \
+ PUNK_EXECUNKNOWN \
+ PUNK_COLOR_STDERR \
+ PUNK_COLOR_STDOUT \
+ PUNK_LOGFILE_STDOUT \
+ PUNK_LOGFILE_STDERR \
+ PUNK_SYSLOG_STDOUT \
+ PUNK_SYSLOG_STDERR \
+ ]
+
+ #override with env vars if set
+ foreach evar $known_punk_env_vars {
+ if {[info exists ::env($evar)]} {
+ set f [set ::env($evar)]
+ if {$f ne "default"} {
+ #e.g PUNK_SCRIPTLIB -> scriptlib
+ set varname [string tolower [string range $evar 5 end]]
+ dict set startup $varname $f
+ }
+ }
+ }
+
+ set running [dict create]
+ set running [dict merge $running $startup]
+}
+
+namespace eval punk {
+ proc scriptlibpath {{shortname {}} args} {
+ upvar ::punk::config::running running_config
+ set scriptlib [dict get $running_config scriptlib]
+ if {[string match "lib::*" $shortname]} {
+ set relpath [string map [list "lib::" "" "::" "/"] $shortname]
+ set relpath [string trimleft $relpath "/"]
+ set fullpath $scriptlib/$relpath
+ } else {
+ set shortname [string trimleft $shortname "/"]
+ set fullpath $scriptlib/$shortname
+ }
+ return $fullpath
+ }
+
+ #todo - something better - 'previous' rather than reverting to startup
+ proc channelcolors {{onoff {}}} {
+ upvar ::punk::config::running running_config
+ upvar ::punk::config::startup startup_config
+
+ if {![string length $onoff]} {
+ return [list stdout [dict get $running_config color_stdout] stderr [dict get $running_config color_stderr]]
+ } else {
+ set lower_onoff [string tolower $onoff]
+ if {$lower_onoff in [list true on 1]} {
+ dict set running_config color_stdout [dict get $startup_config color_stdout]
+ dict set running_config color_stderr [dict get $startup_config color_stderr]
+ } elseif {$lower_onoff in [list false off 0]} {
+ dict set running_config color_stdout ""
+ dict set running_config color_stderr ""
+ } else {
+ error "channelcolors: invalid value $onoff - expected true|false|on|off|1|0"
+ }
+ }
+ return [list stdout [dict get $running_config color_stdout] stderr [dict get $running_config color_stderr]]
+ }
+ #useful for aliases e.g treemore -> xmore tree
+ proc xmore {args} {
+ {*}$args | more
+ }
+ proc winpath {path} {
+ #convert /c/etc to C:/etc
+ set re {^/([[:alpha:]]){1}/.*}
+
+ set volumes [file volumes]
+ #exclude things like //zipfs:/
+ set driveletters [list]
+ foreach v $volumes {
+ if {[regexp {^([[:alpha:]]){1}:/$} $v _ letter]} {
+ lappend driveletters $letter
+ }
+ }
+ #puts stderr "->$driveletters"
+ if {[regexp $re $path _ letter]} {
+ #upper case appears to be windows canonical form
+ if {[string toupper $letter] in $driveletters} {
+ set path [string toupper $letter]:/[string range $path 3 end]
+ }
+ } elseif {[regexp {^/mnt|MNT/([[:alpha:]]){1}/.*} $path _ letter]} {
+ if {[string toupper $letter] in $driveletters} {
+ set path [string toupper $letter]:/[string range $path 7 end]
+ }
+ }
+ #puts stderr "=> $path"
+ #things like 'which' seem to return a path minus the .exe - so we'll just test the containing folder
+ if {![file exists [file dirname $path]]} {
+ set path [file normalize $path]
+ }
+ return $path
+ }
+ proc windir {path} {
+ return [file dirname [punk::winpath $path]]
+ }
+
+ #-------------------------------------------------------------------
+ #sh 'test' equivalent - to be used with exitcode of process
+ #
+
+ #single evaluation to get exitcode
+ proc sh_test {args} {
+ tailcall run test {*}$args
+ }
+
+
+ #double-evaluation to get true/fals
+ #faster tcl equivalents where possible to accuratley provide, and fallthrough to sh for compatibility of unimplemented
+ #The problem with fallthrough is that sh/bash etc have a different view of existant files
+ #e.g unix files such as /dev/null vs windows devices such as CON,PRN
+ #e.g COM1 is mapped as /dev/ttyS1 in wsl (?)
+ proc sh_TEST {args} {
+ set a1 [lindex $args 0]
+ set a2 [lindex $args 1]
+ set a3 [lindex $args 2]
+ if {[llength $args] == 1} {
+ #equivalent of -n STRING
+ return [expr {[string length $a1] != 0}]
+ } elseif {[llength $args] == 2} {
+ switch -- $a1 {
+ -b {
+ #dubious utility on FreeBSD, windows?
+ #FreeBSD has dropped support for block devices - stating 'No serious applications rely on block devices'
+ #Linux apparently uses them though
+ if{[file exists $a2]} {
+ if {[file type $a2] eq "blockSpecial"} {
+ return true
+ } else {
+ return false
+ }
+ } else {
+ return false
+ }
+ }
+ -c {
+ #e.g on windows CON,NUL
+ if {[file exists $a2]} {
+ if {[file type $a2] eq "characterSpecial"} {
+ return true
+ } else {
+ return false
+ }
+ } else {
+ return false
+ }
+ }
+ -d {
+ return [file isdirectory $a2]
+ }
+ -e {
+ return [file exists $a2]
+ }
+ -f {
+ #e.g on windows CON,NUL
+ if {[file exists $a2]} {
+ if {[file type $a2] eq "file"} {
+ return true
+ } else {
+ return false
+ }
+ } else {
+ return false
+ }
+ }
+ -h -
+ -L {
+ return [expr {[file type $a2] eq "link"}]
+ }
+ -s {
+ if {[file exists $a2] && ([file size $a2] > 0 )} {
+ return true
+ } else {
+ return false
+ }
+ }
+ -S {
+ if {[file exists $a2]} {
+ if {[file type $a2] eq "socket"} {
+ return true
+ } else {
+ return false
+ }
+ } else {
+ return false
+ }
+ }
+ -x {
+ if {[file exists $a2] && [file executable $a2]} {
+ return true
+ } else {
+ return false
+ }
+ }
+ -w {
+ if {[file exists $a2] && [file writable $a2]} {
+ return true
+ } else {
+ return false
+ }
+ }
+ -z {
+ return [expr {[string length $a2] == 0}]
+ }
+ -n {
+ return [expr {[string length $a2] != 0}]
+ }
+ default {
+ tailcall apply {arglist {uplevel #0 [run test {*}$arglist]} ::} $args
+ }
+ }
+ } elseif {[llength $args] == 3} {
+ switch -- $a2 {
+ "=" {
+ return [string equal $a1 $a3]
+ }
+ "!=" {
+ return [expr {$a1 ne $a3}]
+ }
+ "-eq" {
+ if {![string is integer -strict $a1]} {
+ puts stderr "sh_TEST: invalid integer '$a1'"
+ return false
+ }
+ if {![string is integer -strict $a3]} {
+ puts stderr "sh_TEST: invalid integer '$a3'"
+ return false
+ }
+ return [expr {$a1 == $a3}]
+ }
+ "-ge" {
+ return [expr {$a1 >= $a3}]
+ }
+ "-gt" {
+ return [expr {$a1 > $a3}]
+ }
+ "-le" {
+ return [expr {$a1 <= $a3}]
+ }
+ "-lt" {
+ return [expr {$a1 < $a3}]
+ }
+ "-ne" {
+ return [expr {$a1 != $a3}]
+ }
+ default {
+ tailcall apply {arglist {uplevel #0 [run test {*}$arglist]} ::} $args
+ }
+ }
+ } else {
+ tailcall apply {arglist {uplevel #0 [run test {*}$arglist]} ::} $args
+ }
+ }
+ proc sh_echo {args} {
+ tailcall run echo {*}$args
+ }
+ proc sh_ECHO {args} {
+ tailcall apply {arglist {uplevel #0 [run echo {*}$arglist]} ::} $args
+ }
+
+
+ #sh style true/false for process exitcode. 0 is true - everything else false
+ proc exitcode {c} {
+ if {[string is integer -strict $c]} {
+ #return [expr {$c == 0}]
+ #return true/false to make it clearer we are outputting tcl-boolean inverse mapping from the shell style 0=true
+ if {$c == 0} {
+ return true
+ } else {
+ return false
+ }
+ } else {
+ return false
+ }
+ }
+ #-------------------------------------------------------------------
+
+ namespace export help aliases alias cdwin cdwindir winpath windir
+ namespace ensemble create
+
+ #tailcall is important
+ #TODO - fix. conflicts with Tk toplevel command "."
+ proc ./ {args} {
+ set ::punk::last_run_display [list]
+
+ if {([llength $args]) && ([lindex $args 0] eq "")} {
+ set args [lrange $args 1 end]
+ }
+
+
+ if {![llength $args]} {
+ set out [runout -n ls -aFC]
+ #puts stdout $out
+ #puts stderr [a+ white]$out[a+]
+ set result [pwd]
+ set chunklist [list]
+ lappend chunklist [list stderr "[a+ white light]$out[a+]\n"]
+ lappend chunklist [list stdout $result\n]
+ set ::punk::last_run_display $chunklist
+ return $result
+ } else {
+ set a1 [lindex $args 0]
+ if {$a1 in [list . ..]} {
+ if {$a1 eq ".."} {
+ cd $a1
+ }
+ tailcall punk::./ {*}[lrange $args 1 end]
+ }
+ set curdir [pwd]
+ set path $curdir/$a1
+ if {[file type $path] eq "file"} {
+ if {[string tolower [file extension $path]] in [list ".tcl" ".tm"]} {
+ set newargs [lrange $args 1 end]
+ set ::argv0 $path
+ set ::argc [llength $newargs]
+ set ::argv $newargs
+ tailcall source $path
+ } else {
+ puts stderr "Cannot run [file extension $path] file directly ([file tail $path])"
+ return [pwd]
+ }
+ }
+ if {[file type $path] eq "directory"} {
+ cd $path
+ tailcall punk::./ {*}[lrange $args 1 end]
+ }
+ error "Cannot access path $path"
+ }
+ }
+ proc ../ {args} {
+ set ::punk::last_run_display
+ if {![llength $args]} {
+ cd ..
+ } else {
+ cd ../[file join {*}$args]
+ }
+ set out [runout -n ls -aFC]
+ set result [pwd]
+ #return $out\n[pwd]
+ set chunklist [list]
+ lappend chunklist [list stderr "[a+ white light]$out[a+]\n"]
+ lappend chunklist [list stdout $result\n]
+ set ::punk::last_run_display $chunklist
+ return $result
+ }
+ proc ls {args} {
+ if {![llength $args]} {
+ set args [list [pwd]]
+ }
+ if {[llength $args] ==1} {
+ return [glob -nocomplain -tails -dir [lindex $args 0] *]
+ } else {
+ set result [dict create]
+ foreach a $args {
+ set k [file normalize $a]
+ set contents [glob -nocomplain -tails -dir $a *]
+ dict set result $k $contents
+ }
+ return $result
+ }
+ }
+ proc cdwin {path} {
+ set path [punk::winpath $path]
+ cd $path
+ }
+ proc cdwindir {path} {
+ set path [punk::winpath $path]
+ cd [file dirname $path]
+ }
+
+ #return list of {chan chunk} elements
+ proc help_chunks {} {
+ set chunks [list]
+ set linesep [string repeat - 76]
+ catch {
+ package require patternpunk
+ #puts -nonewline stderr [>punk . rhs]
+ lappend chunks [list stderr [>punk . rhs]]
+ }
+ set text ""
+ set known $::punk::config::known_punk_env_vars
+ append text $linesep\n
+ append text "punk environment vars:\n"
+ append text $linesep\n
+ set col1 [string repeat " " 25]
+ set col2 [string repeat " " 50]
+ foreach v $known {
+ set c1 [overtype::left $col1 $v]
+ if {[info exists ::env($v)]} {
+ set c2 [overtype::left $col2 [set ::env($v)]
+ } else {
+ set c2 [overtype::right $col2 "(NOT SET)"]
+ }
+ append text "$c1 $c2\n"
+ }
+ append text $linesep\n
+ lappend chunks [list stdout $text]
+
+ set text ""
+ append text "Punk commands:\n"
+ append text "punk help\n"
+ lappend chunks [list stdout $text]
+ return $chunks
+ }
+ proc help {} {
+ set chunks [help_chunks]
+ foreach chunk $chunks {
+ lassign $chunk chan text
+ puts -nonewline $chan $text
+ }
+ }
+ #current interp aliases except those created by pattern package '::p::*'
+ proc aliases {{glob *}} {
+ set interesting [lmap a [interp aliases ""] {expr {![string match ::p::* $a] ? $a : [continue]}}]
+ set matched [lsearch -all -inline $interesting $glob]
+ }
+ proc alias {a args} {
+ if {[llength $args]} {
+ if {$a in [interp aliases ""]} {
+ set existing [interp alias "" $a]
+ puts stderr "Overwriting existing alias $a -> $existing with $a -> $args (in current session only)"
+ }
+ interp alias "" $a "" {*}$args
+ } else {
+ return [interp alias "" $a]
+ }
+ }
+
+ #sh style 'test' and 'exitcode' (0 is false)
+ interp alias {} sh_test {} punk::sh_test
+ interp alias {} sh_echo {} punk::sh_echo
+ interp alias {} sh_TEST {} punk::sh_TEST
+ interp alias {} sh_ECHO {} punk::sh_ECHO
+
+
+ interp alias {} exitcode {} punk::exitcode
+
+
+ #friendly sh aliases (which user may wish to disable e.g if conflicts)
+ interp alias {} test {} punk::sh_test ;#not much reason to run 'test' directly in punk shell (or tclsh shell) as returncode not obvious anyway due to use of exec
+ interp alias {} TEST {} punk::sh_TEST; #double-evaluation to return tcl true/false from exitcode
+ interp alias {} echo {} punk::sh_echo
+ interp alias {} ECHO {} punk::sh_ECHO
+
+ interp alias {} c {} clear
+ interp alias {} a+ {} shellfilter::ansi::+
+ interp alias {} run {} shellrun::run
+ interp alias {} runout {} shellrun::runout
+ interp alias {} runerr {} shellrun::runerr
+ interp alias {} runx {} shellrun::runx
+
+ interp alias {} help {} punk help
+ interp alias {} aliases {} punk aliases
+ interp alias {} alias {} punk alias
+ interp alias {} treemore {} punk::xmore tree
+ #----------------------------------------------
+ #leave the winpath related aliases available on all platforms
+ interp alias {} cdwin {} punk cdwin
+ interp alias {} cdwindir {} punk cdwindir
+ interp alias {} winpath {} punk winpath
+ interp alias {} windir {} punk windir
+ #----------------------------------------------
+ #git
+ interp alias {} gs {} git status
+ interp alias {} gl {} git log --oneline --decorate ;#decorate so stdout consistent with what we see on console
+
+ #----------------------------------------------
+ interp alias {} l {} ls -aFC ;#wide listing ()
+ interp alias {} ll {} ls -laFo --color=always
+ interp alias {} lw {} ls -aFv --color=always
+ interp alias {} ./ {} punk::./
+ interp alias {} ../ {} punk::../
+ if {$::tcl_platform(platform) eq "windows"} {
+ set has_powershell 1
+ interp alias {} dl {} dir /q
+ interp alias {} dw {} dir /W/D
+ } else {
+ #todo - natsorted equivalent
+ #interp alias {} dl {}
+ #todo - powershell detection on other platforms
+ set has_powershell 0
+ }
+ if {$has_powershell} {
+ interp alias {} psls {} pwsh -nop -nolo -c ls
+ interp alias {} psps {} pwsh -nop -nolo -c ps
+ }
+
+}
diff --git a/src/modules/shellfilter-0.1.8.tm b/src/modules/shellfilter-0.1.8.tm
index 1bd3b766..ec97f3ff 100644
--- a/src/modules/shellfilter-0.1.8.tm
+++ b/src/modules/shellfilter-0.1.8.tm
@@ -184,12 +184,18 @@ namespace eval shellfilter::chan {
variable o_datavar
variable o_trecord
variable o_enc
+ variable o_is_junction
constructor {tf} {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
set settingsdict [dict get $tf -settings]
set varname [dict get $settingsdict -varname]
set o_datavar $varname
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
+ } else {
+ set o_is_junction 1 ;# as a var is diversionary - default it to be a jucntion
+ }
}
method initialize {ch mode} {
return [list initialize finalize write]
@@ -210,7 +216,7 @@ namespace eval shellfilter::chan {
return ""
}
method meta_is_redirection {} {
- return 1
+ return $o_is_junction
}
method meta_buffering_supported {} {
return [list line full none]
@@ -227,6 +233,7 @@ namespace eval shellfilter::chan {
variable o_postlines
variable o_postcountdown
variable o_enc
+ variable o_is_junction
constructor {tf} {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
@@ -239,6 +246,11 @@ namespace eval shellfilter::chan {
set o_grepfor [dict get $settings -grep]
set o_prelines [dict get $settings -pre]
set o_postlines [dict get $settings -post]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
+ } else {
+ set o_is_junction 0
+ }
}
method initialize {transform_handle mode} {
return [list initialize finalize write]
@@ -278,7 +290,7 @@ namespace eval shellfilter::chan {
return $bytes
}
method meta_is_redirection {} {
- return 0
+ return $o_is_junction
}
method meta_buffering_supported {} {
return [list line]
@@ -286,15 +298,21 @@ namespace eval shellfilter::chan {
}
oo::class create tee_to_var {
- variable o_datavar
+ variable o_datavars
variable o_trecord
variable o_enc
+ variable o_is_junction
constructor {tf} {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
set settingsdict [dict get $tf -settings]
set varname [dict get $settingsdict -varname]
- set o_datavar $varname
+ set o_datavars $varname
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
+ } else {
+ set o_is_junction 0
+ }
}
method initialize {ch mode} {
return [list initialize finalize write]
@@ -311,11 +329,13 @@ namespace eval shellfilter::chan {
#}
method write {ch bytes} {
set stringdata [encoding convertfrom $o_enc $bytes]
- append $o_datavar $stringdata
+ foreach v $o_datavars {
+ append $v $stringdata
+ }
return $bytes
}
method meta_is_redirection {} {
- return 0
+ return $o_is_junction
}
}
oo::class create tee_to_pipe {
@@ -323,6 +343,7 @@ namespace eval shellfilter::chan {
variable o_localchan
variable o_enc
variable o_trecord
+ variable o_is_junction
constructor {tf} {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
@@ -332,6 +353,11 @@ namespace eval shellfilter::chan {
}
set o_localchan [dict get $settingsdict -pipechan]
set o_logsource [dict get $settingsdict -tag]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
+ } else {
+ set o_is_junction 0
+ }
}
method initialize {transform_handle mode} {
return [list initialize read write finalize]
@@ -358,7 +384,7 @@ namespace eval shellfilter::chan {
}
#a tee is not a redirection - because data still flows along the main path
method meta_is_redirection {} {
- return 0
+ return $o_is_junction
}
}
@@ -367,6 +393,7 @@ namespace eval shellfilter::chan {
variable o_logsource
variable o_trecord
variable o_enc
+ variable o_is_junction
constructor {tf} {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
@@ -376,6 +403,11 @@ namespace eval shellfilter::chan {
}
set o_logsource [dict get $settingsdict -tag]
set o_tid [::shellfilter::log::open $o_logsource $settingsdict]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
+ } else {
+ set o_is_junction 0
+ }
}
method initialize {ch mode} {
return [list initialize read write finalize]
@@ -399,7 +431,7 @@ namespace eval shellfilter::chan {
return $bytes
}
method meta_is_redirection {} {
- return 0
+ return $o_is_junction
}
}
@@ -463,9 +495,15 @@ namespace eval shellfilter::chan {
oo::class create ansistrip {
variable o_trecord
variable o_enc
+ variable o_is_junction
constructor {tf} {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
+ } else {
+ set o_is_junction 0
+ }
}
method initialize {transform_handle mode} {
return [list initialize read write finalize]
@@ -486,10 +524,8 @@ namespace eval shellfilter::chan {
return [encoding convertto $o_enc $outstring]
#return [encoding convertto unicode $outstring]
}
- }
- oo::define ansistrip {
method meta_is_redirection {} {
- return 0
+ return $o_is_junction
}
}
@@ -550,8 +586,8 @@ namespace eval shellfilter::chan {
set o_do_colour ""
set o_do_normal ""
}
- if {[dict exists $settingsdict -junction]} {
- set o_is_junction [dict get $settingsdict -junction]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
} else {
set o_is_junction 0
}
@@ -623,8 +659,8 @@ namespace eval shellfilter::chan {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
set settingsdict [dict get $tf -settings]
- if {[dict exists $settingsdict -junction]} {
- set o_is_junction [dict get $settingsdict -junction]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
} else {
set o_is_junction 0
}
@@ -684,8 +720,8 @@ namespace eval shellfilter::chan {
set o_trecord $tf
set o_enc [dict get $tf -encoding]
set settingsdict [dict get $tf -settings]
- if {[dict exists $settingsdict -junction]} {
- set o_is_junction [dict get $settingsdict -junction]
+ if {[dict exists $tf -junction]} {
+ set o_is_junction [dict get $tf -junction]
} else {
set o_is_junction 0
}
diff --git a/src/modules/shellrun-0.1.tm b/src/modules/shellrun-0.1.tm
new file mode 100644
index 00000000..13e8b43e
--- /dev/null
+++ b/src/modules/shellrun-0.1.tm
@@ -0,0 +1,377 @@
+# vim: set ft=tcl
+#
+package provide shellrun [namespace eval shellrun {
+ variable version
+ set version 0.1
+}]
+#purpose: handle the run commands that call shellfilter::run
+#e.g run,runout,runerr,runx
+
+
+
+#NOTE: the run,runout,runerr,runx commands only produce an error if the command didn't run.
+# - If it did run, but there was a non-zero exitcode it is up to the application to check that.
+#This is deliberate, but means 'catch' doesn't catch errors within the command itself - the exitcode has to be checked.
+#The user can always use exec for different process error semantics (they don't get exitcode with exec)
+
+namespace eval shellrun {
+ variable runout
+ variable runerr
+
+
+ proc run {args} {
+ set ::punk::last_run_display [list]
+ #we provide -nonewline for 'run' even though run doesn't deliver stderr or stdout to the tcl return value
+ #This is for compatibility with other runX commands, and the difference is also visible when calling from repl.
+ set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
+ set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
+ set runopts [list]
+ set cmdargs [list]
+ set idx_first_cmdarg [lsearch -not $args "-*"]
+ set runopts [lrange $args 0 $idx_first_cmdarg-1]
+ set cmdargs [lrange $args $idx_first_cmdarg end]
+ foreach o $runopts {
+ if {$o ni $known_runopts} {
+ error "run: Unknown runoption $o"
+ }
+ }
+ set runopts [lmap o $runopts {dict get $aliases $o}]
+ if {"-nonewline" in $runopts} {
+ set nonewline 1
+ } else {
+ set nonewline 0
+ }
+
+ set id_err [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}]
+ set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ]
+ shellfilter::stack::remove stderr $id_err
+
+ flush stderr
+ flush stdout
+
+ set c [shellfilter::ansi::+ green]
+ set n [shellfilter::ansi::+]
+ if {[dict exists $exitinfo error]} {
+ error [dict get $exitinfo error]
+ }
+
+ return $exitinfo
+ }
+
+ proc runout {args} {
+ set ::punk::last_run_display [list]
+ variable runout
+ variable runerr
+ set runout ""
+ set runerr ""
+
+ set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
+ set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
+ set runopts [list]
+ set cmdargs [list]
+ set idx_first_cmdarg [lsearch -not $args "-*"]
+ set runopts [lrange $args 0 $idx_first_cmdarg-1]
+ set cmdargs [lrange $args $idx_first_cmdarg end]
+ foreach o $runopts {
+ if {$o ni $known_runopts} {
+ error "runout: Unknown runoption $o"
+ }
+ }
+ set runopts [lmap o $runopts {dict get $aliases $o}]
+ if {"-nonewline" in $runopts} {
+ set nonewline 1
+ } else {
+ set nonewline 0
+ }
+
+ #puts stdout "RUNOUT cmdargs: $cmdargs"
+
+ #todo add -data boolean and -data lastwrite to -settings with default being -data all
+ # because sometimes we're only interested in last char (e.g to detect something was output)
+
+ #set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}]
+ #
+ #when not echoing - use float-locked so that the repl's stack is bypassed
+ if {"-echo" in $runopts} {
+ set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}]
+ set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}]
+ #set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}]
+ } else {
+ set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}]
+ set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}]
+ }
+
+ #shellfilter::run [lrange $args 1 end] -teehandle punk -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler
+ set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ]
+
+ flush stderr
+ flush stdout
+
+ shellfilter::stack::remove stdout $stdout_stackid
+ shellfilter::stack::remove stderr $stderr_stackid
+
+ #shellfilter::stack::remove commandout $outvar_stackid
+ if {[dict exists $exitinfo error]} {
+ #we must raise an error.
+ #todo - check errorInfo makes sense.. return -code? tailcall?
+ error [dict get $exitinfo error]
+ }
+
+ set chunklist [list]
+
+ set n [a+]
+ set c ""
+ if [dict exists $exitinfo exitcode] {
+ set code [dict get $exitinfo exitcode]
+ if {$code == 0} {
+ set c [a+ green]
+ } else {
+ set c [a+ white bold]
+ }
+ } else {
+ set c [a+ Yellow red bold]
+ }
+ #exitcode not part of return value for runout - colourcode appropriately
+ lappend chunklist [list stderr "$c$exitinfo$n\n"]
+
+
+ set chunk "[a+ red bold]stderr[a+]\n"
+ if {[string length $::shellrun::runerr]} {
+ if {$nonewline} {
+ set e [string trimright $::shellrun::runerr \r\n]
+ } else {
+ set e $::shellrun::runerr
+ }
+ append chunk "$e\n"
+ }
+ lappend chunklist [list stderr $chunk]
+
+
+
+
+ lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"]
+ set chunk ""
+ if {[string length $::shellrun::runout]} {
+ if {$nonewline} {
+ set o [string trimright $::shellrun::runout \r\n]
+ } else {
+ set o $::shellrun::runout
+ }
+ append chunk "$o\n" ;#this newline is the display output separator - always there whether data has trailing newline or not.
+ }
+ lappend chunklist [list stdout $chunk]
+
+
+ set ::punk::last_run_display $chunklist
+
+ if {$nonewline} {
+ return [string trimright $::shellrun::runout \r\n]
+ } else {
+ return $::shellrun::runout
+ }
+ }
+
+ proc runerr {args} {
+ set ::punk::last_run_display [list]
+ variable runout
+ variable runerr
+ set runout ""
+ set runerr ""
+ set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
+ set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
+ set runopts [list]
+ set cmdargs [list]
+ set idx_first_cmdarg [lsearch -not $args "-*"]
+ set runopts [lrange $args 0 $idx_first_cmdarg-1]
+ set cmdargs [lrange $args $idx_first_cmdarg end]
+ foreach o $runopts {
+ if {$o ni $known_runopts} {
+ error "runerr: Unknown runoption $o"
+ }
+ }
+ set runopts [lmap o $runopts {dict get $aliases $o}]
+ if {"-nonewline" in $runopts} {
+ set nonewline 1
+ } else {
+ set nonewline 0
+ }
+
+ if {"-echo" in $runopts} {
+ set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}]
+ set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}]
+ } else {
+ set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}]
+ set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}]
+ }
+
+
+ set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler]
+ shellfilter::stack::remove stderr $stderr_stackid
+ shellfilter::stack::remove stdout $stdout_stackid
+
+
+ flush stderr
+ flush stdout
+
+ #we raise an error because an error during calling is different to collecting stderr from a command, and the caller should be able to wrap in a catch
+ # to determine something other than just a nonzero exit code or output on stderr.
+ if {[dict exists $exitinfo error]} {
+ #todo - check errorInfo makes sense.. return -code? tailcall?
+ error [dict get $exitinfo error]
+ }
+
+ set chunklist [list]
+
+ set n [a+]
+ set c ""
+ if [dict exists $exitinfo exitcode] {
+ set code [dict get $exitinfo exitcode]
+ if {$code == 0} {
+ set c [a+ green]
+ } else {
+ set c [a+ white bold]
+ }
+ } else {
+ set c [a+ Yellow red bold]
+ }
+ #exitcode not part of return value for runout - colourcode appropriately
+ lappend chunklist [list stderr "$c$exitinfo$n\n"]
+
+
+ lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"]
+ set chunk ""
+ if {[string length $::shellrun::runout]} {
+ if {$nonewline} {
+ set o [string trimright $::shellrun::runout \r\n]
+ } else {
+ set o $::shellrun::runout
+ }
+ append chunk "$o\n" ;#this newline is the display output separator - always there whether data has trailing newline or not.
+ }
+ lappend chunklist [list stdout $chunk]
+
+
+
+ set chunk "[a+ red bold]stderr[a+]\n"
+ if {[string length $::shellrun::runerr]} {
+ if {$nonewline} {
+ set e [string trimright $::shellrun::runerr \r\n]
+ } else {
+ set e $::shellrun::runerr
+ }
+ append chunk "$e\n"
+ }
+ lappend chunklist [list stderr $chunk]
+
+
+ set ::punk::last_run_display $chunklist
+
+ if {$nonewline} {
+ return [string trimright $::shellrun::runerr \r\n]
+ }
+ return $::shellrun::runerr
+ }
+
+ proc runx {args} {
+ set ::punk::last_run_display [list]
+ variable last_run_display
+ variable runout
+ variable runerr
+ set runout ""
+ set runerr ""
+
+ set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
+ set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
+ set runopts [list]
+ set cmdargs [list]
+ set idx_first_cmdarg [lsearch -not $args "-*"]
+ set runopts [lrange $args 0 $idx_first_cmdarg-1]
+ set cmdargs [lrange $args $idx_first_cmdarg end]
+ foreach o $runopts {
+ if {$o ni $known_runopts} {
+ error "runx: Unknown runoption $o - known options $known_runopts"
+ }
+ }
+ set runopts [lmap o $runopts {dict get $aliases $o}]
+ if {"-nonewline" in $runopts} {
+ set nonewline 1
+ } else {
+ set nonewline 0
+ }
+
+
+
+ #shellfilter::stack::remove stdout $::repl::id_outstack
+
+ if {"-echo" in $runopts} {
+ set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}]
+ set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::shellrun::runout}]
+ } else {
+ #set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::shellrun::runerr}]
+ #set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::shellrun::runout}]
+
+ #float above the repl's tee_to_var to deliberately block it.
+ #a var transform is naturally a junction point because there is no flow-through..
+ # - but mark it with -junction 1 just to be explicit
+ set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -junction 1 -settings {-varname ::shellrun::runerr}]
+ set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -junction 1 -settings {-varname ::shellrun::runout}]
+ }
+
+ #set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler]
+ set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none]
+
+ shellfilter::stack::remove stdout $stdout_stackid
+ shellfilter::stack::remove stderr $stderr_stackid
+
+
+ flush stderr
+ flush stdout
+
+
+ #set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}]
+ set chunklist [list]
+ lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"]
+
+ set chunk ""
+ if {[string length $::shellrun::runout]} {
+ append chunk "$::shellrun::runout\n"
+ }
+ lappend chunklist [list stdout $chunk]
+
+
+ set chunk "[a+ red bold]stderr[a+]\n"
+ if {[string length $::shellrun::runerr]} {
+ append chunk "$::shellrun::runerr\n"
+ }
+ lappend chunklist [list stderr $chunk]
+
+
+
+ set n [a+]
+ set c ""
+ if [dict exists $exitinfo exitcode] {
+ set code [dict get $exitinfo exitcode]
+ if {$code == 0} {
+ set c [a+ green]
+ } else {
+ set c [a+ white bold]
+ }
+ }
+ lappend chunklist [list stderr "$c$exitinfo$n\n"]
+
+ set ::punk::last_run_display $chunklist
+
+ #set ::repl::result_print 0
+ #return [lindex [list [list stdout $::runout stderr $::runerr {*}$exitinfo] [shellfilter::stack::remove stdout $x][puts -nonewline stdout $pretty][set ::repl::output ""]] 0]
+
+
+ if {[dict exists $exitinfo error]} {
+ #todo - check errorInfo makes sense.. return -code? tailcall?
+ error [dict get $exitinfo error]
+ }
+ if {$nonewline} {
+ return [list stdout [string trimright $::shellrun::runout \r\n] stderr [string trimright $::shellrun::runerr \r\n] {*}$exitinfo]
+ }
+ return [list stdout $::shellrun::runout stderr $::shellrun::runerr {*}$exitinfo]
+ }
+}
diff --git a/src/punk86.vfs/lib/app-punk/repl.tcl b/src/punk86.vfs/lib/app-punk/repl.tcl
index b7271e12..8219c808 100644
--- a/src/punk86.vfs/lib/app-punk/repl.tcl
+++ b/src/punk86.vfs/lib/app-punk/repl.tcl
@@ -1,7 +1,7 @@
#temp
package provide app-punk 1.0
-namespace eval punk {
+namespace eval punkrepl {
}
@@ -38,170 +38,18 @@ if {![info exists ::env(TERM)]} {
-namespace eval punk {
- set syslog_stdout "127.0.0.1:514"
- set syslog_stderr "127.0.0.1:514"
-
- #default file logs to logs folder at same location as exe if writable, or empty string
- set logfile_stdout ""
- set logfile_stderr ""
- set exefolder [file dirname [info nameofexecutable]]
- set logfolder $exefolder/logs
- if {[file exists $logfolder]} {
- if {[file isdirectory $logfolder] && [file writable $logfolder]} {
- set logfile_stdout $logfolder/repl-exec-stdout.txt
- set logfile_stderr $logfolder/repl-exec-stderr.txt
- }
- }
-
-
- #override with env vars if set
- if {[info exists ::env(PUNK_LOGFILE_STDOUT)]} {
- set f $::env(PUNK_LOGFILE_STDOUT)
- if {$f ne "default"} {
- set logfile_stdout $f
- }
- }
- if {[info exists ::env(PUNK_LOGFILE_STDERR)]} {
- set f $::env(PUNK_LOGFILE_STDERR)
- if {$f ne "default"} {
- set logfile_stderr $f
- }
- }
- if {[info exists ::env(PUNK_SYSLOG_STDOUT)]} {
- set u $::env(PUNK_SYSLOG_STDOUT)
- if {$u ne "default"} {
- set syslog_stdout $u
- }
- }
- if {[info exists ::env(PUNK_SYSLOG_STDERR)]} {
- set u $::env(PUNK_SYSLOG_STDERR)
- if {$u ne "default"} {
- set syslog_stderr $u
- }
- }
- catch {
- unset u
- unset f
- }
-
- #useful for aliases e.g treemore -> xmore tree
- proc xmore {args} {
- {*}$args | more
- }
- proc winpath {path} {
- #convert /c/etc to C:/etc
- set re {^/([[:alpha:]]){1}/.*}
-
- set volumes [file volumes]
- #exclude things like //zipfs:/
- set driveletters [list]
- foreach v $volumes {
- if {[regexp {^([[:alpha:]]){1}:/$} $v _ letter]} {
- lappend driveletters $letter
- }
- }
- #puts stderr "->$driveletters"
- if {[regexp $re $path _ letter]} {
- #upper case appears to be windows canonical form
- if {[string toupper $letter] in $driveletters} {
- set path [string toupper $letter]:/[string range $path 3 end]
- }
- } elseif {[regexp {^/mnt|MNT/([[:alpha:]]){1}/.*} $path _ letter]} {
- if {[string toupper $letter] in $driveletters} {
- set path [string toupper $letter]:/[string range $path 7 end]
- }
- }
- #puts stderr "=> $path"
- #things like 'which' seem to return a path minus the .exe - so we'll just test the containing folder
- if {![file exists [file dirname $path]]} {
- set path [file normalize $path]
- }
- return $path
- }
- proc windir {path} {
- return [file dirname [punk::winpath $path]]
- }
-
-
- namespace export help aliases alias cdwin cdwindir winpath windir
- namespace ensemble create
-
-
- proc cdwin {path} {
- set path [punk::winpath $path]
- cd $path
- }
- proc cdwindir {path} {
- set path [punk::winpath $path]
- cd [file dirname $path]
- }
- proc help {} {
- catch {
- package require patternpunk
- puts -nonewline stderr [>punk . rhs]
- }
- puts stdout "Punk commands:"
- puts stdout "punk help"
- }
- #current interp aliases except those created by pattern package '::p::*'
- proc aliases {{glob *}} {
- set interesting [lmap a [interp aliases ""] {expr {![string match ::p::* $a] ? $a : [continue]}}]
- }
- proc alias {a args} {
- if {[llength $args]} {
- if {$a in [interp aliases ""]} {
- set existing [interp alias "" $a]
- puts stderr "Overwriting existing alias $a -> $existing with $a -> $args (in current session only)"
- }
- interp alias "" $a "" {*}$args
- } else {
- return [interp alias "" $a]
- }
- }
-
-
- #global aliases - keep to a minimum
- interp alias {} help {} punk help
- interp alias {} aliases {} punk aliases
- interp alias {} alias {} punk alias
- interp alias {} treemore {} punk::xmore tree
- #----------------------------------------------
- #leave the winpath related aliases available on all platforms
- interp alias {} cdwin {} punk cdwin
- interp alias {} cdwindir {} punk cdwindir
- interp alias {} winpath {} punk winpath
- interp alias {} windir {} punk windir
- #----------------------------------------------
- interp alias {} ll {} ls -laFo --color=always
- interp alias {} lw {} ls -aFv --color=always
- if {$::tcl_platform(platform) eq "windows"} {
- set has_powershell 1
- interp alias {} dl {} dir /q
- interp alias {} dw {} dir /W/D
- } else {
- #todo - natsorted equivalent
- #interp alias {} dl {}
- #todo - powershell detection on other platforms
- set has_powershell 0
- }
- if {$has_powershell} {
- interp alias {} psls {} pwsh -nop -nolo -c ls
- interp alias {} psps {} pwsh -nop -nolo -c ps
- }
-
-}
+package require shellfilter
+package require shellrun
+package require Thread
+package require punk
-set ::punk::PUNKRUN 0 ;#whether to use shellfilter::run instead of exec.
-package require shellfilter
-package require Thread
-set outdevice [shellfilter::stack::new punkout -settings [list -tag "punkout" -buffering none -raw 1 -syslog $::punk::syslog_stdout -file $::punk::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 errdevice [shellfilter::stack::new punkerr -settings [list -tag "punkerr" -buffering none -raw 1 -syslog $::punk::syslog_stderr -file $::punk::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]]]
set err [dict get $errdevice localchan]
#
#set indevice [shellfilter::stack::new commandin -settings {-tag "commandin" -readbuffering line -writebuffering none -raw 1 -direction in}]
@@ -457,9 +305,11 @@ proc unknown args {
set ::tcl::UnknownResult ""
}
} else {
+
+ #when using exec with >&@stdout (to ensure process is connected to console) - the output unfortunately doesn't go via the shellfilter stacks
set id_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}]
- if {$::punk::PUNKRUN} {
+ if {![dict get $::punk::config::running exec_unknown]} {
uplevel 1 [list ::catch \
[list ::shellfilter::run [concat [list $new] [lrange $args 1 end]] -teehandle punk -inbuffering line -outbuffering none ] \
::tcl::UnknownResult ::tcl::UnknownOptions]
@@ -475,6 +325,10 @@ proc unknown args {
} else {
set redir ">&@stdout <@stdin"
uplevel 1 [list ::catch [concat exec $redir $new [lrange $args 1 end]] ::tcl::UnknownResult ::tcl::UnknownOptions]
+ #we can't detect stdout/stderr output from the exec
+ #for now emit an extra \n on stderr
+ #todo - use console apis (twapi on windows) to detect cursor posn?
+ puts -nonewline stderr \n[a+ green bold]-[a+]
}
@@ -565,6 +419,13 @@ know {[regexp {^([0-9]+)\.\.([0-9]+)$} [lindex $args 0] -> from to]} {
set res
}
+#handle process return dict of form {exitcode num etc blah}
+#exitcode must be the first key
+know {[lindex $args 0 0] eq "exitcode"} {
+ set c [lindex $args 0 1]
+ uplevel 1 [list exitcode $c]
+}
+
#run as raw string instead of tcl-list - no variable subst etc
proc do_runraw {commandline} {
@@ -644,231 +505,10 @@ proc do_runraw {commandline} {
return $exitinfo
}
-#NOTE: the run,runout,runerr,runx commands only produce an error if the command didn't run.
-# - If it did run, but there was a non-zero exitcode it is up to the application to check that.
-#This is deliberate, but means 'catch' doesn't catch errors within the command itself - the exitcode has to be checked.
-#The user can always use exec for different process error semantics (they don't get exitcode with exec)
know {[lindex $args 0] eq "runraw"} {
- return [do_run $args]
-}
-know {[lindex $args 0] eq "run"} {
- set args [lrange $args 1 end]
- set known_runopts [list "-echo" "-e"]
- set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self
- set runopts [list]
- set cmdargs [list]
- set idx_first_cmdarg [lsearch -not $args "-*"]
- set runopts [lrange $args 0 $idx_first_cmdarg-1]
- set cmdargs [lrange $args $idx_first_cmdarg end]
- foreach o $runopts {
- if {$o ni $known_runopts} {
- error "run: Unknown runoption $o"
- }
- }
- set runopts [lmap o $runopts {dict get $aliases $o}]
-
- set id_err [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}]
- set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ]
- shellfilter::stack::remove stderr $id_err
-
- flush stderr
- flush stdout
-
- set c [shellfilter::ansi::+ green]
- set n [shellfilter::ansi::+]
- if {[dict exists $exitinfo error]} {
- error [dict get $exitinfo error]
- }
-
- return $exitinfo
-}
-
-know {[lindex $args 0] eq "runout"} {
- set ::runout ""
-
- set args [lrange $args 1 end]
- set known_runopts [list "-echo" "-e"]
- set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self
- set runopts [list]
- set cmdargs [list]
- set idx_first_cmdarg [lsearch -not $args "-*"]
- set runopts [lrange $args 0 $idx_first_cmdarg-1]
- set cmdargs [lrange $args $idx_first_cmdarg end]
- foreach o $runopts {
- if {$o ni $known_runopts} {
- error "runout: Unknown runoption $o"
- }
- }
- set runopts [lmap o $runopts {dict get $aliases $o}]
-
- #puts stdout "RUNOUT cmdargs: $cmdargs"
-
- #set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}]
- if {"-echo" in $runopts} {
- set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::runout}]
- } else {
- set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::runout}]
- }
-
- #shellfilter::run [lrange $args 1 end] -teehandle punk -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler
- set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ]
-
- shellfilter::stack::remove stdout $stdout_stackid
- #shellfilter::stack::remove commandout $outvar_stackid
- if {[dict exists $exitinfo error]} {
- #we must raise an error.
- #todo - check errorInfo makes sense.. return -code? tailcall?
- error [dict get $exitinfo error]
- }
-
- flush stderr
- flush stdout
-
- set lastoutchar [string range $::repl::output_stdout end-1 end]
-
-
- #exitcode not part of return value - colourcode appropriately
- set n [shellfilter::ansi::+]
- set code [dict get $exitinfo exitcode]
- if {$code == 0} {
- set c [shellfilter::ansi::+ green]
- } else {
- set c [shellfilter::ansi::+ white bold]
- }
- puts stderr $c$exitinfo$n
- return $::runout
+ return [do_runraw $args]
}
-know {[lindex $args 0] eq "runerr"} {
- set ::runerr ""
-
- set args [lrange $args 1 end]
- set known_runopts [list "-echo" "-e"]
- set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self
- set runopts [list]
- set cmdargs [list]
- set idx_first_cmdarg [lsearch -not $args "-*"]
- set runopts [lrange $args 0 $idx_first_cmdarg-1]
- set cmdargs [lrange $args $idx_first_cmdarg end]
- foreach o $runopts {
- if {$o ni $known_runopts} {
- error "runerr: Unknown runoption $o"
- }
- }
- set runopts [lmap o $runopts {dict get $aliases $o}]
-
- if {"-echo" in $runopts} {
- set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::runerr}]
- } else {
- set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::runerr}]
- }
- set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler]
- shellfilter::stack::remove stderr $stderr_stackid
-
-
- flush stderr
- flush stdout
- #we raise an error because an error during calling is different to collecting stderr from a command, and the caller should be able to wrap in a catch
- # to determine something other than just a nonzero exit code or output on stderr.
- if {[dict exists $exitinfo error]} {
- #todo - check errorInfo makes sense.. return -code? tailcall?
- error [dict get $exitinfo error]
- }
-
- #exitcode not part of return value - colourcode appropriately
- set n [shellfilter::ansi::+]
- set code [dict get $exitinfo exitcode]
- if {$code == 0} {
- set c [shellfilter::ansi::+ green]
- } else {
- set c [shellfilter::ansi::+ white bold]
- }
- puts stderr \n$c$exitinfo$n
- return $::runerr
-}
-know {[lindex $args 0] eq "runx"} {
- set ::runerr ""
- set ::runout ""
-
- set args [lrange $args 1 end]
- set known_runopts [list "-echo" "-e"]
- set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self
- set runopts [list]
- set cmdargs [list]
- set idx_first_cmdarg [lsearch -not $args "-*"]
- set runopts [lrange $args 0 $idx_first_cmdarg-1]
- set cmdargs [lrange $args $idx_first_cmdarg end]
- foreach o $runopts {
- if {$o ni $known_runopts} {
- error "runx: Unknown runoption $o"
- }
- }
- set runopts [lmap o $runopts {dict get $aliases $o}]
-
-
-
- #shellfilter::stack::remove stdout $::repl::id_outstack
-
- if {"-echo" in $runopts} {
- set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::runerr}]
- set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::runout}]
- } else {
- set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::runerr}]
- set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::runout}]
- }
-
- set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler]
-
- shellfilter::stack::remove stdout $stdout_stackid
- shellfilter::stack::remove stderr $stderr_stackid
-
- set ::repl::output ""
-
- flush stderr
- flush stdout
-
- #set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}]
- set pretty ""
- append pretty "stdout\n"
- if {[string length $::runout]} {
- append pretty "$::runout\n"
- }
- append pretty "stderr\n"
- if {[string length $::runerr]} {
- append pretty "$::runerr\n"
- }
- set n [shellfilter::ansi::+]
- set c ""
- if [dict exists $exitinfo exitcode] {
- set code [dict get $exitinfo exitcode]
- if {$code == 0} {
- set c [shellfilter::ansi::+ green]
- } else {
- set c [shellfilter::ansi::+ white bold]
- }
- }
- append pretty "$c$exitinfo$n"
- #set ::repl::result_print 0
- #return [lindex [list [list stdout $::runout stderr $::runerr {*}$exitinfo] [shellfilter::stack::remove stdout $x][puts -nonewline stdout $pretty][set ::repl::output ""]] 0]
-
- set ::repl::result_pretty $pretty
-
- if {[dict exists $exitinfo error]} {
- #todo - check errorInfo makes sense.. return -code? tailcall?
- error [dict get $exitinfo error]
- }
-
-
- return [list stdout $::runout stderr $::runerr {*}$exitinfo]
-
-
- #return [string map [list %o% [list $::runout] %e% [list $::runerr] %x% $exitinfo] {stdout\
- # %o%\
- # stderr\
- # %e%\
- # %x%\
- #}]
-}
}
namespace eval repl {
variable output ""
@@ -936,12 +576,14 @@ proc repl::reopen_stdin {} {
#review/test
set s [open "/dev/tty" r]
}
-
repl::start stdin
}
+
proc quit {} {
set ::repl::done "quit"
+ 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
@@ -1008,8 +650,8 @@ proc repl::repl_handler {chan} {
variable reading
variable post_script
variable id_outstack
- variable result_print
- variable result_pretty
+ upvar ::punk::last_run_display last_run_display
+ upvar ::punk::config::running running_config
set chunksize [gets $chan line]
if {$chunksize < 0} {
if {[chan eof $chan]} {
@@ -1029,15 +671,20 @@ proc repl::repl_handler {chan} {
if {[info complete $command]} {
set ::repl::output_stdout ""
set ::repl::output_stderr ""
+ set outstack [list]
set errstack [list]
- set id_outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output_stdout}]
- lappend errstack [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}]
+ if {[string length [dict get $running_config color_stdout]]} {
+ 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]]} {
+ lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]]
+ }
+
lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::repl::output_stderr}]
#chan configure stdout -buffering none
fileevent $chan readable {}
set reading 0
- set result_print 1
- set result_pretty ""
#don't let unknown use 'args' to convert command to list
if {[string equal -length [string length "runraw "] "runraw " $command]} {
@@ -1047,29 +694,42 @@ proc repl::repl_handler {chan} {
set status [catch {uplevel #0 $command} result]
}
- #puts stderr "