Version 1 of patch for rcs in tcl

Updated 2013-01-20 09:37:11 by pooryorick

A quickie to apply patches generated by diff -n (so-called rcs format) - CMcC 20041006

# patch a file given diffs in rcs (diff -n) format
package require fileutil

namespace eval rcs {}

# convert \n delimited file to an array indexed by line name
proc rcs::file2array {filename arr} {
    upvar 1 $arr lines
    set lnum 0
    fileutil::foreachLine line $filename {
    set lines([incr lnum]) $line
    }
}

# convert \n delimited text to an array indexed by line name
proc rcs::text2array {text arr} {
    upvar 1 $arr lines
    set lnum 0
    foreach line [split $text \n] {
    set lines([incr lnum]) $line
    }
}

# Apply some rcs diff -n format patches to the text in array
proc rcs::patch {patch arr} {
    upvar 1 $arr lines
    set patch [split $patch \n]
    while {$patch != {}} {
    set pc [string trim [lindex $patch 0]]
    puts stderr "doing $pc"
    set patch [lrange $patch 1 end]
    switch -glob -- $pc {
        "" {}
        a* {
        foreach {start len} [split [string range $pc 1 end]] break
        set adding [join [lrange $patch 0 [expr {$len - 1}]] \n]
        if {[info exists lines($start)]} {
            append lines($start) \n
        }
        append lines($start) "$adding"
        puts stderr "ADD: '$adding'"
        set patch [lrange $patch $len end]
        puts stderr "$pc: $lines($start)"
        }
        d* {
        foreach {start len} [split [string range $pc 1 end]] break
        while {$len > 0} {
            puts stderr "DEL $start: $lines($start)"
            unset lines($start)
            incr start
            incr len -1
        }
        }
        default {
        error "Unknown patch: '$pc'"
        }
    }
    }

    set result ""
    foreach lnum [lsort -integer [array names lines]] {
    append result \n $lines($lnum)
    }
    
    return [string range $result 1 end]
}