Eskil

#!/bin/sh
#
#   diff.tcl
#
#   Purpose
#             Graphical frontend to diff
#
#   Usage
#             diff.tcl [diff options] [file1] [file2]
#
#             [diff options]         Options 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 directory next to the
#                                    file, and if found, runs rcsdiff.
#
#   Author    Peter Spjuth  980612
#
#   Revised   By       Date     Remark
#
#     1.0     DC-PS    980612   New Version.
#
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

proc myform {line text} {
    return [format "%3d: %s\n" $line $text]
}

proc myforml {line} {
    return [format "%3d: " $line]
}

proc comparelines {line1 line2 res1var res2var} {
    upvar $res1var res1
    upvar $res2var res2

    #Delete white space in both ends
    set apa1 [string trimleft $line1]
    set left1 [string range $line1 0 [expr [string length $line1] - [string length $apa1] - 1]]
    set mid1 [string trimright $apa1]
    set right1 [string range $apa1 [string length $mid1] end]

    set apa2 [string trimleft $line2]
    set left2 [string range $line2 0 [expr [string length $line2] - [string length $apa2] - 1]]
    set mid2 [string trimright $apa2]
    set right2 [string range $apa2 [string length $mid2] end]

    #Move matching left chars to left string.
    set len1 [string length $mid1]
    set len2 [string length $mid2]
    set len [expr $len1 < $len2 ? $len1 : $len2]

    for {set t 0} {$t < $len} {incr t} {
        if {[string index $mid1 $t] != [string index $mid2 $t]} {
            break
        }
    }
    set u [expr $t - 1]
    set left1 ${left1}[string range $mid1 0 $u]
    set mid1 [string range $mid1 $t end]
    set left2 ${left2}[string range $mid2 0 $u]
    set mid2 [string range $mid2 $t end]

    #Move matching right chars to right string.
    set len1 [string length $mid1]
    set len2 [string length $mid2]

    set t1 [expr $len1 - 1]
    set t2 [expr $len2 - 1]

    for {} {$t1 >= 0 && $t2 >= 0} {incr t1 -1;incr t2 -1} {
        if {[string index $mid1 $t1] != [string index $mid2 $t2]} {
            break
        }
    }
    set u1 [expr $t1 + 1]
    set u2 [expr $t2 + 1]
    set right1 [string range $mid1 $u1 end]$right1
    set mid1 [string range $mid1 0 $t1]
    set right2 [string range $mid2 $u2 end]$right2
    set mid2 [string range $mid2 0 $t2]

    if {$len1 == 0} {
        set res1 [list $left1$right1]
    } else {
        set res1 [list $left1 $mid1 $right1]
    }
    if {$len2 == 0} {
        set res2 [list $left1$right1]
    } else {
        set res2 [list $left2 $mid2 $right2]
    }
}

proc dotext {ch1data ch2 tag1 tag2 n1 n2 line1 line2} {
    global  doingLine1 doingLine2

    if {$n1 == 0 && $n2 == 0} {
        while {[gets $ch2 apa] != -1} {
            .t2 insert end [myform $doingLine2 $apa]
            incr doingLine2
            .t1 insert end [myform $doingLine1 $apa]
            incr doingLine1
        }
        return
    }

    while {$doingLine1 < $line1} {
        gets $ch2 apa
        .t1 insert end [myform $doingLine1 $apa]
        incr doingLine1
        .t2 insert end [myform $doingLine2 $apa]
        incr doingLine2
    }
    if {$doingLine2 != $line2} {
        .t1 insert end "**Bad alignment here!! $doingLine2 $line2**\n"
        .t2 insert end "**Bad alignment here!! $doingLine2 $line2**\n"
    }

    if {$n1 == $n2} {
        for {set t 0} {$t < $n1} {incr t} {
            set line1 [lindex $ch1data $t]
            gets $ch2 line2
            comparelines $line1 $line2 res1 res2
            set dotag 0
            .t1 insert end [myforml $doingLine1] $tag1
            foreach i $res1 {
                if {$dotag} {
                    .t1 insert end $i $tag1
                    set dotag 0
                } else {
                    .t1 insert end $i
                    set dotag 1
                }
            }
            .t1 insert end "\n"

            set dotag 0
            .t2 insert end [myforml $doingLine2] $tag2
            foreach i $res2 {
                if {$dotag} {
                    .t2 insert end $i $tag2
                    set dotag 0
                } else {
                    .t2 insert end $i
                    set dotag 1
                }
            }
            .t2 insert end "\n"
            incr doingLine1
            incr doingLine2
        }
    } else {
        for {set t 0} {$t < $n1} {incr t} {
            set apa [lindex $ch1data $t]
            .t1 insert end [myform $doingLine1 $apa] $tag1
            incr doingLine1
        }
        for {set t 0} {$t < $n2} {incr t} {
            gets $ch2 apa
            .t2 insert end [myform $doingLine2 $apa] $tag2
            incr doingLine2
        }
    }
    if {$n1 < $n2} {
        for {set t $n1} {$t < $n2} {incr t} {
            .t1 insert end "\n"
        }
    } elseif {$n2 < $n1} {
        for {set t $n2} {$t < $n1} {incr t} {
            .t2 insert end "\n"
        }
    }
}

proc findNext {} {
    set i [.t1 index @0,0+1line]
    set n1 [.t1 tag nextrange new $i]
    set c1 [.t1 tag nextrange change $i]
    set i [.t2 index @0,0+1line]
    set n2 [.t2 tag nextrange new $i]
    set c2 [.t2 tag nextrange change $i]

    set apa [lsort -dictionary "$n1 $c1 $n2 $c2"]

    if {[llength $apa] != 0} {
        .t1 yview [lindex $apa 0]
        .t2 yview [lindex $apa 0]
    } else {
        .t1 yview end
        .t2 yview end
    }
}

proc enableRedo {} {
    .mf.m entryconfigure 1 -state normal
}

proc disableRedo {} {
    .mf.m entryconfigure 1 -state disabled
}

proc busyCursor {} {
    global oldcursor oldcursor2
    set oldcursor [. cget -cursor]
    set oldcursor2 [.t1 cget -cursor]
    . config -cursor watch
    .t1 config -cursor watch
    .t2 config -cursor watch
}

proc normalCursor {} {
    global oldcursor oldcursor2
    . config -cursor $oldcursor
    .t1 config -cursor $oldcursor2
    .t2 config -cursor $oldcursor2
}

proc time1 {} {
    global tid1
    set tid1 [clock clicks]
}

proc time2 {} {
    global tid1
    set tid2 [clock clicks]
    puts "[expr {$tid2 - $tid1}]"
}

proc doDiff {} {
    global leftFile rightFile leftOK rightOK
    global eqLabel ignorePref RCS MiscPref doingLine1 doingLine2
    global difflines

    if {$RCS == 0 && ($leftOK == 0 || $rightOK == 0)} {
        disableRedo
        return
    } else {
        enableRedo
    }

    busyCursor

    .t1 delete 1.0 end
    .t2 delete 1.0 end
    set difflines {}
    update idletasks

    if {$RCS} {
        set differr [catch {eval exec rcsdiff $MiscPref $ignorePref $rightFile} diffres]
    } else {
        set differr [catch {eval exec diff $MiscPref $ignorePref $leftFile $rightFile} diffres]
    }

    time1

    set apa [split $diffres "\n"]
    set result {}
    set result2 {}
    foreach i $apa {
        if {[string match {[0-9]*} $i]} {
            lappend result $i
        }
        if {[string match {<*} $i]} {
            lappend result2 [string range $i 2 end]
        }
    }

    if {[llength $result] == 0} {
        if {$differr == 1} {
            .t1 insert end $diffres
            normalCursor
            return
        } else {
            set eqLabel "="
        }
    } else {
        set eqLabel " "
    }

    set t2 0
    set ch2 [open $rightFile]
    set doingLine1 1
    set doingLine2 1

    foreach i $result {
        if {![regexp {(.*)([acd])(.*)} $i apa l c r]} {
            .t1 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
            } else {
                set n1 1
                set line1 $l
            }
            if {[regexp {([0-9]+),([0-9]+)} $r apa start stop]} {
                set n2 [expr $stop - $start + 1]
                set line2 $start
            } else {
                set n2 1
                set line2 $r
            }
            switch $c {
                a {
                    # lucka i left, new i right
                    lappend difflist "new [.t1 index end] $n2"
                    dotext "" $ch2 "" new 0 $n2 [expr $line1 +1] $line2
                } c {
                    set apa [lrange $result2 $t2 [expr $t2 + $n1 - 1]]
                    incr t2 $n1
                    if {$n1 > $n2} {
                        lappend difflist "change [.t1 index end] $n1"
                    } else {
                        lappend difflist "change [.t1 index end] $n2"
                    }
                    dotext $apa $ch2 change change $n1 $n2 $line1 $line2
                } d {
                    # lucka i right, new i left
                    set apa [lrange $result2 $t2 [expr $t2 + $n1 - 1]]
                    incr t2 $n1
                    lappend difflist "new [.t1 index end] $n1"
                    dotext $apa $ch2 new "" $n1 0 $line1 [expr $line2 +1]
                }
            }
        }
    }

    dotext "" $ch2 "" "" 0 0 0 0

    close $ch2
    normalCursor
    time2
}

proc doOpenLeft {} {
    global leftFile leftDir rightDir leftOK
    if {![info exists leftDir]} {
        if {[info exists rightDir]} {
            set leftDir $rightDir
        } else {
            set leftDir [pwd]
        }
    }
    set apa [tk_getOpenFile -title "Select left file" -initialdir $leftDir]
    if {$apa != ""} {
	set leftDir [file dirname $apa]
	set leftFile $apa
        set leftOK 1
        return 1
    }
    return 0
}

proc doOpenRight {} {
    global rightFile rightDir leftDir rightOK
    if {![info exists rightDir]} {
        if {[info exists leftDir]} {
            set rightDir $leftDir
        } else {
            set rightDir [pwd]
        }
    }
    set apa [tk_getOpenFile -title "Select right file" -initialdir $rightDir]
    if {$apa != ""} {
        set rightDir [file dirname $apa]
        set rightFile $apa
        set rightOK 1
        return 1
    }
    return 0
}

proc openLeft {} {
    global RCS
    if {[doOpenLeft]} {
        set RCS 0
        doDiff
    }
}

proc openRight {} {
    global RCS
    if {[doOpenRight]} {
        set RCS 0
        doDiff
    }
}

proc openRCS {} {
    global RCS leftFile leftOK
    if {[doOpenRight]} {
        set RCS 1
        set leftFile "RCS"
        set leftOK 0
        doDiff
    }
}

proc openBoth {} {
    global RCS
    if {[doOpenLeft]} {
        if {[doOpenRight]} {
            set RCS 0
            doDiff
        }
    }
}

proc my_yview args {
    eval .t1 yview $args
    eval .t2 yview $args
}

proc chFont {} {
    global fontsize

    font configure myfont -size $fontsize
#    .t1 configure -font "Courier $fontsize"
#    .t2 configure -font "Courier $fontsize"
}

proc makeDiffWin {} {
    global fontsize ignorePref tcl_platform
    eval destroy [winfo children .]

    frame .f
    grid .f - - -row 0 -sticky news

    menubutton .mf -text File -underline 0 -menu .mf.m
    menu .mf.m
    .mf.m add command -label "Redo Diff" -underline 5 -command doDiff -state disabled
    .mf.m add separator
    .mf.m add command -label "Open Both" -underline 0 -command openBoth
    .mf.m add command -label "Open Left File" -command openLeft
    .mf.m add command -label "Open Right File" -command openRight
    if {$tcl_platform(platform) == "unix"} {
        .mf.m add command -label "RCSDiff" -underline 0 -command openRCS
    }
    .mf.m add separator
    .mf.m add command -label "Quit" -command exit

    menubutton .ms -text Fontsize -underline 4 -menu .ms.m
    menu .ms.m
    .ms.m add radiobutton -label 6 -variable fontsize -value 6 -command chFont
    .ms.m add radiobutton -label 7 -variable fontsize -value 7 -command chFont
    .ms.m add radiobutton -label 8 -variable fontsize -value 8 -command chFont
    .ms.m add radiobutton -label 9 -variable fontsize -value 9 -command chFont
    .ms.m add radiobutton -label 10 -variable fontsize -value 10 -command chFont
    set fontsize 9

    menubutton .mi -text Ignore -underline 0 -menu .mi.m
    menu .mi.m
    .mi.m add radiobutton -label "Nothing" -variable ignorePref -value ""
    .mi.m add radiobutton -label "Space changes (-b)" -variable ignorePref -value "-b"
    .mi.m add radiobutton -label "All spaces (-w)" -variable ignorePref -value "-w"
    set ignorePref "-b"

    menubutton .mh -text Help -underline 0 -menu .mh.m
    menu .mh.m
    .mh.m add command -label "About" -command makeAboutWin

    button .bfn -text "Next Diff" -relief raised -command findNext
    entry .eo -width 10 -textvariable MiscPref
    label .lo -text "Diff Options"

    font create myfont -family courier -size $fontsize

    label .l1 -textvariable leftFile -anchor e -width 10
    label .l2 -textvariable rightFile -anchor e -width 10
    text .t1 -height 40 -width 60 -wrap none -yscrollcommand ".sby set" \
	    -xscrollcommand ".sbx1 set" -font myfont
    scrollbar .sby -orient vertical -command "my_yview"
    scrollbar .sbx1 -orient horizontal -command ".t1 xview"
    text .t2 -height 40 -width 60 -wrap none \
	    -xscrollcommand ".sbx2 set" -font myfont
    scrollbar .sbx2 -orient horizontal -command ".t2 xview"
    label .le -textvariable eqLabel -width 1

    .t1 tag configure new -foreground blue -background gray 
    .t1 tag configure change -foreground red -background gray
    .t2 tag configure new -foreground blue -background gray
    .t2 tag configure change -foreground red -background gray
    
    grid .l1 .le .l2 -row 1 -sticky news
    grid .t1 .sby .t2 -row 2 -sticky news
    grid .sbx1 x .sbx2 -row 3 -sticky news
    grid columnconfigure . {0 2} -weight 1
    grid rowconfigure . 2 -weight 1

    pack .mf .ms .mi .mh -in .f -side left
    pack .bfn .eo .lo -in .f -side right
}

proc makeAboutWin {} {
    destroy .ab

    toplevel .ab
    wm title .ab "About"
    text .ab.t -width 45 -height 8 -wrap word
    button .ab.b -text "Close" -command "destroy .ab"
    pack .ab.b -side bottom
    pack .ab.t -side top -expand y -fill both
    
    .ab.t insert end "A Tcl/Tk frontend to diff\n\n"
    .ab.t insert end "Made by Peter Spjuth\n"
    .ab.t insert end "E-Mail: peter.spjuth@space.se\n\n"

}

proc parseCommandLine {} {
    global argv argc MiscPref ignorePref 
    global rightDir rightFile rightOK leftDir leftFile leftOK RCS

    set leftOK 0
    set rightOK 0
    set RCS 0

    if {$argc == 0} return

    set files ""
    foreach arg $argv {
        if {$arg == "-w"} {
            set ignorePref "-w"
        } elseif {$arg == "-b"} {
            set ignorePref "-b"
        } elseif {[string range $arg 0 0] == "-"} {
            set MiscPref "$MiscPref $arg"
        } else {
            set apa [glob -nocomplain $arg]
            if {$apa == ""} {
                puts "Ignoring argument: $arg"
            } else {
                lappend files $apa
            }
        }
    }

    set len [llength $files]
    if {$len == 1} {
        set fullname [file join [pwd] $files]
        set fulldir [file dirname $fullname]
        if {[glob -nocomplain [file join $fulldir RCS]] != ""} {
            set RCS 1
            set rightDir $fulldir
            set rightFile $fullname
            set rightOK 1
            set leftFile "RCS"
            doDiff
        } else {
            set leftDir $fulldir
            set leftFile $fullname
            set leftOK 1
        }
    } elseif {$len >= 2} {
        set fullname [file join [pwd] [lindex $files 0]]
        set fulldir [file dirname $fullname]
        set leftDir $fulldir
        set leftFile $fullname
        set leftOK 1
        set fullname [file join [pwd] [lindex $files 1]]
        set fulldir [file dirname $fullname]
        set rightDir $fulldir
        set rightFile $fullname
        set rightOK 1
        doDiff
    }
}

makeDiffWin
parseCommandLine