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.
159 lines
6.6 KiB
159 lines
6.6 KiB
|
|
|
|
package require punk::mix::util |
|
|
|
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 {![string match ::* $routine]} { |
|
set resolved [uplevel 1 [list ::namespace which $routine]] |
|
if {$resolved eq {}} { |
|
error [list {no such routine} $routine] |
|
} |
|
set routine $resolved |
|
} |
|
set routinens [namespace qualifiers $routine] |
|
if {$routinens eq {::}} { |
|
set routinens {} |
|
} |
|
set routinetail [namespace tail $routine] |
|
|
|
if {![string match ::* $base]} { |
|
set base [uplevel 1 [ |
|
list [namespace which namespace] current]]::$base |
|
} |
|
|
|
if {![namespace exists $base]} { |
|
error [list {no such namespace} $base] |
|
} |
|
|
|
set base [namespace eval $base [ |
|
list [namespace which namespace] current]] |
|
|
|
|
|
#while 1 { |
|
# set renamed ${routinens}::${routinetail}_[info cmdcount] |
|
# if {[namespace which $renamed] eq {}} break |
|
#} |
|
|
|
namespace eval $routine [ |
|
list 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::* |
|
#}] |
|
|
|
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] { |
|
if {[namespace exists <base>::lib]} { |
|
set current_paths [namespace path] |
|
if {"<routine>" ni $current_paths} { |
|
lappend current_paths <routine> |
|
} |
|
namespace path $current_paths |
|
} |
|
}] |
|
|
|
namespace eval $routine { |
|
set exportlist [list] |
|
foreach cmd [info commands [namespace current]::*] { |
|
set c [namespace tail $cmd] |
|
if {![string match _* $c]} { |
|
lappend exportlist $c |
|
} |
|
} |
|
namespace export {*}$exportlist |
|
} |
|
|
|
return $routine |
|
} |
|
#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'" |
|
} |
|
#namespace may or may not be a package |
|
# allow with or without leading :: |
|
if {[string range $cmdnamespace 0 1] eq "::"} { |
|
set cmdpackage [string range $cmdnamespace 2 end] |
|
} else { |
|
set cmdpackage $cmdnamespace |
|
set cmdnamespace ::$cmdnamespace |
|
} |
|
|
|
if {![namespace exists $cmdnamespace]} { |
|
#only do package require if the namespace not already present |
|
catch {package require $cmdpackage} pkg_load_info |
|
#recheck |
|
if {![namespace exists $cmdnamespace]} { |
|
set prov [package provide $cmdpackage] |
|
if {[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 |
|
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] { |
|
set nspaths [namespace path] |
|
if {"<cmdns>" ni $nspaths} { |
|
lappend nspaths <cmdns> |
|
} |
|
namespace path $nspaths |
|
}] |
|
|
|
set imported_commands [list] |
|
set nscaller [uplevel 1 [list namespace current]] |
|
if {[catch { |
|
#review - noclobber? |
|
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*] |
|
foreach cmd [info commands ${nscaller}::temp_import::*] { |
|
set cmdtail [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 |
|
} |
|
} errM]} { |
|
puts stderr "Error loading commandset $prefix $separator $cmdnamespace" |
|
puts stderr "err: $errM" |
|
} |
|
return $imported_commands |
|
} |
|
} |
|
|
|
|
|
package provide punk::overlay [namespace eval punk::overlay { |
|
variable version |
|
set version 0.1 |
|
}]
|
|
|