Updated 2014-05-11 15:58:11 by pooryorick

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