[PD-cvs] pd/src pre8.5.tcl,1.1.2.1,1.1.2.2
carmen rocco
ix9 at users.sourceforge.net
Sun Sep 18 21:29:44 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18866
Modified Files:
Tag: devel_0_39
pre8.5.tcl
Log Message:
lremove
Index: pre8.5.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/pre8.5.tcl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** pre8.5.tcl 11 Sep 2005 11:03:28 -0000 1.1.2.1
--- pre8.5.tcl 18 Sep 2005 19:29:42 -0000 1.1.2.2
***************
*** 1,2 ****
--- 1,26 ----
+ 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} {
More information about the Pd-cvs
mailing list