11 changed files with 939 additions and 203 deletions
@ -0,0 +1,197 @@ |
|||||||
|
#JMN - api should be kept in sync with package patternlib where possible |
||||||
|
# |
||||||
|
package provide oolib [namespace eval oolib { |
||||||
|
variable version |
||||||
|
set version 0.1.1 |
||||||
|
}] |
||||||
|
|
||||||
|
namespace eval oolib { |
||||||
|
oo::class create collection { |
||||||
|
variable o_data ;#dict |
||||||
|
variable o_alias |
||||||
|
constructor {} { |
||||||
|
set o_data [dict create] |
||||||
|
} |
||||||
|
method info {} { |
||||||
|
return [dict info $o_data] |
||||||
|
} |
||||||
|
method count {} { |
||||||
|
return [dict size $o_data] |
||||||
|
} |
||||||
|
method isEmpty {} { |
||||||
|
expr {[dict size $o_data] == 0} |
||||||
|
} |
||||||
|
method names {{globOrIdx {}}} { |
||||||
|
if {[llength $globOrIdx]} { |
||||||
|
if {[string is integer -strict $globOrIdx]} { |
||||||
|
set idx $globOrIdx |
||||||
|
if {$idx < 0} { |
||||||
|
set idx "end-[expr {abs($idx + 1)}]" |
||||||
|
} |
||||||
|
if {[catch {lindex [dict keys $o_data] $idx} result]} { |
||||||
|
error "[self object] no such index : '$idx'" |
||||||
|
} else { |
||||||
|
return $result |
||||||
|
} |
||||||
|
} else { |
||||||
|
#glob |
||||||
|
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx] |
||||||
|
} |
||||||
|
} else { |
||||||
|
return [dict keys $o_data] |
||||||
|
} |
||||||
|
} |
||||||
|
#like names but without globbing |
||||||
|
method keys {} { |
||||||
|
dict keys $o_data |
||||||
|
} |
||||||
|
method key {{posn 0}} { |
||||||
|
if {$posn < 0} { |
||||||
|
set posn "end-[expr {abs($posn + 1)}]" |
||||||
|
} |
||||||
|
if {[catch {lindex [dict keys $o_data] $posn} result]} { |
||||||
|
error "[self object] no such index : '$posn'" |
||||||
|
} else { |
||||||
|
return $result |
||||||
|
} |
||||||
|
} |
||||||
|
method hasKey {key} { |
||||||
|
dict exists $o_data $key |
||||||
|
} |
||||||
|
method get {} { |
||||||
|
return $o_data |
||||||
|
} |
||||||
|
method items {} { |
||||||
|
return [dict values $o_data] |
||||||
|
} |
||||||
|
method item {key} { |
||||||
|
if {[string is integer -strict $key]} { |
||||||
|
if {$key >= 0} { |
||||||
|
set valposn [expr {(2*$key) +1}] |
||||||
|
return [lindex $o_data $valposn] |
||||||
|
} else { |
||||||
|
set key "end-[expr {abs($key + 1)}]" |
||||||
|
return [lindex $o_data $key] |
||||||
|
#return [lindex [dict keys $o_data] $key] |
||||||
|
} |
||||||
|
} |
||||||
|
if {[dict exists $o_data $key]} { |
||||||
|
return [dict get $o_data $key] |
||||||
|
} |
||||||
|
} |
||||||
|
#inverse lookup |
||||||
|
method itemKeys {value} { |
||||||
|
set value_indices [lsearch -all [dict values $o_data] $value] |
||||||
|
set keylist [list] |
||||||
|
foreach i $value_indices { |
||||||
|
set idx [expr {(($i + 1) *2) -2}] |
||||||
|
lappend keylist [lindex $o_data $idx] |
||||||
|
} |
||||||
|
return $keylist |
||||||
|
} |
||||||
|
method search {value args} { |
||||||
|
set matches [lsearch {*}$args [dict values $o_data] $value] |
||||||
|
if {"-inline" in $args} { |
||||||
|
return $matches |
||||||
|
} else { |
||||||
|
set keylist [list] |
||||||
|
foreach i $matches { |
||||||
|
set idx [expr {(($i + 1) *2) -2}] |
||||||
|
lappend keylist [lindex $o_data $idx] |
||||||
|
} |
||||||
|
return $keylist |
||||||
|
} |
||||||
|
} |
||||||
|
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists? |
||||||
|
method alias {newAlias existingKeyOrAlias} { |
||||||
|
if {[string is integer -strict $newAlias]} { |
||||||
|
error "[self object] collection key alias cannot be integer" |
||||||
|
} |
||||||
|
if {[string length $existingKeyOrAlias]} { |
||||||
|
set o_alias($newAlias) $existingKeyOrAlias |
||||||
|
} else { |
||||||
|
unset o_alias($newAlias) |
||||||
|
} |
||||||
|
} |
||||||
|
method aliases {{key ""}} { |
||||||
|
if {[string length $key]} { |
||||||
|
set result [list] |
||||||
|
foreach {n v} [array get o_alias] { |
||||||
|
if {$v eq $key} { |
||||||
|
lappend result $n $v |
||||||
|
} |
||||||
|
} |
||||||
|
return $result |
||||||
|
} else { |
||||||
|
return [array get o_alias] |
||||||
|
} |
||||||
|
} |
||||||
|
#if the supplied index is an alias, return the underlying key; else return the index supplied. |
||||||
|
method realKey {idx} { |
||||||
|
if {[catch {set o_alias($idx)} key]} { |
||||||
|
return $idx |
||||||
|
} else { |
||||||
|
return $key |
||||||
|
} |
||||||
|
} |
||||||
|
method add {value key} { |
||||||
|
if {[string is integer -strict $key]} { |
||||||
|
error "[self object] collection key must not be an integer. Use another structure if integer keys required" |
||||||
|
} |
||||||
|
if {[dict exists $o_data $key]} { |
||||||
|
error "[self object] col_processors object error: key '$key' already exists in collection" |
||||||
|
} |
||||||
|
dict set o_data $key $value |
||||||
|
return [expr {[dict size $o_data] - 1}] ;#return index of item |
||||||
|
} |
||||||
|
method remove {idx {endRange ""}} { |
||||||
|
if {[string length $endRange]} { |
||||||
|
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time" |
||||||
|
} |
||||||
|
if {[string is integer -strict $idx]} { |
||||||
|
if {$idx < 0} { |
||||||
|
set idx "end-[expr {abs($idx+1)}]" |
||||||
|
} |
||||||
|
set key [lindex [dict keys $o_data] $idx] |
||||||
|
set posn $idx |
||||||
|
} else { |
||||||
|
set key $idx |
||||||
|
set posn [lsearch -exact [dict keys $o_data] $key] |
||||||
|
if {$posn < 0} { |
||||||
|
error "[self object] no such index: '$idx' in this collection" |
||||||
|
} |
||||||
|
} |
||||||
|
dict unset o_data $key |
||||||
|
return |
||||||
|
} |
||||||
|
method clear {} { |
||||||
|
set o_data [dict create] |
||||||
|
return |
||||||
|
} |
||||||
|
method reverse {} { |
||||||
|
set dictnew [dict create] |
||||||
|
foreach k [lreverse [dict keys $o_data]] { |
||||||
|
dict set dictnew $k [dict get $o_data $k] |
||||||
|
} |
||||||
|
set o_data $dictnew |
||||||
|
return |
||||||
|
} |
||||||
|
#review - cmd as list vs cmd as script? |
||||||
|
method map {cmd} { |
||||||
|
set seed [list] |
||||||
|
dict for {k v} $o_data { |
||||||
|
lappend seed [uplevel #0 [list {*}$cmd $v]] |
||||||
|
} |
||||||
|
return $seed |
||||||
|
} |
||||||
|
method objectmap {cmd} { |
||||||
|
set seed [list] |
||||||
|
dict for {k v} $o_data { |
||||||
|
lappend seed [uplevel #0 [list $v {*}$cmd]] |
||||||
|
} |
||||||
|
return $seed |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,51 @@ |
|||||||
|
# -*- tcl -*- |
||||||
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-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 %pkg% 999999.0a1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license <unspecified> |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
apply {code { #auto determine package name and version from name and placement of .tm file |
||||||
|
foreach base [tcl::tm::list] { |
||||||
|
set nsprefix "";#in case sourced directly and not in any of the .tm paths |
||||||
|
if {[string match -nocase ${base}* [info script]]} { |
||||||
|
set nsprefix [string trimleft [join [lrange [file split [string range [info script] [string length $base]+1 end]] 0 end-1] ::]:: ::] |
||||||
|
break |
||||||
|
} |
||||||
|
} |
||||||
|
set ver [join [lassign [split [file rootname [file tail [info script] ]] -] pkgtail] -] |
||||||
|
set pkgns ${nsprefix}${pkgtail} |
||||||
|
namespace eval $pkgns [string map [list <pkg> $pkgns <ver> $ver] $code] |
||||||
|
package provide $pkgns $ver;# only provide package if code evaluated without error |
||||||
|
} ::} { |
||||||
|
#-------------------------------------- |
||||||
|
variable pkg "<pkg>" |
||||||
|
variable version "<ver>" |
||||||
|
#-------------------------------------- |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Requirements |
||||||
|
##e.g package require frobz |
||||||
|
|
||||||
|
|
||||||
|
#proc test {args} {puts "[namespace current]::test got args: $args"} |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
namespace eval [namespace current]::lib { |
||||||
|
#proc test {args} {puts "[namespace current]::test got args: $args"} |
||||||
|
} |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
} |
||||||
|
return |
||||||
|
|
||||||
@ -0,0 +1,4 @@ |
|||||||
|
#single line per runtime executable. Name of runtime followed by list of .vfs folders with path relative to src folder. |
||||||
|
#if runtime has no entry - it will only match a .vfs folder with a matching filename e.g runtime1.exe runtime1.vfs |
||||||
|
tclkit86bi.exe punk86.vfs |
||||||
|
tclkit87a5bawt.exe punk86.vfs |
||||||
Loading…
Reference in new issue