You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
193 lines
8.7 KiB
193 lines
8.7 KiB
|
|
|
|
package require punk::mix::util |
|
package require punk::args |
|
|
|
tcl::namespace::eval ::punk::overlay { |
|
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend |
|
# extend an ensemble-like routine with the routines in some namespace |
|
# |
|
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base |
|
# |
|
proc custom_from_base {routine base} { |
|
if {![tcl::string::match ::* $routine]} { |
|
set resolved [uplevel 1 [list ::tcl::namespace::which $routine]] |
|
if {$resolved eq {}} { |
|
error [list {no such routine} $routine] |
|
} |
|
set routine $resolved |
|
} |
|
set routinens [tcl::namespace::qualifiers $routine] |
|
if {$routinens eq {::}} { |
|
set routinens {} |
|
} |
|
set routinetail [tcl::namespace::tail $routine] |
|
|
|
if {![tcl::string::match ::* $base]} { |
|
set base [uplevel 1 [ |
|
list [tcl::namespace::which namespace] current]]::$base |
|
} |
|
|
|
if {![tcl::namespace::exists $base]} { |
|
error [list {no such namespace} $base] |
|
} |
|
|
|
set base [tcl::namespace::eval $base [ |
|
list [tcl::namespace::which namespace] current]] |
|
|
|
|
|
#while 1 { |
|
# set renamed ${routinens}::${routinetail}_[info cmdcount] |
|
# if {[namespace which $renamed] eq {}} break |
|
#} |
|
|
|
tcl::namespace::eval $routine [ |
|
::list tcl::namespace::ensemble configure $routine -unknown [ |
|
::list ::apply {{base ensemble subcommand args} { |
|
::list ${base}::_redirected $ensemble $subcommand |
|
}} $base |
|
] |
|
] |
|
|
|
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util |
|
#namespace eval ${routine}::util { |
|
#::namespace import ::punk::mix::util::* |
|
#} |
|
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib |
|
#namespace eval ${routine}::lib [string map [list <base> $base] { |
|
# ::namespace import <base>::lib::* |
|
#}] |
|
|
|
tcl::namespace::eval ${routine}::lib [tcl::string::map [list <base> $base <routine> $routine] { |
|
if {[tcl::namespace::exists <base>::lib]} { |
|
::set current_paths [tcl::namespace::path] |
|
if {"<routine>" ni $current_paths} { |
|
::lappend current_paths <routine> |
|
} |
|
tcl::namespace::path $current_paths |
|
} |
|
}] |
|
|
|
tcl::namespace::eval $routine { |
|
::set exportlist [::list] |
|
::foreach cmd [tcl::info::commands [tcl::namespace::current]::*] { |
|
::set c [tcl::namespace::tail $cmd] |
|
if {![tcl::string::match _* $c]} { |
|
::lappend exportlist $c |
|
} |
|
} |
|
tcl::namespace::export {*}$exportlist |
|
} |
|
|
|
return $routine |
|
} |
|
punk::args::define { |
|
@id -id ::punk::overlay::import_commandset |
|
@cmd -name punk::overlay::import_commandset\ |
|
-summary\ |
|
"Import commands into caller's namespace with optional prefix and separator."\ |
|
-help\ |
|
"Import commands that have been exported by another namespace into the caller's |
|
namespace. Usually a prefix and optionally a separator should be used. |
|
This is part of the punk::mix CLI commandset infrastructure - design in flux. |
|
Todo - .toml configuration files for defining CLI configurations." |
|
@values |
|
prefix -type string |
|
separator -type string -help\ |
|
"A string, usually punctuation, to separate the prefix and the command name |
|
of the final imported command. The value \"::\" is disallowed in this context." |
|
cmdnamespace -type string -help\ |
|
"Namespace from which to import commands. Commands are those that have been exported." |
|
} |
|
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix |
|
#Note: commandset may be imported by different CLIs with different bases *at the same time* |
|
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base) |
|
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs. |
|
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they |
|
#want the convenience of using lib:xxx with commands coming from those packages. |
|
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace. |
|
#The basic principle is that the commandset is loaded into the caller(s) with a prefix |
|
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into) |
|
proc import_commandset {prefix separator cmdnamespace} { |
|
set bad_seps [list "::"] |
|
if {$separator in $bad_seps} { |
|
error "import_commandset invalid separator '$separator'" |
|
} |
|
if {$prefix in $bad_seps} { |
|
error "import_commandset invalid prefix '$prefix'" |
|
} |
|
if {"$prefix$separator" in $bad_seps} { |
|
error "import_commandset invalid prefix/separator combination '$prefix$separator'" |
|
} |
|
if {"[string index $prefix end][string index $separator 0]" in $bad_seps} { |
|
error "import_commandset invalid prefix/separator combination '$prefix$separator'" |
|
} |
|
#review - do we allow prefixes/separators such as a::b? |
|
|
|
#namespace may or may not be a package |
|
# allow with or without leading :: |
|
if {[tcl::string::range $cmdnamespace 0 1] eq "::"} { |
|
set cmdpackage [tcl::string::range $cmdnamespace 2 end] |
|
} else { |
|
set cmdpackage $cmdnamespace |
|
set cmdnamespace ::$cmdnamespace |
|
} |
|
|
|
if {![tcl::namespace::exists $cmdnamespace]} { |
|
#only do package require if the namespace not already present |
|
catch {package require $cmdpackage} pkg_load_info |
|
#recheck |
|
if {![tcl::namespace::exists $cmdnamespace]} { |
|
set prov [package provide $cmdpackage] |
|
if {[tcl::string::length $prov]} { |
|
set provinfo "(package $cmdpackage is present with version $prov)" |
|
} else { |
|
set provinfo "(package $cmdpackage not present)" |
|
} |
|
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace" |
|
} |
|
} |
|
|
|
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util |
|
|
|
#let child namespace 'lib' resolve parent namespace and thus util::xxx |
|
tcl::namespace::eval ${cmdnamespace}::lib [tcl::string::map [list <cmdns> $cmdnamespace] { |
|
::set nspaths [tcl::namespace::path] |
|
if {"<cmdns>" ni $nspaths} { |
|
::lappend nspaths <cmdns> |
|
} |
|
tcl::namespace::path $nspaths |
|
}] |
|
|
|
set imported_commands [list] |
|
set imported_tails [list] |
|
set nscaller [uplevel 1 [list tcl::namespace::current]] |
|
if {[catch { |
|
#review - noclobber? |
|
tcl::namespace::eval ${nscaller}::temp_import [list tcl::namespace::import ${cmdnamespace}::*] |
|
foreach cmd [tcl::info::commands ${nscaller}::temp_import::*] { |
|
set cmdtail [tcl::namespace::tail $cmd] |
|
if {$cmdtail eq "_default"} { |
|
set import_as ${nscaller}::${prefix} |
|
} else { |
|
set import_as ${nscaller}::${prefix}${separator}${cmdtail} |
|
} |
|
rename $cmd $import_as |
|
lappend imported_commands $import_as |
|
lappend imported_tails [namespace tail $import_as] |
|
} |
|
#make imported commands exported so they are available to the ensemble |
|
tcl::namespace::eval ${nscaller} [list namespace export {*}$imported_tails] |
|
} errM]} { |
|
puts stderr "Error loading commandset $prefix $separator $cmdnamespace" |
|
puts stderr "err: $errM" |
|
} |
|
return $imported_commands |
|
} |
|
} |
|
|
|
|
|
package provide punk::overlay [tcl::namespace::eval punk::overlay { |
|
variable version |
|
set version 0.1 |
|
}]
|
|
|