[PD-cvs] SF.net SVN: pure-data: [9439] trunk/desiredata/src
matju at users.sourceforge.net
matju at users.sourceforge.net
Thu Feb 14 00:59:12 CET 2008
Revision: 9439
http://pure-data.svn.sourceforge.net/pure-data/?rev=9439&view=rev
Author: matju
Date: 2008-02-13 15:59:11 -0800 (Wed, 13 Feb 2008)
Log Message:
-----------
require Tcl/Tk 8.5
Modified Paths:
--------------
trunk/desiredata/src/desire.tk
trunk/desiredata/src/poe.tcl
Removed Paths:
-------------
trunk/desiredata/src/pre8.5.tcl
Modified: trunk/desiredata/src/desire.tk
===================================================================
--- trunk/desiredata/src/desire.tk 2008-02-13 21:44:17 UTC (rev 9438)
+++ trunk/desiredata/src/desire.tk 2008-02-13 23:59:11 UTC (rev 9439)
@@ -32,6 +32,8 @@
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]]
Modified: trunk/desiredata/src/poe.tcl
===================================================================
--- trunk/desiredata/src/poe.tcl 2008-02-13 21:44:17 UTC (rev 9438)
+++ trunk/desiredata/src/poe.tcl 2008-02-13 23:59:11 UTC (rev 9439)
@@ -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}
Deleted: trunk/desiredata/src/pre8.5.tcl
===================================================================
--- trunk/desiredata/src/pre8.5.tcl 2008-02-13 21:44:17 UTC (rev 9438)
+++ trunk/desiredata/src/pre8.5.tcl 2008-02-13 23:59:11 UTC (rev 9439)
@@ -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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the Pd-cvs
mailing list