####### tcl compatibility layer ## this package provides implementations of newer Tcl-features ## that are not found in old one implementations (like Tcl8.4) ## features are only provided if they are missing ## currently these are the functions provided: ## - 'dict' ## to use this do something like: ## > package require pdtcl_compat ## > catch {namespace import ::pdtcl_compat::dict} package provide pdtcl_compat 0.1 namespace eval ::pdtcl_compat { namespace export dict namespace export lmap } ## poor man's 'dict' implementation (for Tcl8.4) # this only provides a limited set of sub-commands # it is also slower than the built-in proc ::pdtcl_compat::dict {command args} { #puts " $args" switch -- "${command}" { create { return {} } exist - exists { set dictionary [lindex ${args} 0] set key [lindex ${args} 1] foreach {k v} ${dictionary} { if { $k eq ${key} } {return 1} } return 0 } get { set key [lindex ${args} 1] foreach {k v} [lindex ${args} 0] { if { $k eq ${key} } {return $v} } return {} } lappend { upvar [lindex ${args} 0] dictionary set key [lindex ${args} 1] set value [lrange ${args} 2 end] set index 0 foreach {k v} ${dictionary} { if { $k eq ${key} } { incr index set dictionary \ [lreplace ${dictionary} ${index} ${index} \ [concat $v ${value}]] return ${dictionary} } incr index 2 } return [lappend dictionary ${key} ${value}] } set { upvar [lindex ${args} 0] dictionary set key [lindex ${args} 1] set value [lindex ${args} 2] set index 0 foreach {k v} ${dictionary} { if { $k eq ${key} } { incr index set dictionary \ [lreplace ${dictionary} ${index} ${index} \ [concat $v ${value}]] return ${dictionary} } incr index 2 } return [lappend dictionary ${key} ${value}] } unset { upvar [lindex ${args} 0] dictionary set key [lindex ${args} 1] set index 0 foreach {k value} ${dictionary} { if { $k eq ${key} } { set dictionary \ [lreplace ${dictionary} ${index} ${index}+1] return ${dictionary} } incr index 2 } return ${dictionary} } } } ## poor man's 'lmap' implementation (for Tcl8.4, Tcl8.5) # https://wiki.tcl-lang.org/page/lmap proc ::pdtcl_compat::lmap args { set body [lindex $args end] set args [lrange $args 0 end-1] set n 0 set pairs [list] foreach {varname listval} $args { upvar 1 $varname var$n lappend pairs var$n $listval incr n } set temp [list] eval foreach $pairs [list { lappend temp [uplevel 1 $body] }] set temp } if { [catch {dict create} ] } { namespace import ::pdtcl_compat::dict } if { [catch {lmap _ {1 2 3} {list $_}} ] } { namespace import ::pdtcl_compat::lmap }