regmap

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