Eskil

set thisScript [file join [pwd] [info script]]

proc busyCursor {} {
    global oldcursor oldcursor2
    if {![info exists oldcursor]} {
        set oldcursor [. cget -cursor]
        set oldcursor2 [.e1 cget -cursor]
    }
    . config -cursor watch
    foreach w {.e1 .e2} {
	$w config -cursor watch
    }
}

proc normalCursor {} {
    global oldcursor oldcursor2
    . config -cursor $oldcursor
    foreach w {.e1 .e2} {
	$w config -cursor $oldcursor2
    }
}

proc browse {varName} {
    upvar $varName file

    if {$file == ""} {
	set initdir [pwd]
    } else {
	set initdir [file dirname $file]
    }
    set apa [tk_getOpenFile -title "Select file" -initialdir $initdir]
    if {$apa != ""} {
	set file [file join $initdir $apa]
	cd [file dirname $file]
    }
}

proc doComp {{extra 0}} {
    global compRes file1 file2

    busyCursor
    update idletasks

    file stat $file1 stat1
    file stat $file2 stat2

    set compRes ""
    if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
	set compRes "Size&Time "
    }

    update idletasks

    set eqbut 0
    set bufsz 65536
    set eq 1
    set ch1 [open $file1 r]
    set ch2 [open $file2 r]
    fconfigure $ch1 -translation binary
    fconfigure $ch2 -translation binary
    while {![eof $ch1] && ![eof $ch2]} {
	set f1 [read $ch1 $bufsz]
	set f2 [read $ch2 $bufsz]
	if {![string equal $f1 $f2]} {
	    set eq 0
	    set len1 [string length $f1]
	    set len2 [string length $f2]
	    if {$len1 != $len2} {
		set len [expr {$len1 < $len2 ? $len1 : $len2}]
		if {[string equal -length $len $f1 $f2]} {
		    set eqbut [expr {$len1 < $len2 ? 2 : 1}]
		}
	    }
	    break
	}
    }
    if {([eof $ch1] + [eof $ch2]) < 2} {
	set eq 0
    }
    close $ch1
    close $ch2

    if {$eq} {
	append compRes Equal
    } else {
	append compRes "Not Equal"
    }

    if {$eqbut} {
	append compRes " but [expr {abs($stat1(size) - $stat2(size))}]($eqbut)"
    }
    
    if {!$extra || $eq || $eqbut} {
	normalCursor
	return
    }

    update idletasks
    set ch1 [open $file1 r]
    set ch2 [open $file2 r]
    fconfigure $ch1 -translation binary -buffersize 524288
    fconfigure $ch2 -translation binary -buffersize 524288
    set data1 [read $ch1]
    set data2 [read $ch2]
    close $ch1
    close $ch2
    set len1 [string length $data1]
    set len2 [string length $data2]
    
    if {$len1 < 2000 || $len2 < 2000} {
	normalCursor
	return
    }
    
    set mid1 [expr {$len1 / 2 - 500}]
    set midstr1 [string range $data1 $mid1 [expr {$mid1 + 999}]]
    set places {}
    for {set i2 0} {$i2 < $len2} {incr i2} {
	set i2 [string first $midstr1 $data2 $i2]
	if {$i2 == -1} break
	lappend places $i2
    }
    if {[llength $places] > 1} {
	append compRes " multiple parts"
    } elseif {[llength $places] == 1} {
	set i2 [lindex $places 0]
	append compRes " s"
	if {$mid1 < $i2} {
	    set start1 0
	    set start2 [expr {$i2 - $mid1}]
	} else {
	    set start1 [expr {$mid1 - $i2}]
	    set start2 0
	}
	if {($len1 - $mid1) > ($len2 - $i2)} {
	    set end1 [expr {$mid1 + ($len2 - $i2) - 1}]
	    set end2 [expr {$len2 - 1}]
	} else {
	    set end1 [expr {$len1 - 1}]
	    set end2 [expr {$i2 + ($len1 - $mid1) - 1}]
	}
	if {$end2 - $start2 != $end1 - $start1} {
	    append compRes " ($mid1=$i2 '$start1-$end1' '$start2-$end2')"
	}
	for {set s1 $start1 ; set s2 $start2} {$s1 < $mid1} {incr s1 1000 ; incr s2 1000} {
	    if {[string equal [string range $data1 $s1 [expr {$s1 + 999}]] \
		    [string range $data2 $s2 [expr {$s2 + 999}]]]} {
		break
	    }
	}
	for {set e1 $end1 ; set e2 $end2} {$e1 > $mid1} {incr e1 -1000 ; incr e2 -1000} {
	    if {[string equal [string range $data1 [expr {$e1 - 999}] $e1] \
		    [string range $data2 [expr {$e2 - 999}] $e2]]} {
		break
	    }
	}
	set eql [expr {$e1 - $s1 + 1}]
	append compRes " '$s1 - $e1' == '$s2 - $e2' ($eql)($len1)($len2)"
    } else {
	append compRes " no"
    }
    normalCursor
}

# File drop using TkDnd
proc fileDrop {var files} {
    set $var [lindex $files 0]
}

proc makeWin {} {
    global tcl_platform
    eval destroy [winfo children .]

    frame .fm

    menubutton .md -text Debug -menu .md.m -relief ridge
    menu .md.m
    if {$tcl_platform(platform) == "windows"} {
	.md.m add checkbutton -label Console -variable consolestate \
		-onvalue show -offvalue hide -command {console $consolestate}
	.md.m add separator
    }
    .md.m add command -label "Stack trace" -command {bgerror Debug}
    .md.m add separator
    .md.m add command -label "Reread Source" -command {source $thisScript}
    .md.m add separator
    .md.m add command -label "Redraw Window" -command {makeWin}
    .md.m add separator
    .md.m add command -label "Extra Comp" -command {doComp 1}
    
    pack .md -in .fm -side left

    button .bd -text Comp -command doComp
    label .l -textvariable compRes

    entry .e1 -width 50 -textvariable file1
    entry .e2 -width 50 -textvariable file2
    button .b1 -text Browse -command "browse file1"
    button .b2 -text Browse -command "browse file2"

    # Set up file dropping in entries if TkDnd is available
    if {![catch {package require tkdnd}]} {
        dnd bindtarget .e1 text/uri-list <Drop> {fileDrop ::file1 %D}
        dnd bindtarget .e2 text/uri-list <Drop> {fileDrop ::file2 %D}
    }

    grid .fm .l .bd -sticky wns
    grid .e1 -  .b1 -sticky news
    grid .e2 -  .b2 -sticky news
    grid .l .bd -sticky news
    grid columnconfigure . 1 -weight 1
}

if {![winfo exists .fm]} {
    makeWin
}

#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

set thisscript [file join [pwd] [info script]]
set thisdir [file dirname $thisscript]
set diffpath [file join $thisdir diff.tcl]
set debug 1

if {$tcl_platform(platform) == "windows"} {
    package require dde
}

proc doDiff {} {
    set f1 [file join $::thisdir clipdiffleft.tmp]
    set f2 [file join $::thisdir clipdiffright.tmp]

    set ch [open $f1 w]
    puts $ch [string trimright [.t1 get 1.0 end] \n]
    close $ch
    set ch [open $f2 w]
    puts $ch [string trimright [.t2 get 1.0 end] \n]
    close $ch

    remoteDiff $f1 $f2
}    

proc remoteDiff {file1 file2} {
    set cmd [list remoteDiff $file1 $file2]

    if {$::tcl_platform(platform) == "unix"} {
#	send -async Diff $cmd
        exec [info nameofexecutable] $::diffpath $file1 $file2 &
    } else {
	if {[catch {dde eval -async Diff $cmd}]} {
	    catch {exec [info nameofexecutable] $::diffpath -server &}
	    after 500
#	    catch {dde eval -async Diff $cmd}
	    dde eval -async Diff $cmd
	}
    }
}

proc makeWin {} {
    eval destroy [winfo children .]
    text .t1 -width 60 -height 35 \
	    -yscrollcommand {.sby1 set} -xscrollcommand {.sbx1 set}
    text .t2 -width 60 -height 35 \
	    -yscrollcommand {.sby2 set} -xscrollcommand {.sbx2 set}
    scrollbar .sbx1 -orient horiz -command {.t1 xview}
    scrollbar .sbx2 -orient horiz -command {.t2 xview}
    scrollbar .sby1 -orient vert  -command {.t1 yview}
    scrollbar .sby2 -orient vert  -command {.t2 yview}

    bind .t1 <Control-o> {focus .t2}
    bind .t2 <Control-o> {focus .t1}

    frame .f
    button .b -text Diff -command doDiff
    button .b2 -text "Left Clear" -command {.t1 delete 1.0 end}
    button .b3 -text "Right Clear" -command {.t2 delete 1.0 end}
    button .b4 -text "Left Clear&Paste" -command {.t1 delete 1.0 end ; event generate .t1 <<Paste>>}
    button .b5 -text "Right Clear&Paste" -command {.t2 delete 1.0 end ; event generate .t2 <<Paste>>}

    pack .b .b2 .b3 .b4 .b5 -in .f -side left

    if {$::debug == 1} {
        menubutton .md -text Debug -menu .md.m -relief ridge
        menu .md.m
        if {$::tcl_platform(platform) == "windows"} {
            .md.m add checkbutton -label Console -variable consolestate \
                    -onvalue show -offvalue hide -command {console $consolestate}
            .md.m add separator
        }
        .md.m add command -label "Stack trace" -command {bgerror Debug}
        .md.m add separator
        .md.m add command -label "Reread Source" -command {source $thisscript}
        .md.m add separator
        .md.m add command -label "Redraw Window" -command {makeWin}
        
        pack .md -in .f -side left
    }

    grid .f    -     -     -     -sticky w
    grid .t1   .sby1 .t2   .sby2 -sticky news
    grid .sbx1 x     .sbx2 x     -sticky we
    grid rowconfigure . 1 -weight 1
    grid columnconfigure . {0 2} -weight 1
}

if {![winfo exists .t1]} {
    makeWin
    update idletasks
}