diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm
index 8126b318..045697bf 100644
--- a/src/modules/punk-0.1.tm
+++ b/src/modules/punk-0.1.tm
@@ -4,6 +4,37 @@ package provide punk [namespace eval punk {
set version 0.1
}]
+#globals... some minimal global var pollution
+set punk_testd [dict create \
+ a0 a0val \
+ b0 [dict create \
+ a1 b0a1val \
+ b1 b0b1val \
+ c1 b0c1val \
+ d1 b0d1val \
+ ]\
+ c0 [dict create \
+ a1 [dict create \
+ a2 c0a1a2val \
+ b2 c0a1b2val \
+ c2 c0a1c2val \
+ ] \
+ b1 [dict create \
+ a2 [dict create \
+ a3 c0b1a2a3val \
+ b3 c0b1a2b3val \
+ ] \
+ b2 [dict create \
+ a3 c0b1b2a3val \
+ b3 [dict create \
+ a4 c0b1b2b3a4 \
+ ] \
+ c3 [dict create] \
+ ] \
+ ] \
+ ] \
+ ]
+
#cooperative withe punk repl
namespace eval ::repl {
variable running 0
@@ -14,6 +45,7 @@ namespace eval punk::config {
variable running
set vars [list \
+ apps \
scriptlib \
color_stdout \
color_stderr \
@@ -26,6 +58,7 @@ namespace eval punk::config {
#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]
@@ -37,6 +70,7 @@ namespace eval punk::config {
set exefolder [file dirname [info nameofexecutable]]
set log_folder $exefolder/logs
dict set startup scriptlib $exefolder/scriptlib
+ dict set startup apps $exefolder/../punkapps
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
@@ -51,6 +85,7 @@ namespace eval punk::config {
#todo - define which configvars are settable in env
set known_punk_env_vars [list \
+ PUNK_APPS \
PUNK_SCRIPTLIB \
PUNK_EXECUNKNOWN \
PUNK_COLOR_STDERR \
@@ -79,6 +114,7 @@ namespace eval punk::config {
namespace eval punk {
package require pattern
+ package require punkapp
package require funcl
package require control
control::control assert enabled 1
@@ -259,8 +295,226 @@ namespace eval punk {
}
return $varlist
}
+ proc _split_var_key_at_unbracketed_comma {varspecs} {
+ set varlist [list]
+ set var_terminals [list "@" "/" "#"]
+ set in_brackets 0
+ set varspecs [string trimleft $varspecs,]
+ set token ""
+ #if {[string first "," $varspecs] <0} {
+ # return $varspecs
+ #}
+ set first_term -1
+ set token_index 0 ;#index of terminal char within each token
+ foreach c [split $varspecs ""] {
+ if {$in_brackets} {
+ if {$c eq ")"} {
+ set in_brackets 0
+ }
+ append token $c
+ } else {
+ if {$c eq ","} {
+ if {$first_term > -1} {
+ set v [string range $token 0 $first_term-1]
+ set k [string range $token $first_term end] ;#key section includes the terminal char
+ lappend varlist [list $v $k]
+ } else {
+ lappend varlist [list $token ""]
+ }
+ set token ""
+ set token_index -1 ;#reduce by 1 because , not included in next token
+ set first_term -1
+ } else {
+ if {$first_term == -1} {
+ if {$c in $var_terminals} {
+ set first_term $token_index
+ }
+ }
+ append token $c
+ if {$c eq "("} {
+ set in_brackets 1
+ }
+ }
+ }
+ incr token_index
+ }
+ if {[string length $token]} {
+ if {$first_term > -1} {
+ set v [string range $token 0 $first_term-1]
+ set k [string range $token $first_term end] ;#key section includes the terminal char
+ lappend varlist [list $v $k]
+ } else {
+ lappend varlist [list $token ""]
+ }
+ }
+ return $varlist
+ }
+
+ proc destructure {selector data} {
+ set selector [string trim $selector /]
+ upvar v_list_idx v_list_idx ;#positional tracker for /@ - list position
+ upvar v_dict_idx v_dict_idx ;#positional tracker for /@@ - dict position
+
+ set leveldata $data
+ set subindices [split $selector /]
+ set i_keyindex 0
+ set active_key_type ""
+ foreach index $subindices {
+ set assigned ""
+ set get_not 0
+ set already_assigned 0
+
+ if {$index eq "#"} {
+ set active_key_type "list"
+ set assigned [llength $leveldata]
+ set already_assigned 1
+ } elseif {$index eq "##"} {
+ set active_key_type "dict"
+ set assigned [dict size $leveldata]
+ set already_assigned 1
+ } elseif {$index eq "@"} {
+ set active_key_type "list"
+ #e.g @1/1/@/1 the lone @ is a positional spec for this specific subkey
+ #no normalization done - ie @2/@ will not be considered same subkey as @end/@ or @end-0/@ even if llength = 3
+ #while x@,y@.= is reasonably handy - especially for args e.g = 0) ? [list $var $m] : [list $var 0]}}]
- # e.g {a 0} {'b 1'} {c 0} {^x(a,b) 2}
+ #set var_class [lmap var $varspeclist {expr {([set m [lsearch $map [string index $var 0]]] >= 0) ? [list $var $m] : [list $var 0]}}]
+ #puts stdout "\n var_class: $var_class\n"
+ # e.g {a 0} {'b 1} {c 0} {^x(a,b) 2}
+
+ set var_class [lmap var $varkeylist {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}]
+ #puts stdout "\n var_class: $var_class\n"
#raw varspecs without pin/atom modifiers
- set varspecs_trimmed [lmap varinfo $var_class {expr {([lindex $varinfo 1] > 0) ? [string range [lindex $varinfo 0] 1 end] : [lindex $varinfo 0]}}]
+ #set varspecs_trimmed [lmap varinfo $var_class {expr {([lindex $varinfo 1] > 0) ? [string range [lindex $varinfo 0] 1 end] : [lindex $varinfo 0]}}]
+ #puts stdout "\n varspecs_trimmed: $varspecs_trimmed\n"
+
+
+ set varspecs_trimmed [lmap varinfo $var_class {expr {([lindex $varinfo 1] > 0) ? [list [string range [lindex $varinfo 0 0] 1 end] [lindex $varinfo 0 1]] : [lindex $varinfo 0]}}]
+ #puts stdout "\n varspecs_trimmed: $varspecs_trimmed\n"
+
#var names (possibly empty portion to the left of )
- set var_names [lmap v $varspecs_trimmed {expr {([set p [string first @ $v]] >= 0) ? [string range $v 0 $p-1] : $v}}]
+ #set var_names [lmap v $varspecs_trimmed {expr {([set p [string first @ $v]] >= 0) ? [string range $v 0 $p-1] : $v}}]
+ set var_names [lmap v $varspecs_trimmed {lindex $v 0}]
+ #puts stdout "\nvar_names: $var_names\n"
- set v_list_idx 0 ;#for vars with single @ only
+ set v_list_idx(@) 0 ;#for spec with single @ only
+ set v_dict_idx(@@) 0 ;#for spec with @@ only
#jn
- #member lists of returndict which will be apppended to in the initial value-retrieving loop
+ #member lists of returndict which will be appended to in the initial value-retrieving loop
set returndict_setvars [dict get $returndict setvars]
set returndict_unsetvars [dict get $returndict unsetvars]
@@ -349,14 +618,19 @@ namespace eval punk {
#
# In this loop we don't set or unset variables - but assign an action entry in var_actions - all with leading question mark.
# as well as adding the data values to the var_actions list
- foreach vspec $varspecs_trimmed {
+ foreach v_and_key $varspecs_trimmed {
+ set vspec [join $v_and_key ""]
+ lassign $v_and_key v vkey
+
set assigned ""
- set firstat [string first "@" $vspec]
+ #The binding spec begins at first @ or # or /
+ set firstat [string first "@" $vkey]
+
#set firstq [string first "'" $vspec]
- set v [lindex $var_names $i]
+ #set v [lindex $var_names $i]
#if v contains any * and/or ? - then it is a glob match - not a varname
- if {$firstat >= 0} {
+ if {[string length $vkey]} {
#if {[string is integer -strict $v]} {
# lset var_actions $i 1 matchatom
#}
@@ -379,112 +653,162 @@ namespace eval punk {
- set after_first_at [string range $vspec $firstat+1 end]
- if {$after_first_at eq ""} {
- #no dict key following @, this is a positional spec
- set assigned [lindex $data $v_list_idx]
+ set after_first_at [string range $vkey $firstat+1 end]
+
+ set vkey [string trimleft $vkey /]
+ if {$vkey eq "@"} {
+ #no dict key following @, this is a positional spec for list
+ set assigned [lindex $data $v_list_idx(@)]
lset var_actions $i 1 ?set
lset var_actions $i 2 $assigned
#if {[string length $v]} {
# uplevel $lvlup [list set $v $assigned]
#}
- incr v_list_idx ;#only incr each time we have a trailing @
- } elseif {[string match "@*" $after_first_at]} {
- #part following a double @ is dict key possibly with forward-slash separators for subpath access e.g @@key/subkey/etc
- set keypath [string range $after_first_at 1 end]
- set key [split $keypath /]
-
- if {[dict exists $data {*}$key]} {
- set assigned [dict get $data {*}$key]
- lset var_actions $i 1 ?set
- lset var_actions $i 2 $assigned
- #if {[string length $v]} {
- # uplevel $lvlup [list set $v $assigned]
- #}
+ incr v_list_idx(@) ;#only incr each time we have a plain @ at the root level of the index
+ } elseif {$vkey eq "@@"} {
+ # @@ positional spec for dict
+ set k [lindex [dict keys $data] $v_dict_idx(@@)]
+ if {($v_dict_idx(@@) + 1) <= [dict size $data]} {
+ set assigned [list $k [dict get $data $k]] ;#return a list of the k,v pair at the current @@ index position
} else {
- #for consistency with lindex out of range setting var to empty string - we will do same for non existent dict key rather than unset
- #This stops us *directly* using @@key for pattern-match testing that key exists - but we can acheive matching using the count mechanism.
- #e.g 0+@#@key ? (where 0 is empty list/string and -1 means key not found)
set assigned ""
- lset var_actions $i 1 ?set
- lset var_actions $i 2 ""
}
+ lset var_actions $i 1 ?set
+ lset var_actions $i 2 $assigned
+ incr v_dict_idx(@@)
+ } elseif {[string match "@@*" $vkey]} {
+ #part following a double @ is dict key possibly with forward-slash separators for subpath access e.g @@key/subkey/etc
+ set keypath [string range $vkey 1 end]
+ set keylist [split $keypath /]
+ if {([lindex $keylist 0] ne "@@") && [lsearch $keylist @*] == -1} {
+ #pure keylist for dict - process in one go
+ if {[dict exists $data {*}$keylist]} {
+ set assigned [dict get $data {*}$keylist]
+ lset var_actions $i 1 ?set
+ lset var_actions $i 2 $assigned
+ #if {[string length $v]} {
+ # uplevel $lvlup [list set $v $assigned]
+ #}
+ } else {
+ #for consistency with lindex out of range setting var to empty string - we will do same for non existent dict key rather than unset
+ #This stops us *directly* using @@key for pattern-match testing that key exists - but we can acheive matching using the count mechanism.
+ #e.g 0+@@key/# or 0+@@key/## ? (where 0 is empty list/string and -1 means key not found)
+ set assigned ""
+ lset var_actions $i 1 ?set
+ lset var_actions $i 2 ""
+ }
+ } else {
+ #compound keylist e.g x@@data/@0/1 or x@@/a (combined dict/list access)
+ #process level by level
+ set assigned [destructure $vkey $data]
+ lset var_actions $i 1 ?set
+ #todo - destructure should return more than just assigned..(?)
+ lset var_actions $i 2 $assigned
+ }
} else {
# varname@x where x is positive or negative integer or zero - use x as lindex
# or x is a range e.g 0-3 suitable for lrange
- set selector $after_first_at
+ #set selector $after_first_at
+ set selector $vkey
+ #puts stderr "selector:$selector leveldata: $data"
set leveldata $data
set subindices [split $selector /]
- foreach index $subindices {
- set assigned ""
- set get_not 0
- set already_assigned 0
- #not- only valid at beginning if selector is a range.
- #e.g not-0-end-1 not-end-4-end-2
- if {[string match "not-*" $index]} {
- set get_not 1
- #cherry-pick some easy cases, and either assign, or re-map to corresponding index
- if {$index eq "not-tail"} {
- set assigned [lindex $leveldata 0]; set already_assigned 1
- } elseif {$index in [list "not-head" "not-0"]} {
- #set selector "tail"; set get_not 0
- set assigned [lrange $leveldata 1 end]; set already_assigned 1
- } elseif {$index eq "not-end"} {
- set assigned [lrange $leveldata 0 end-1]; set already_assigned 1
- } else {
- #trim off the not- and let the remaining index handle based on get_not being 1
- set index [string range $index 4 end]
+ set chars [join $subindices ""]
+ if {[string is digit -strict $chars]} {
+ #pure numeric keylist - put straight to lindex
+ puts stderr "lindex $leveldata $subindices"
+ set assigned [lindex $leveldata {*}$subindices]
+ } elseif {[string first "/@@" $selector] >=0 || [string first "/#" $selector] >= 0} {
+ #compound destructuring required - mix of list and dict keys
+ set assigned [destructure $vkey $data]
+ lset var_actions $i 1 ?set
+ lset var_actions $i 2 $assigned
+
+ } else {
+ set i_keyindex 0
+ foreach index $subindices {
+ if {$index eq "@"} {
+ #e.g @1/1/@/1 the lone @ is a positional spec for this specific subkey
+ #no normalization done - ie @2/@ will not be considered same subkey as @end/@ or @end-0/@ even if llength = 3
+ #while x@,y@.= is reasonably handy - especially for args e.g >> $result"
if {[string match "pipesyntax*" $result]} {
error $result
}
- return [dict create error [dict create reason $result]]
+ if {[string match "binding*mismatch*" $result]} {
+ return [dict create error [dict create reason $result]]
+ }
+ error $result
} else {
tailcall return [dict create ok [dict create result $result]]
}
@@ -1838,8 +2168,12 @@ namespace eval punk {
}
proc pipeswitch {pipescript args} {
- set prefix "set args \[list $args\]\n"
- set pipescript $prefix$pipescript
+ set nextargs $args
+ unset args
+ upvar args upargs
+ set upargs $nextargs
+ #set prefix "set args \[list $args\]\n"
+ #set pipescript $prefix$pipescript
uplevel 1 [list if 1 $pipescript]
}
proc ansi+ {args} {
@@ -2124,7 +2458,7 @@ namespace eval punk {
}
#-------------------------------------------------------------------
- namespace export help aliases alias cdwin cdwindir winpath windir
+ namespace export help aliases alias cdwin cdwindir winpath windir app
namespace ensemble create
#tailcall is important
@@ -2403,6 +2737,30 @@ namespace eval punk {
puts -nonewline $chan $text
}
}
+ proc app {{glob *}} {
+ upvar ::punk::config::running running_config
+ set apps_folder [dict get $running_config apps]
+ if {[file exists $apps_folder]} {
+ if {[file exists $apps_folder/$glob]} {
+ tailcall source $apps_folder/$glob/main.tcl
+ }
+ set apps [glob -nocomplain -dir $apps_folder -type d -tail $glob]
+ if {[llength $apps] == 0} {
+ if {[string first * $glob] <0 && [string first ? $glob] <0} {
+ #no glob chars supplied - only launch if exact match for name part
+ set namematches [glob -nocomplain -dir $apps_folder -type d -tail ${glob}-*]
+ set namematches [lsort $namematches] ;#todo - -ascii? -dictionary? natsort?
+ if {[llength $namematches] > 0} {
+ set latest [lindex $namematches end]
+ lassign $latest nm ver
+ tailcall source $apps_folder/$latest/main.tcl
+ }
+ }
+ }
+
+ return $apps
+ }
+ }
#current interp aliases except those created by pattern package '::p::*'
proc aliases {{glob *}} {
#todo - way to configure and query what aliases are hidden
@@ -2448,6 +2806,7 @@ namespace eval punk {
interp alias {} val {} punk::val
interp alias {} exitcode {} punk::exitcode
+ interp alias {} hide {} punkapp::hide_console ;#will only work if controllable toplevels exist
interp alias {} ansi {} punk::ansi