Eskil

#!/bin/sh
#
#   diff.tcl
#
#   Purpose
#             Graphical frontend to diff
#
#   Usage












#             Do 'diff.tcl' for interactive mode

















#             Do 'diff.tcl -h' for command line usage



#
#   Author    Peter Spjuth  980612
#
#   Revised   By       Date     Remark
#
#     1.0     DC-PS    980612   New Version.
#     1.1     DC-PS    980807   Parsing of change blocks added

#     1.7     DA-PS    000427   Restricted parsing of large blocks.
#                               Fixed bug with spaces in file names.
#                               Regular screen updates during processing.
#                               Added CVS support.
#     1.8     DA-PS    001115   Highlight current diff.
#                               New -conflict flag to handle merge conflicts.
#
#-----------------------------------------------
# $Revision$
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

set debug 1
set diffver "Version 1.8.4  2001-05-04"
set tmpcnt 0
set tmpfiles {}
set thisscript [file join [pwd] [info script]]
set thisdir [file dirname $thisscript]

if {$tcl_platform(platform) == "windows"} {
    cd $thisdir

    if {$::diffexe != "diff"} {
        file delete $::diffexe
    }
    cleartmp
    exit
}




# Format a line number
proc myforml {lineNo} {
    if {![string is integer -strict $lineNo]} {return "$lineNo\n"}
      return [format "%3d: \n" $lineNo]
}

proc maxabs {a b} {
    return [expr {abs($a) > abs($b) ? $a : $b}]
}

proc tmpfile {} {

    } else {
        insert 1 $doingLine1 $line1 change
        insert 2 $doingLine2 $line2 change
    }
    incr doingLine1
    incr doingLine2
}

# Returns number of lines used to display the blocks
proc insertMatchingBlocks {block1 block2} {
    global doingLine1 doingLine2

    set apa [compareblocks $block1 $block2]

    set t1 0
    set t2 0
    foreach c $apa {
        if {$c == "c"} {
            set textline1 [lindex $block1 $t1]
            set textline2 [lindex $block2 $t2]
            insertMatchingLines $textline1 $textline2
            incr t1
            incr t2
        }
        if {$c == "d"} {
            set bepa [lindex $block1 $t1]
            .ft1.tl insert end [myforml $doingLine1] \
                    "hl$::HighLightCount change"
            .ft1.tt insert end "$bepa\n" new1
            emptyline 2
            incr doingLine1
            incr t1
        }
        if {$c == "a"} {
            set bepa [lindex $block2 $t2]
            .ft2.tl insert end [myforml $doingLine2] \
                    "hl$::HighLightCount change"
            .ft2.tt insert end "$bepa\n" new2
            emptyline 1
            incr doingLine2
            incr t2
        }
    }
    return [llength $apa]
}

# Process one of the change/add/delete blocks reported by diff.
# ch1 is a file channel for the left file
# ch2 is a file channel for the right file
# n1/n2 is the number of lines involved
# line1/line2 says on what lines this block starts
proc dotext {ch1 ch2 n1 n2 line1 line2} {

                lappend block1 $apa
            }
            set block2 {}
            for {set t 0} {$t < $n2} {incr t} {
                gets $ch2 apa
                lappend block2 $apa
            }
            set apa [insertMatchingBlocks $block1 $block2]






























            lappend changesList $mapMax $apa change \
                    $line1 $n1 $line2 $n2
            incr mapMax $apa
        } else {
            for {set t 0} {$t < $n1} {incr t} {
                gets $ch1 apa
                insert 1 $doingLine1 $apa $tag1
                incr doingLine1
            }
            for {set t 0} {$t < $n2} {incr t} {

proc cleanupConflict {} {
    global diff Pref

    cleartmp
    set diff(rightFile) $diff(conflictFile)
    set diff(leftFile) $diff(conflictFile)
}

proc displayOnePatch {leftLines rightLines leftLine rightLine} {
    emptyline 1
    emptyline 2

    set leftlen [llength $leftLines]
    set rightlen [llength $rightLines]

    set leftc 0
    set rightc 0
    set lblock {}
    set lblockl 0
    set rblock {}
    set rblockl 0

    while {$leftc < $leftlen || $rightc < $rightlen} {
        foreach {lline lmode lstr} [lindex $leftLines $leftc] break
        foreach {rline rmode rstr} [lindex $rightLines $rightc] break

        # Fix the case where one side's block is empty.
        # That means that each line not marked should show up on both sides.
        if {$leftc >= $leftlen} {
            set lline $leftLine
            incr leftLine
            set lmode ""
            set lstr $rstr
        }
        if {$rightc >= $rightlen} {
            set rline $rightLine
            incr rightLine
            set rmode ""
            set rstr $lstr
        }

        # Treat the combination "-" and "+" as a "!"
        if {$lmode == "-" && $rmode == "+"} {
            set lmode "!"
            set rmode "!"
        }
        if {$lmode == "-" && [llength $lblock] > 0} {
            set lmode "!"
        }
        if {$rmode == "+" && [llength $rblock] > 0} {
            set rmode "!"
        }

        # If we are in a change block, gather up all lines
        if {$lmode == "!" || $rmode == "!"} {
            if {$lmode == "!"} {
                if {[llength $lblock] == 0} {
                    set lblockl $lline
                }
                lappend lblock $lstr
                incr leftc
            }
            if {$rmode == "!"} {
                if {[llength $rblock] == 0} {
                    set rblockl $rline
                }
                lappend rblock $rstr
                incr rightc
            }
            continue
        }
        # No change block anymore. If one just ended, display it.
        if {[llength $lblock] > 0 || [llength $rblock] > 0} {
            set ::doingLine1 $lblockl
            set ::doingLine2 $rblockl
            insertMatchingBlocks $lblock $rblock
            set lblock {}
            set rblock {}
        }
        if {$lmode == "" && $rmode == ""} {
            insert 1 $lline $lstr
            insert 2 $rline $rstr
            incr leftc
            incr rightc
            continue
        }
        if {$lmode == "-"} {
            insert 1 $lline $lstr new1
            emptyline 2
            incr leftc
            continue
        }
        if {$rmode == "+"} {
            insert 2 $rline $rstr new2
            emptyline 1
            incr rightc
            continue
        }
    }
}

# Read a patch file and display it
proc displayPatch {} {
    global diff Pref

    set ch [open $diff(patchFile) r]

    set style ""
    set divider "-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-"

    set leftLine 1
    set rightLine 1
    set leftLines {}
    set rightLines {}
    set state none
    while {[gets $ch line] != -1} {
        if {[string match ======* $line]} {
            if {$state != "none"} {
                displayOnePatch $leftLines $rightLines $leftLine $rightLine
            }
            set leftLines {}
            set rightLines {}
            set state none
            continue
        }
        # Detect the first line in a c style diff
        if {$state == "none" && [regexp {^\*\*\*} $line]} {
            set state newfile
            set style c
            set leftRE {^\*\*\*\s+(.*)$}
            set rightRE {^---\s+(.*)$}
        }
        # Detect the first line in a u style diff
        if {$state == "none" && [regexp {^---} $line]} {
            set state newfile
            set style u
            set leftRE {^---\s+(.*)$}
            set rightRE {^\+\+\+\s+(.*)$}
        }
        if {$state == "newfile" && [regexp $leftRE $line -> sub]} {
            emptyline 1
            insert 1 "" $divider
            insert 1 "" $sub
            insert 1 "" $divider
            continue
        }
        if {$state == "newfile" && [regexp $rightRE $line -> sub]} {
            emptyline 2
            insert 2 "" $divider
            insert 2 "" $sub
            insert 2 "" $divider
            continue
        }
        # A new section in a u style diff
        if {[regexp {^@@\s+-(\d+),\d+\s+\+(\d+),} $line -> sub1 sub2]} {
            if {$state == "both"} {
                displayOnePatch $leftLines $rightLines $leftLine $rightLine
            }
            set state both
            set leftLine $sub1
            set rightLine $sub2
            set leftLines {}
            set rightLines {}
            continue
        }
        # A new section in a c style diff
        if {[regexp {^\*\*\*\*\*} $line]} {
            if {$state == "right"} {
                displayOnePatch $leftLines $rightLines $leftLine $rightLine
            }
            set leftLines {}
            set rightLines {}
            set state left
            continue
        }
        # We are in the left part of a c style diff
        if {$state == "left"} {
            if {[regexp {^\*\*\*\s*(\d*)} $line -> sub]} {
                if {$sub != ""} {
                    set leftLine $sub
                }
                continue
            }
            if {[regexp {^---\s*(\d*)} $line -> sub]} {
                if {$sub != ""} {
                    set rightLine $sub
                }
                set state right
                continue
            }
            if {![regexp {^[\s!+-]} $line]} continue
            lappend leftLines [list $leftLine \
                    [string trim [string range $line 0 1]] \
                    [string range $line 2 end]]
            incr leftLine
            continue
        }
        # We are in the right part of a c style diff
        if {$state == "right"} {
            if {![regexp {^[\s!+-]} $line]} continue
            lappend rightLines [list $rightLine \
                    [string trim [string range $line 0 1]] \
                    [string range $line 2 end]]
            incr rightLine
            continue
        }
        # We are in a u style diff
        if {$state == "both"} {
            if {![regexp {^[\s+-]} $line]} continue
            set sig [string trim [string index $line 0]]
            set str [string range $line 1 end]
            if {$sig == ""} {
                lappend leftLines [list $leftLine "" $str]
                lappend rightLines [list $leftLine "" $str]
                incr leftLine
                incr rightLine
            } elseif {$sig == "-"} {
                lappend leftLines [list $leftLine "-" $str]
                incr leftLine
            } else {
                lappend rightLines [list $leftLine "+" $str]
                incr rightLine
            }
            continue
        }
    }
    close $ch

    set diff(leftLabel) "Patch $diff(patchFile): old"
    set diff(rightLabel) "Patch $diff(patchFile): new"
    update idletasks
}

# Prepare for RCS/CVS diff. Checkout copies of the versions needed.
proc prepareRCS {} {
    global diff Pref

    set revs {}
    set opts {}

    foreach w {.ft1.tl .ft1.tt .ft2.tl .ft2.tt} {
        $w configure -state normal
        $w delete 1.0 end
    }
    set changesList {}
    set mapMax 0
    set ::HighLightCount 0
    highLightChange -1

    update idletasks

    if {$diff(mode) == "patch"} {
        displayPatch
        drawMap -1
        foreach w {.ft1.tl .ft2.tl} {
            $w configure -state disabled
        }
        update idletasks
        .ft2.tl see 1.0
        normalCursor
        return
    } elseif {$diff(mode) == "RCS" || $diff(mode) == "CVS"} {
        prepareRCS
    } elseif {[string match "conflict*" $diff(mode)]} {
        prepareConflict
    }

    # Run diff and parse the result.
    set differr [catch {eval exec \$::diffexe $Pref(dopt) $Pref(ignore) \

    if {$::tcl_platform(platform) == "windows" && $Pref(crlf)} {
        fconfigure $ch1 -translation crlf
        fconfigure $ch2 -translation crlf
    }
    set doingLine1 1
    set doingLine2 1
    set t 0

    foreach i $result {
        if {![regexp {(.*)([acd])(.*)} $i -> l c r]} {
            .ft1.tt insert 1.0 "No regexp match for $i\n"
        } else {
            if {[regexp {([0-9]+),([0-9]+)} $l apa start stop]} {
                set n1 [expr {$stop - $start + 1}]
                set line1 $start

        set diff(mode) "conflict"
        set Pref(ignore) " "
        set diff(conflictFile) $diff(rightFile)
        set diff(mergeFile) ""
        doDiff
    }
}

proc openPatch {} {
    global diff
    if {[doOpenLeft]} {
        set diff(mode) "patch"
        set Pref(ignore) " "
        set diff(patchFile) $diff(leftFile)
        doDiff
    }
}

proc openRCS {} {
    global diff
    if {[doOpenRight]} {
        set diff(mode) "RCS"
        set diff(RCSFile) $diff(rightFile)
        set diff(leftLabel) "RCS"

    set gray 1.0
    set line ""
    set lines {}
    foreach {key value index} $tdump {
        if {$key == "tagon"} {
            if {$value == "change"} {
                set gray $::grayLevel1
            } elseif {[string match "new*" $value]} {
                set gray $::grayLevel2
            }
        } elseif {$key == "tagoff"} {
            if {$value == "change" || [string match "new*" $value]} {
                set gray 1.0
            }
        } elseif {$key == "text"} {
            append line $value
            if {[string index $value end] == "\n"} {
                set line [string trim [string trim $line] :]
                if {$line == ""} {
                    lappend lines ""
                } else {

                text {
                    set value [fixTextBlock $value $index]
                    if {[string index $value end] == "\n"} {
                        set newline 1
                        set value [string trimright $value "\n"]
                    }
                    set len [string length $value]
                    while {$chars + $len > 84} {
                        set wrap [expr {84 - $chars}]
                        set val1 [string range $value 0 [expr {$wrap - 1}]]
                        set value [string range $value $wrap end]
                        append line $val1
                        append line [linewrap $gray]
                        set chars 5
                        incr wrapc
                        set len [string length $value]

            puts $ch [lindex $wraplines2 $i2]
        }
        puts -nonewline $ch "\f"
    }

    close $ch

    if {$::tcl_platform(platform) == "windows" &&\
            ![info exists env(ENSCRIPT_LIBRARY)]} {
        set ::env(ENSCRIPT_LIBRARY) [pwd]
    }
    if {[catch {exec enscript -c -B -e -p $tmpFile2 $tmpFile} result]} {
        if {[string index $result 0] != "\["} {
            tk_messageBox -message "Enscript error: $result"
            return
        }
    }
    if {[catch {exec mpage -bA4 -a2 $tmpFile2 > $tmpFile3} result]} {
        tk_messageBox -message "Mpage error: $result"
        return
    }

    normalCursor
    if {!$quiet} {
        destroy .dp
        toplevel .dp
        wm title .dp "Diff Print"
        button .dp.b -text Close -command {destroy .dp}

        regsub -all "\t" $text "        " text
        .balloon.t$x configure -width [string length $text]
    }

    wm geometry .balloon +${wx}+${wy}
    update
    wm withdraw .balloon


    # Is the balloon within the diff window?
    set wid [winfo width .balloon]
    if {$wid + $wx > [winfo rootx .] + [winfo width .]} {
        # No.
        # Center on diff window
        set wx [expr {([winfo width .] - $wid) / 2 + [winfo rootx .]}]
        if {$wx < 0} {set wx 0}
        # Is the balloon not within the screen?
        if {$wx + $wid > [winfo screenwidth .]} {
            # Center in screen
            set wx [expr {([winfo screenwidth .] - $wid) / 2}]
            if {$wx < 0} {set wx 0}
        }

    }
            
    # Does the balloon fit within the screen?
    if {$wid > [winfo screenwidth .]} {
        # Add a row and fill screen width
        .balloon.t1 configure -height 2
        .balloon.t2 configure -height 2
        update idletasks
        wm geometry .balloon \
                [winfo screenwidth .]x[winfo reqheight .balloon]
        set wx 0
        set apa {
            set h [.balloon.t1 cget -height]
            incr h
            .balloon.t1 configure -height $h
            .balloon.t2 configure -height $h
            update idletasks
            wm geometry .balloon \
                    [winfo screenwidth .]x[winfo reqheight .balloon]
        }
        bind .balloon <Button-1> $apa
        bind . <Button-1> $apa
    }
    wm deiconify .balloon
    wm geometry .balloon +$wx+$wy
}

proc unzoomRow {} {
    destroy .balloon
    bind . <Button-1> ""
}

    }
    .mf.m add separator
    .mf.m add command -label "Open Both" -underline 0 -command {openBoth 0}
    .mf.m add command -label "Open Both (forget)" -command {openBoth 1}
    .mf.m add command -label "Open Left File" -command openLeft
    .mf.m add command -label "Open Right File" -command openRight
    .mf.m add command -label "Open Conflict File" -command openConflict
    .mf.m add command -label "Open Patch File" -command openPatch
    if {$tcl_platform(platform) == "unix"} {
        .mf.m add command -label "RCSDiff" -underline 0 -command openRCS
        .mf.m add command -label "CVSDiff" -underline 0 -command openCVS
    }
    .mf.m add separator
    .mf.m add command -label "Print" -underline 0 -command doPrint

    .mf.m add separator
    .mf.m add command -label "Quit" -command cleanupAndExit

    menubutton .mo -text Options -underline 0 -menu .mo.m
    menu .mo.m
    .mo.m add cascade -label Font -underline 0 -menu .mo.mf
    .mo.m add cascade -label Ignore -underline 0 -menu .mo.mi

.he.t insert end {3: } change {NET '/I$1/N$1456' } "" {IC2-13 } new1 {IC2-12  } "" {2: } change {NET '/I$1/N$1456' IC2-12
}
.he.t insert end {4: NET '/I$1/N$1457' IC2-11 IC6-7   3: NET '/I$1/N$1457' IC2-11 IC6-7
}
.he.t insert end {5: } change {NET '/I$1/N$1458' } "" {IC2-10} change {         } "" {4: } change {NET '/I$1/N$1458' } "" {IC2-9} change "\n"

}

proc printUsage {} {
    puts {Usage: diff.tcl [options] [file1] [file2]
  [options]              All options but the ones listed below
                         are passed to diff.
  [file1],[file2]        Files to be compared
                         If no files are given, the program is
                         started anyway and you can select files
                         from within.
                         If only one file is given, the program
                         looks for an RCS/CVS directory next to the
                         file, and if found, runs in RCS mode.
  Options:

  -nodiff   : Normally, if there are enough information on the
              command line to run diff, diff.tcl will do so unless
              this option is specified.

  -noparse  : Diff.tcl can perform analysis of changed blocks to
  -line     : improve display. See online help for details.
  -block    : The default is -block, but this can be slow if there
              are large change blocks.

  -char     : The analysis of changes can be done on either
  -word     : character or word basis. -char is the default.

  -2nd      : Turn on or off second stage parsing.
  -no2nd    : It is on by default.

  -conflict : Treat file as a merge conflict file and enter merge
              mode.
  -o <file> : Specify merge result output file. 

  -print <file> : Generate postscript and exit.
}
}

proc parseCommandLine {} {
    global diff Pref
    global argv argc tcl_platform

    set diff(leftOK) 0
    set diff(rightOK) 0

                set Pref(dopt) "$Pref(dopt) -r$arg"
            }
            set nextArg ""
            continue
        }
        if {$arg == "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg == "-h"} {
            printUsage
            exit
        } elseif {$arg == "-b"} {
            set Pref(ignore) "-b"
        } elseif {$arg == "-noignore"} {
            set Pref(ignore) " "
        } elseif {$arg == "-noparse"} {
            set Pref(parse) 0
        } elseif {$arg == "-line"} {

                after idle doDiff
            }
        } else {
            set diff(leftDir) $fulldir
            set diff(leftFile) $fullname
            set diff(leftLabel) $fullname
            set diff(leftOK) 1
            if {[string match "*.diff" $fullname]} {
                set diff(mode) "patch"
                set diff(patchFile) $fullname
                set autobrowse 0
                if {$noautodiff} {
                    enableRedo
                } else {
                    after idle doDiff
                }
            }   
        }
    } elseif {$len >= 2} {
        set fullname [file join [pwd] [lindex $files 0]]
        set fulldir [file dirname $fullname]
        set diff(leftDir) $fulldir
        set diff(leftFile) $fullname
        set diff(leftLabel) $fullname