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}KG 2005-Sep-03 wrote this recursive multiple-index version to help backport sugar to 8.3. (was too eager to solve the problem to remember to check here for an existing solution first!):
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} #-- Passes all the test cases in the 8.4 help page for lset