# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # (C) 2023 # # @@ Meta Begin # Application punk::ns 999999.0a1.0 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz package require punk::lib package require punk::args namespace eval ::punk_dynamic::ns { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::ns { variable ns_current "::" variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nsimport_noclobber corp #leading colon makes it hard (impossible?) to call directly if not within the namespace proc ns/ {v {ns_or_glob ""} args} { variable ns_current ;#change active ns of repl by setting ns_current set ns_caller [uplevel 1 {::namespace current}] #puts stderr "ns_cur:$ns_current ns_call:$ns_caller" set types [list all] set nspathcommands 0 if {$v eq "/"} { set types [list children] } if {$v eq "///"} { set nspathcommands 1 } #todo - cooperate with repl? set out "" if {$ns_or_glob eq ""} { set is_absolute 1 set ns_queried $ns_current set out [nslist [nsjoin $ns_current *] -types $types -nspathcommands $nspathcommands] } else { set is_absolute [string match ::* $ns_or_glob] set has_globchars [regexp {[*?]} $ns_or_glob] if {$is_absolute} { if {!$has_globchars} { if {![namespace exists $ns_or_glob]} { error "cannot change to namespace $ns_or_glob" } set ns_current $ns_or_glob set ns_queried $ns_current tailcall ns/ $v "" } else { set ns_queried $ns_or_glob set out [nslist $ns_or_glob -types $types -nspathcommands $nspathcommands] } } else { if {!$has_globchars} { set nsnext [nsjoin $ns_current $ns_or_glob] if {![namespace exists $nsnext]} { error "cannot change to namespace $ns_or_glob" } set ns_current $nsnext set ns_queried $nsnext set out [nslist [nsjoin $nsnext *] -types $types -nspathcommands $nspathcommands] } else { set ns_queried [nsjoin $ns_current $ns_or_glob] set out [nslist [nsjoin $ns_current $ns_or_glob] -types $types -nspathcommands $nspathcommands] } } } set ns_display "\n$ns_queried" if {$ns_current eq $ns_queried} { if {$ns_current in [info commands $ns_current] } { if {![catch [list namespace ensemble configure $ns_current] ensemble_info]} { if {[llength $ensemble_info] > 0} { #this namespace happens to match ensemble command. #todo - keep cache of encountered ensembles from commands.. and examine namespace in the configure info. set ns_display "\n[a+ yellow bold]$ns_current (ensemble)[a+]" } } } } append out $ns_display return $out } #create possibly nested namespace structure - but only if not already existant proc n/new {args} { variable ns_current if {![llength $args]} { error "usage: :/new \[ ...\]" } set a1 [lindex $args 0] set is_absolute [string match ::* $a1] if {$is_absolute} { set nspath [nsjoinall {*}$args] } else { if {[string match :* $a1]} { puts stderr "n/new WARNING namespace with leading colon '$a1' is likely to have unexpected results" } set nspath [nsjoinall $ns_current {*}$args] } set ns_exists [nseval [nsprefix $nspath] [list ::namespace exists [nstail $nspath] ]] if {$ns_exists} { error "Namespace $nspath already exists" } #namespace eval [nsprefix $nspath] [list namespace eval [nstail $nspath] {}] nseval [nsprefix $nspath] [list ::namespace eval [nstail $nspath] {}] n/ $nspath } #nn/ ::/ nsup/ - back up one namespace level proc nsup/ {v args} { variable ns_current if {$ns_current eq "::"} { puts stderr "Already at global namespace '::'" } else { set out "" set nsq [nsprefix $ns_current] if {$v eq "/"} { set out [get_nslist -match [nsjoin $nsq *] -types [list children]] } else { set out [get_nslist -match [nsjoin $nsq *] -types [list all]] } #set out [nslist [nsjoin $nsq *]] set ns_current $nsq append out "\n$ns_current" return $out } } #todo - walk up each ns - testing for possibly weirdly named namespaces #review - do we even need it. proc nsexists {nspath} { error "unimplemented" } #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal namespace eval - but still only a few microseconds.. fine for repl introspection proc nseval_script {location} { set parts [nsparts $location] if {[lindex $parts 0] eq ""} { lset parts 0 :: } if {[lindex $parts end] eq ""} { set parts [lrange $parts 0 end-1] } set body "" set i 0 set tails [lrepeat [llength $parts] ""] foreach ns $parts { set cmdlist [list ::namespace eval $ns] set t "" if {$i > 0} { append body " " } append body $cmdlist if {$i == ([llength $parts] -1)} { append body "