#! /bin/env tclsh
namespace eval doc {}
proc require {name args} {
rename ::package [namespace current]::package_orig
namespace eval :: {
interp alias {} ::package {} ycl::package
}
package_orig require $name {*}$args
interp alias {} ::package {} {}
rename [namespace current]::package_orig ::package
}
variable doc::loaded {
description {
return a list of all loaded packages
}
}
proc loaded {} {
set res [list]
foreach name [package names] {
if {[package provide $name] ne {}} {
lappend res $name
}
}
return $res
}
proc prep name {
#[yclprefix] exports the root namespace
set yclprefix [yclprefix]
if {[string match ::* $name]} {
set fullname $name
} else {
set fullname [set name ${yclprefix}::$name]
}
set yclprefix [yclprefix]
while {$name ne $yclprefix} {
if {![namespace ensemble exists $name]} {
namespace eval $name {
namespace eval imports {}
namespace path [list imports {*}[namespace path]]
namespace export {[a-z]*}
namespace ensemble create
}
}
set name [namespace parent $name]
}
namespace eval $fullname {
namespace eval doc {}
}
return $fullname
}
proc source {name file} {
set fullname [prep $name]
#source the file after the export commands to that the file can override them
namespace eval $fullname [list source $file]
}
proc vcomp {a b} {
variable vcompre
foreach varname {a b} {
upvar 0 $varname var
regsub -all {[[:punct:]]+} $var { } $varname
regsub -all $vcompre $var { \0 } $varname
regsub -all {[[:space:]]+} $var { } $varname
set $varname [string trim $var]
}
set length [llength $a]
set idx 0
foreach apart $a bpart $b {
foreach varname {apart bpart} {
upvar 0 $varname var
if {[string is integer $apart]} {
scan $var %d $varname
}
}
if {$apart > $bpart} {
return 1
} elseif {$bpart > $apart} {
return -1
}
}
}
### convenience commands **
proc yclifneeded {name version filename} {
package ifneeded ycl::$name $version [list apply {{dir} {
package require ycl::package
[yclprefix]::package::source $name \
[file join $dir {*}$filename]
package provide ycl::$name $version
}} $dir]
}
variable vcompre
foreach class {upper lower digit cntrl} {
lappend vcompre (\[\[:$class:]]+)
set vcompre [join $vcompre |]
unset class
}