[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