From 6439b5e9d7c2e6af8589168ca7253d9e3d838959 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Tue, 23 Dec 2025 12:39:02 +1100 Subject: [PATCH] ensure punk::nav::ns included in bootsupport --- .../modules/include_modules.config | 1 + src/bootsupport/modules/punk/nav/ns-0.1.0.tm | 302 ++++++++++++++++++ 2 files changed, 303 insertions(+) create mode 100644 src/bootsupport/modules/punk/nav/ns-0.1.0.tm diff --git a/src/bootsupport/modules/include_modules.config b/src/bootsupport/modules/include_modules.config index 3a8e96a7..31d40115 100644 --- a/src/bootsupport/modules/include_modules.config +++ b/src/bootsupport/modules/include_modules.config @@ -81,6 +81,7 @@ set bootsupport_modules [list\ modules punk::mix::commandset::scriptwrap\ modules punk::mod\ modules punk::nav::fs\ + modules punk::nav::ns\ modules punk::ns\ modules punk::overlay\ modules punk::path\ diff --git a/src/bootsupport/modules/punk/nav/ns-0.1.0.tm b/src/bootsupport/modules/punk/nav/ns-0.1.0.tm new file mode 100644 index 00000000..16cb13a1 --- /dev/null +++ b/src/bootsupport/modules/punk/nav/ns-0.1.0.tm @@ -0,0 +1,302 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.4.tm +# +# 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) 2025 +# +# @@ Meta Begin +# Application punk::nav::ns 0.1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +package require Tcl 8.6- + + + +tcl::namespace::eval punk::nav::ns { + variable PUNKARGS + variable ns_current + #allow presetting + if {![info exists ::punk::nav::ns::ns_current]} { + set ns_current :: + } + namespace path {::punk::ns} + + proc ns/ {v {ns_or_glob ""} args} { + variable ns_current ;#change active ns of repl by setting ns_current + + set ns_caller [uplevel 1 {::tcl::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 + } + + set ns_or_glob [string map {:::: ::} $ns_or_glob] + + #todo - cooperate with repl? + set out "" + if {$ns_or_glob eq ""} { + set is_absolute 1 + set ns_queried $ns_current + set out [nslist -types $types -nspathcommands $nspathcommands [nsjoin $ns_current *]] + } else { + set is_absolute [string match ::* $ns_or_glob] + set has_globchars [regexp {[*?]} $ns_or_glob] ;#basic globs only? + if {$is_absolute} { + if {!$has_globchars} { + if {![nsexists $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 -types $types -nspathcommands $nspathcommands $ns_or_glob] + } + } else { + if {!$has_globchars} { + set nsnext [nsjoin $ns_current $ns_or_glob] + if {![nsexists $nsnext]} { + error "cannot change to namespace $ns_or_glob" + } + set ns_current $nsnext + set ns_queried $nsnext + set out [nslist -types $types -nspathcommands $nspathcommands [nsjoin $nsnext *]] + } else { + set ns_queried [nsjoin $ns_current $ns_or_glob] + set out [nslist -types $types -nspathcommands $nspathcommands [nsjoin $ns_current $ns_or_glob]] + } + } + } + set ns_display "\n$ns_queried" + if {$ns_current eq $ns_queried} { + if {$ns_current in [info commands $ns_current] } { + if {![catch [list tcl::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 ::tcl::namespace::exists [nstail $nspath] ]] + + if {$ns_exists} { + error "Namespace $nspath already exists" + } + #tcl::namespace::eval [nsprefix $nspath] [list tcl::namespace::eval [nstail $nspath] {}] + nseval [nsprefix $nspath] [list ::tcl::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 + } + } + + + +} + + + +#extra slash implies more verbosity (ie display commands instead of just nschildren) +interp alias {} n/ {} punk::nav::ns::ns/ / +interp alias {} n// {} punk::nav::ns::ns/ // +interp alias {} n/// {} punk::nav::ns::ns/ /// +interp alias {} n/new {} punk::nav::ns::n/new +interp alias {} nn/ {} punk::nav::ns::nsup/ / +interp alias {} nn// {} punk::nav::ns::nsup/ // +if 0 { +#we can't have ::/ without just plain / which is confusing. +interp alias {} :/ {} punk::nav::ns::ns/ / +interp alias {} :// {} punk::nav::ns::ns/ // +interp alias {} :/new {} punk::nav::ns::n/new +interp alias {} ::/ {} punk::nav::ns::nsup/ / +interp alias {} ::// {} punk::nav::ns::nsup/ // +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::nav::ns::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +#tcl::namespace::eval punk::nav::ns::system { +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::nav::ns { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::nav::ns" + @package -name "punk::nav::ns" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::nav::ns + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + #Adjust this function or 'default_topics' if a different order is required + return [lsort $about_topics] + } + proc default_topics {} {return [list Description *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + package punk::nav::ns + description to come.. + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return "$::punk::nav::ns::version" + } + proc get_topic_Contributors {} { + set authors {} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_custom-topic {} { + punk::args::lib::tstr -return string { + A custom + topic + etc + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::nav::ns::about" + dict set overrides @cmd -name "punk::nav::ns::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::nav::ns + }] \n] + dict set overrides topic -choices [list {*}[punk::nav::ns::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::nav::ns::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::nav::ns::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::nav::ns::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + + +# ----------------------------------------------------------------------------- +# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked +# ----------------------------------------------------------------------------- +# variable PUNKARGS +# variable PUNKARGS_aliases +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::nav::ns +} +# ----------------------------------------------------------------------------- + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::nav::ns [tcl::namespace::eval punk::nav::ns { + variable pkg punk::nav::ns + variable version + set version 0.1.0 +}] +return +