diff options
| -rw-r--r-- | desiredata/src/desire.tk | 2 | ||||
| -rw-r--r-- | desiredata/src/poe.tcl | 1 | ||||
| -rw-r--r-- | desiredata/src/pre8.5.tcl | 209 |
3 files changed, 2 insertions, 210 deletions
diff --git a/desiredata/src/desire.tk b/desiredata/src/desire.tk index d1d02cda..b424c9cc 100644 --- a/desiredata/src/desire.tk +++ b/desiredata/src/desire.tk @@ -32,6 +32,8 @@ set cvsid {$Id: desire.tk,v 1.1.2.600.2.419 2007-10-27 00:22:27 matju Exp $} set debug 0 ;# DON'T TOUCH THIS, make yourself a debug.tcl instead! +if {$tcl_version < 8.5} {puts "Please upgrade to Tcl/Tk 8.5... Thank You.\n(your version is $tcl_version)"; exit 84} + if {[catch {winfo children .}]} {set tk 0} {set tk 1} set argh0 [file normalize [file join [pwd] $argv0]] diff --git a/desiredata/src/poe.tcl b/desiredata/src/poe.tcl index 89ddfc78..68ec96fc 100644 --- a/desiredata/src/poe.tcl +++ b/desiredata/src/poe.tcl @@ -31,7 +31,6 @@ package provide poe 0.1 -if {$tcl_version < 8.5} {package require pre8.5} set nextid 0 set _(Class:_class) Class set _(Class:_super) {Thing} diff --git a/desiredata/src/pre8.5.tcl b/desiredata/src/pre8.5.tcl deleted file mode 100644 index c4b289c5..00000000 --- a/desiredata/src/pre8.5.tcl +++ /dev/null @@ -1,209 +0,0 @@ -package provide pre8.5 8.4 - -proc lremove {args} { - array set opts {-all 0 pattern -exact} - while {[string match -* [lindex $args 0]]} { - switch -glob -- [lindex $args 0] { - -a* { set opts(-all) 1 } - -g* { set opts(pattern) -glob } - -r* { set opts(pattern) -regexp } - -- { set args [lreplace $args 0 0]; break } - default {return -code error "unknown option \"[lindex $args 0]\""} - } - set args [lreplace $args 0 0] - } - set l [lindex $args 0] - foreach i [join [lreplace $args 0 0]] { - if {[set ix [lsearch $opts(pattern) $l $i]] == -1} continue - set l [lreplace $l $ix $ix] - if {$opts(-all)} { - while {[set ix [lsearch $opts(pattern) $l $i]] != -1} { - set l [lreplace $l $ix $ix] - } - } - } - return $l -} -if {![llength [info commands dict]]} { - proc lassign {list args} { - foreach elem $list varName $args { - upvar 1 $varName var - set var $elem - } - } - proc dict {cmd args} { - uplevel 1 [linsert $args 0 _dict_$cmd] - } - proc _dict_get {dv args} { - if {![llength $args]} {return $dv} else { - array set dvx $dv - set key [lindex $args 0] - set dv $dvx($key) - set args [lrange $args 1 end] - return [eval [linsert $args 0 _dict_get $dv]] - } - } - proc _dict_exists {dv key args} { - array set dvx $dv - set r [info exists dvx($key)] - if {!$r} {return 0} - if {[llength $args]} { - return [eval [linsert $args 0 _dict_exists $dvx($key) ]] - } else {return 1} - } - proc _dict_set {dvar key value args } { - upvar 1 $dvar dv - if {![info exists dv]} {set dv [list]} - array set dvx $dv - if {![llength $args]} { - set dvx($key) $value - } else { - eval [linsert $args 0 _dict_set dvx($key) $value] - } - set dv [array get dvx] - } - proc _dict_unset {dvar key args} { - upvar 1 $dvar mydvar - if {![info exists mydvar]} {return} - array set dv $mydvar - if {![llength $args]} { - if {[info exists dv($key)]} { - unset dv($key) - } - } else { - eval [linsert $args 0 _dict_unset dv($key) ] - } - set mydvar [array get dv] - return {} - } - proc _dict_keys {dv {pat *}} { - array set dvx $dv - return [array names dvx $pat] - } - proc _dict_append {dvar key {args}} { - upvar 1 $dvar dv - if {![info exists dv]} {set dv [list]} - array set dvx $dv - eval [linsert $args 0 append dvx($key) ] - set dv [array get dvx] - } - proc _dict_create {args} { - return $args - } - proc _dict_filter {dv ftype args} { - set r [list] - foreach {globpattern} $args {break} - foreach {varlist script} $args {break} - - switch $ftype { - key { - foreach {key value} $dv { - if {[string match $globpattern $key]} { - lappend r $key $value - } - } - } - value { - foreach {key value} $dv { - if {[string match $globpattern $value]} { - lappend r $key $value - } - } - } - script { - foreach {Pkey Pval} $varlist {break} - upvar 1 $Pkey key $Pval value - foreach {key value} $dv { - if {[uplevel 1 $script]} { - lappend r $key $value - } - } - } - default { - error "Wrong filter type" - } - } - return $r - } - proc _dict_for {kv dict body} { - uplevel 1 [list foreach $kv $dict $body] - } - proc _dict_incr {dvar key {incr 1}} { - upvar 1 $dvar dv - if {![info exists dv]} {set dv [list]} - array set dvx $dv - if {![info exists dvx($key)]} {set dvx($key) 0} - incr dvx($key) $incr - set dv [array get dvx] - } - proc _dict_info {dv} { - return "Dictionary is represented as plain list" - } - proc _dict_lappend {dvar key args} { - upvar 1 $dvar dv - if {![info exists dv]} {set dv [list]} - array set dvx $dv - eval [linsert $args 0 lappend dvx($key)] - set dv [array get dvx] - } - proc _dict_merge {args} { - foreach dv $args { - array set dvx $dv - } - array get dvx - } - proc _dict_replace {dv args} { - foreach {k v} $args { - _dict_set dv $k $v - } - return $dv - } - proc _dict_remove {dv args} { - foreach k $args { - _dict_unset dv $k - } - return $dv - } - proc _dict_size {dv} { - return [expr {[llength $dv]/2}] - } - proc _dict_values {dv {gp *}} { - set r [list] - foreach {k v} $dv { - if {[string match $gp $v]} { - lappend r $v - } - } - return $r - } - proc _dict_update {dvar args} { - set name [string map {: {} ( {} ) {}} $dvar] - upvar 1 $dvar dv - upvar 1 _my_dict_array$name local - - array set local $dv - foreach {k v} [lrange $args 0 end-1] { - if {[info exists local($k)]} { - if {![uplevel 1 [list info exists $v]]} { - uplevel 1 [list upvar 0 _my_dict_array${name}($k) $v] - } else { - uplevel 1 [list set $v $local($k)] - } - } - } - set code [catch {uplevel 1 [lindex $args end]} res] - - foreach {k v} [lrange $args 0 end-1] { - if {[uplevel 1 [list info exists $v]]} { - set local($k) [uplevel 1 [list set $v]] - } else { - unset -nocomplain local($k) - } - } - set dv [array get local] - unset local - - return -code $code $res - } - -}
\ No newline at end of file |