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} {