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]
}
======

Below comes a version to apply a patch to a directory tree for the most widely used unified context diff format, generated by [diff] -ruN old/ new/ This performs the analogous task of patch -p<striplevel> < patch 

======
##        Apply a patch in unified diff format
# @synopsis{Patch directory striplevel patch}
#
#
# @param[in] dir        root directory of the original source tree
# @param[in] striplevel number of path elements to be removed from the diff header
# @param[in] patch      output of diff -ru

proc ApplyPatch {dir striplevel patch} {
        set patchlines [split $patch \n]
        set inhunk false
        set oldcode {}
        set newcode {}
        
        for {set lineidx 0} {$lineidx<[llength $patchlines]} {incr lineidx} {
                set line [lindex $patchlines $lineidx]
                if {[string match diff* $line]} {
                        # a diff block starts. Next two lines should be
                        # --- oldfile date time TZ
                        # +++ newfile date time TZ
                        incr lineidx
                        set in [lindex $patchlines $lineidx]
                        incr lineidx
                        set out [lindex $patchlines $lineidx]

                        if {![string match ---* $in] || ![string match +++* $out]} {
                                puts $in
                                puts $out
                                return -code error "Patch not in unified diff format, line $lineidx $in $out"
                        }

                        # the quoting is compatible with list
                        lassign $in -> oldfile
                        lassign $out -> newfile

                        set fntopatch [file join $dir {*}[lrange [file split $newfile] $striplevel end]]
                        set inhunk false
                        #puts "Found diffline for $fntopatch"
                        continue
                }

                # state machine for parsing the hunks
                set typechar [string index $line 0]
                set codeline [string range $line 1 end]
                switch $typechar {
                        @ {
                                if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \
                                        -> oldstart oldlen newstart newlen]} {
                                        return code -error "Erroneous hunk in line $lindeidx, $line"
                                }
                                # adjust line numbers for 0-based indexing
                                incr oldstart -1
                                incr newstart -1
                                #puts "New hunk"
                                set newcode {}
                                set oldcode {}
                                set inhunk true
                        }
                        - { # line only in old code
                                if {$inhunk} {
                                        lappend oldcode $codeline
                                }
                        }
                        + { # line only in new code
                                if {$inhunk} {
                                        lappend newcode $codeline
                                }
                        }
                        " " { # common line
                                if {$inhunk} {
                                        lappend oldcode $codeline
                                        lappend newcode $codeline
                                }
                        }
                        default {
                                # puts "Junk: $codeline";
                                continue
                        }
                }
                # test if the hunk is complete
                if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} {
                        set hunk [dict create \
                                oldcode $oldcode \
                                newcode $newcode \
                                oldstart $oldstart \
                                newstart $newstart]
                        #puts "hunk complete: $hunk"
                        set inhunk false
                        dict lappend patchdict $fntopatch $hunk
                }
        }

        # now we have parsed the patch. Apply
        dict for {fn hunks} $patchdict {
                puts "Patching file $fn"
                if {[catch {open $fn} fd]} {
                        set orig {}
                } else {
                        set orig [split [read $fd] \n]
                }
                close $fd

                set patched $orig

                set fail false
                set already_applied false
                set hunknr 1
                foreach hunk $hunks {
                        dict with hunk {
                                set oldend [expr {$oldstart+[llength $oldcode]-1}]
                                set newend [expr {$newstart+[llength $newcode]-1}]
                                # check if the hunk matches
                                set origcode [lrange $orig $oldstart $oldend]
                                if {$origcode ne $oldcode} {
                                        set fail true
                                        puts "Hunk #$hunknr failed"
                                        # check if the patch is already applied
                                        set origcode_applied [lrange $orig $newstart $newend]
                                        if {$origcode_applied eq $newcode} {
                                                set already_applied true
                                                puts "Patch already applied"
                                        } else {
                                                puts "Expected:\n[join $oldcode \n]"
                                                puts "Seen:\n[join $origcode \n]"
                                        }
                                        break
                                }
                                # apply patch
                                set patched [list {*}[lrange $patched 0 $newstart-1] {*}$newcode {*}[lrange $patched $oldend+1 end]]
                        }
                        incr hunknr
                }

                if {!$fail} {
                        # success - write the result back
                        set fd [open $fn w]
                        puts -nonewline $fd [join $patched \n]
                        close $fd
                }
        }
}


======

<<categories>> Development