# -*- 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 0.1.0 # Meta platform tcl # Meta license # @@ Meta End #BUGS # 2025-08 # n// and n/// won't output info about 'namespace path' if there are no commands in the namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz package require punk::lib package require punk::args tcl::namespace::eval ::punk::ns::evaluator { #eval-_NS_xxx_NS_etc procs } tcl::namespace::eval punk::ns { namespace eval argdoc { variable PUNKARGS tcl::namespace::import ::punk::ansi::a+ ::punk::ansi::a # -- --- --- --- --- #non colour SGR codes # we can use these directly via ${$I} etc without marking a definition with @dynamic #This is because they don't need to change when colour switched on and off. set I [a+ italic] set NI [a+ noitalic] set B [a+ bold] set N [a+ normal] set T [a+ bold underline] set NT [a+ normal nounderline] set LC \u007b ;#left curly brace set RC \u007d ;#right curly brace # -- --- --- --- --- namespace import ::punk::args::helpers::* } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { #variable ns_current ##allow presetting #if {![info exists ::punk::ns::ns_current]} { # set ns_current :: #} variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp pkguse cmdtype synopsis namespace path {::punk::lib ::punk::ansi} ;#list_as_lines etc catch { package require debug debug define punk.ns.compile #debug on punk.ns.compile #debug level punk.ns.compile 3 } #todo - walk up each ns - testing for possibly weirdly named namespaces #needed to use n/ to change to an oddly named namespace such as ":x" proc nsexists {nspath} { if {$nspath eq ""} {return 0} set parts [nsparts_cached $nspath] if {[lindex $parts 0] ne ""} { #relative set ns_caller [uplevel 1 [list ::tcl::namespace::current]] set fq_nspath [nsjoin $ns_caller $nspath] } else { set fq_nspath $nspath } if {[nseval_ifexists $fq_nspath {::string cat ok}] eq "ok"} { return 1 } else { return 0 } } #todo - consider coroutine-based implementation? #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal tcl::namespace::eval - but still only a few microseconds.. fine for repl introspection #WARNING: creates namespaces if they don't exist proc nseval_getscript {location} { set parts [nsparts_cached $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 ::tcl::namespace::eval $ns] set t "" if {$i > 0} { append body " " } append body $cmdlist if {$i == ([llength $parts] -1)} { append body "