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?
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
}See Also: lindex forward compatibility