Originated by Tom Wilkason on comp.lang.tcl.
Modifications by DGP.
if {[package vcompare [package provide Tcl] 8.4] < 0} {
proc tcl::K {a b} {return $a}
proc lset {listName index val} {
upvar $listName list
set list [lreplace [tcl::K $list [set list {}]] $index $index $val]
}
} ;# end ifKPV Does anybody have a version that works with multiple indices? (yes, see KMG 2005-Sep-03 entry below)
MG Nov 12 2004 - Does this work?
proc lset2 {listName args} {
if { [llength $args] == "0" } {
error "wrong # args: should be \"lset2 listVar index ?index...? value\""
}
upvar $listName list
if { [llength $args] == "1" || ([llength $args] == "2" && [llength [lindex $args 0]] == "0") } {
set list [lindex $args [expr {[llength $args]=="1"?0:1}]]
return $list;
}
set val [lindex $args end]
foreach x [lrange $args 0 end-1] {
set list [lreplace $list $x $x $val]
}
return $list;
}LIO I couldn't seem to get the above to work correctly. I wrote a recursive version, the only difference to the actual lset (that I can think of) is it will not take the indeces as a single list (although it would be easy to add that in).
if {[package vcompare [package provide Tcl] 8.4] < 0} {
proc tcl::K {a b} {return $a}
proc lset_r {list args val} {
if { [llength $args] == "0" } {
return $val
} else {
return [lreplace $list [lindex $args 0] [lindex $args 0] [lset_r [lindex $list [lindex $args 0]] [lrange $args 1 end] $val]]
}
}
proc lset {listName args} {
if { [llength $args] == "0" } {
error "wrong # args: should be \"lset varName ?index...? newValue\""
}
upvar $listName list
set list [lset_r [tcl::K $list [set list {}]] [lrange $args 0 end-1] [lindex $args end]]
}
}
TP 2005-01-12 I wrote this version a while back to use in Jacl. It probably could be optimized with the K tricks. Nor am I sure that it's fully compatible with the current 8.4 native lset.
proc lset { varName args } {
upvar 1 $varName list
switch [llength $args] {
0 {
error \
"wrong # args: should be \"lset listVar index ?index...? value\""
}
1 {
set list [lindex $args 0]
return $list
}
2 {
set index [lindex $args 0]
if {[llength $index] > 1} {
set value [lindex $args end]
set list [eval lset list $index [list $value]]
return $list
} else {
if {[regexp end $index]} {
set index \
[expr ([llength $list]-1) [string range $index 3 end]]
}
if {$index < 0 || $index >= [llength $list]} {
error "list index out of range"
}
set value [lindex $args end]
set list [lreplace $list $index $index $value]
return $list
}
}
default {
set index [lindex $args 0]
if {[regexp end $index]} {
set index [expr ([llength $list]-1) [string range $index 3 end]]
}
set rest [lrange $args 1 end-1]
set value [lindex $args end]
set sublist [lindex $list $index]
set first [lrange $list 0 [expr {$index - 1}]]
set last [lrange $list [expr {$index + 1}] end]
set list $first
lappend list [eval lset sublist $rest [list $value]]
foreach l $last {
lappend list $l
}
return $list
}
}
}RS 2005-02-20 hacked up this recursive multiple-index version for the iPaq (Keuchel's port was 8.4a2, no lset yet):
proc lset {_list args} {
upvar 1 $_list list
set indices [lrange $args 0 end-1]
if {[llength $indices]==1} {set indices [lindex $indices 0]} ;# list case
set list [lset0 $list $indices [lindex $args end]]
}
proc lset0 {list indices val} {
if {[llength $indices]==0} {return $val}
set p [lindex $indices 0]
set list2 [lindex $list $p]
set ind2 [lrange $indices 1 end]
lreplace $list $p $p [lset0 $list2 $ind2 $val]
}#-- Test with indices in a list, or in pieces:
% set x {{a b} {c d}}
{a b} {c d}
% lset x 0 1 e
{a e} {c d}
% lset x {0 1} f
{a f} {c d}KMG 2005-Sep-03 wrote this recursive multiple-index version to help backport sugar to 8.3. (I was too eager to solve the problem to remember to check here for an existing solution first!). This implementation passes all of the reference test cases on the 8.4 help page for 'lset'.
proc lset { varName args } {
upvar 1 $varName theList
set theValue [lindex $args end]
switch -exact [llength $args] {
0 {
# lset v (do nothing)
}
1 {
# lset v x (copy x to v)
set theList $theValue
}
2 {
# lset v i x (set the i'th element of v to x)
# lset v {} x (set v to x)
# lset v {i j k} x (set the k'th element of the j'th element of the i'th element of v to x)
set indexList [lindex $args 0]
set index [lindex $indexList 0]
set theLength [llength $theList]
switch -exact [llength $indexList] {
0 {
# lset v {} x (set v to x)
set theList $theValue
}
1 {
# lset v i x (set the i'th element of v to x)
if { [string is integer -strict $index] && ($index >= $theLength) } {
error "list index out of range: $index >= $theLength"
}
set theList [lreplace $theList $index $index $theValue]
}
default {
# lset v {i j k} x (set the k'th element of the j'th element of the i'th element of v to x)
set subList [lindex $theList $index]
set subList [lset subList [lrange $indexList 1 end] $theValue]
set theList [lreplace $theList $index $index $subList]
}
}
}
default {
# lset v i j k x (set the k'th element of the j'th element of the i'th element of v to x)
set indexList [lrange $args 0 end-1]
set theList [lset theList $indexList $theValue]
}
}
return $theList
}kruzalex modified version of lset written by KMG and add replace feature. See example code below:
proc interleaveEmptyBrackets {list} { set res "" set tok "" set i 0 while {llength [split $list {}]!=$i} { switch -exact -- [string index $list $i { "\{" {
append toke $tok
set tok "\{"
}"\}" {
if {[string equal $tok \{]} {
set tok ""
} else {
set toke [string trimright $toke]
append toke "\}"
if {[string first " " [join [split [string trimleft $toke " "]] " \" \" "]] > -1} {
append res $toke
} else {
if {([string equal $toke \{] || [string equal $toke \}])} {
append res $toke
} else {
set temp [string range $toke 0 [string last \{ $toke]]
set toke [string range $toke [expr [string last \{ $toke]+1] [expr [string first \} $toke]-1]]
append res $temp $toke
}
}
set tok ""
set toke ""
}
}{ } {
if {![string equal [string index [join [split $toke] " \" \" "] end] " "]} {
append toke " "
}
}[ - \] - "\t" - "\n" - "\"" - \; - \{ - \} - \$ - ( - ) - "\\" - default {
append toke $tok [string index $list $i]
set tok ""
if {[expr [string length $list] - 1] == $i} {
set res $toke
}
}} incr i } set res }
proc lset { varName args } {
upvar 1 $varName theList
set theValue [lindex $args end]
switch -exact [llength $args] {
0 {
# lset v (do nothing)
}
1 {
# lset v x (copy x to v)
if {[llength $args]==1 && [llength $theList]>1} {
set index [lindex [lindex $args 0] 0]
set theList [lreplace $theList $index $index {}]
return [interleaveEmptyBrackets $theList]
} else {
set theList $theValue
}
}
2 {
# lset v i (replace the i'th element with nothing)
# lset v i x (set the i'th element of v to x)
# lset v {} x (set v to x)
# lset v {i j k} x (set the k'th element of the j'th element of the i'th element of v to x)
set indexList [lindex $args 0]
set index [lindex $indexList 0]
set theLength [llength $theList]
switch -exact [llength $indexList] {
0 {
# lset v {} x (set v to x)
set theList $theValue
}
1 {
# lset v i x (set the i'th element of v to x)
#puts "theList_begin: $theList"
if {![string is integer -strict [lindex $args end]]} {
if { [string is integer -strict $index] && ($index >= $theLength) } {
error "list index out of range: $index >= $theLength"
}
set theList [lreplace $theList $index $index $theValue]
} else {
if {[info level]==1} {
set theList [lreplace $theList $index $index [lreplace [lindex $theList $index] [lindex $args 1] [lindex $args 1] {}]]
return [lreplace $theList $index $index [lreplace [lindex $theList $index] [lindex $args 1] [lindex $args 1]]]
} else {
set theList [lreplace $theList $index $index [lreplace [lindex $theList $index] [lindex $args 1] [lindex $args 1] {}]]
}
}
}
default {
# lset v {i j k} x (set the k'th element of the j'th element of the i'th element of v to x)
#puts "theList_default: $theList"
set subList [lindex $theList $index]
set subList [lset subList [lrange $indexList 1 end] $theValue]
set theList [lreplace $theList $index $index $subList]
}
}
}
default {
# lset v i j k x (set the k'th element of the j'th element of the i'th element of v to x)
set indexList [lrange $args 0 end-1]
set theList [lset theList $indexList $theValue]
return [interleaveEmptyBrackets $theList]
}
}
set theList
}
#Testing
set v1 {a b c}
set v2 [list {a b c} {d e f} {g h i}]
#set v3 [list [list [list a b] [list c d]] [list [list e f] [list g h]] [list [list i j] [list k l]]]
set v3 {{{a b} {c d}} {{e {}} {g h}} {{i j} {k l}}}
set v4 {{{a b} {c d}} {{e {a b}} {g h}} {{i j} {k l}}}
puts [lset v1 1]
puts "v1: $v1"
puts [lset v1 1 b]
puts "v1: $v1"
puts [lset v2 1 0]
puts "v2: $v2"
puts [lset v2 1 0 k]
puts "v2: $v2"
puts [lset v3 1 0 1]
puts "v3: $v3"
puts [lset v3 1 0 1 j]
puts "v3: $v3"See Also: lindex forward compatibility