A function to substitute parts of a string matching a regular expression with the result of a script called using the match as argument. Code and examples will be much more clear than my english:
(new version more comfortable and faster)
# regmap re string var script
# substitute all the occurrences of 're' in 'string' with
# the result of the evaluation of 'script'. Script is called
# for every match with 'var' variable set to the matching string.
#
# Example: regmap {[0-9]+} "1 2 hello 3 4 world" x {expr {$x+1}}
# Result: "2 3 hello 4 5 world"
proc regmap {re string var script} {
set submatches [lindex [regexp -about $re] 0]
lappend varlist idx
while {[incr submatches -1] >= 0} {
lappend varlist _
}
set res $string
set indices [regexp -all -inline -indices $re $string]
set delta 0
foreach $varlist $indices {
foreach {start end} $idx break
set substr [string range $string $start $end]
uplevel [list set $var $substr]
set subresult [uplevel $script]
incr start $delta
incr end $delta
set res [string replace $res $start $end $subresult]
incr delta [expr {[string length $subresult]-[string length $substr]}]
}
return $res
}Note that you can use
regsub and
subst combined to get the same effect, but often it is less secure (against nontrusted inputs) and usually more tricky.
The following is a
map implementation with a similar interface, but supporting a variable number of input elements:
# map list vars script
#
# Returns a list with elements created evaluating 'script'
# with 'vars' set taking values from 'list'.
# 'vars' is a list of variables, so the resulting list can
# be shorter then the input list.
#
# Examples:
#
# map {1 2 3 4} x {expr {$x*$x}} ; => {1 4 9 16}
#
# map {1 2 3 4} {x y} {expr {$x+$y}} ; => {3 7}
#
proc map {list vars script} {
set newlist {}
set nvars [llength $vars]
set nvarsLessOne [expr {$nvars-1}]
set len [llength $list]
for {set j 0} {$j < $len} {incr j $nvars} {
set slice [lrange $list 0 $nvarsLessOne]
set list [lrange $list $nvars end]
uplevel [list foreach $vars $slice break]
lappend newlist [uplevel $script]
}
return $newlist
}Comments to
SS
