Eskil

# Compare two lines and rate how much they resemble each other.
# This has never worked well. Some day I'll sit down, think this through,
# and come up with a better algorithm.
proc CompareLines {line1 line2} {
    set opts $::Pref(ignore)
    if {$::Pref(nocase)} {lappend opts -nocase}
    set res [eval DiffUtil::diffStrings $opts \$line1 \$line2]

    # Collect identical pieces and different pieces
    set sames {}
    set diffs1 {}
    set diffs2 {}
    foreach {same1 same2 diff1 diff2} $res {
        lappend sames $same1

            set todoNow $todo
            set todo {}
            foreach node $todoNow {
                set status [$tree set $node status]
                if {$status eq "equal"} {
                    $tree delete $node
                } else {
                    eval lappend todo [$tree children $node]
                }
            }
        }
    }

    # Open or close all directories in the tree view
    method OpenAll {{state 1}} {
        set todo [$tree children {}]
        while {[llength $todo] > 0} {
            set todoNow $todo
            set todo {}
            foreach node $todoNow {
                set children [$tree children $node]
                if {[llength $children] > 0} {
                    $tree item $node -open $state
                    eval lappend todo $children
                }
            }
        }
    }

    # Copy a file from one directory to the other
    method CopyFile {node from} {

    grid $check.rb2 -sticky w -padx 3 -pady 3
    grid $check.rb3 -sticky w -padx 3 -pady 3
    grid columnconfigure $check {0 1 2} -uniform a -weight 1

    set opts [ttk::labelframe $top.opts -text "Options" -padding 3]
    ttk::checkbutton $opts.cb1 -variable TmpPref(dir,ignorekey) \
            -text "Ignore \$Keyword:\$"
    eval pack [winfo children $opts] -side top -anchor w 

    set filter [ttk::labelframe $top.filter -text "Filter" -padding 3]
    ttk::label $filter.l1 -text "Include Files" -anchor w
    ttk::entryX $filter.e1 -width 20 -textvariable TmpPref(dir,incfiles)
    ttk::label $filter.l2 -text "Exclude Files" -anchor w
    ttk::entryX $filter.e2 -width 20 -textvariable TmpPref(dir,exfiles)
    ttk::label $filter.l3 -text "Include Dirs" -anchor w

#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Tcl 8.4

# Stop Tk from meddling with the command line by copying it first.
set ::eskil(argv) $::argv
set ::eskil(argc) $::argc
set ::argv {}
set ::argc 0

    # Reportedly, the ttk scrollbar looks bad on Aqua
    if {[tk windowingsystem] ne "aqua"} {
        interp alias {} scrollbar {} ttk::scrollbar
    }
    # Provide a ttk-friendly toplevel, fixing background and menubar
    if {[info commands ttk::toplevel] eq ""} {
        proc ttk::toplevel {w args} {
            eval [linsert $args 0 tk::toplevel $w]
            place [ttk::frame $w.tilebg] -x 0 -y 0 -relwidth 1 -relheight 1
            # Menubar looks out of place on linux. This adjusts the background
            # Which is enough to make it reasonable.
            set bg [ttk::style configure . -background]
            option add *Menubutton.background $bg
            option add *Menu.background $bg
            return $w

        }
        # Circumvent a bug in ttk::entry that "xview end" does not work.
        method xview {args} {
            if {[llength $args] == 1} {
                set ix [lindex $args 0]
                $hull xview [$hull index $ix]
            } else {
                eval $hull xview $args
            }
        }
    }

    interp alias {} toplevel {} ttk::toplevel
}

        set ::diff(filterflag) 0
    }

    if {$Pref(parse) != 0} {
        set opts $Pref(ignore)
        if {$Pref(nocase)} {lappend opts -nocase}
        if {$Pref(lineparsewords)} {lappend opts -words}
        set res [eval DiffUtil::diffStrings $opts \$line1 \$line2]
        set dotag 0
        set n [expr {[llength $res] / 2}]
        $::widgets($top,wLine1) insert end [myFormL $doingLine1] \
                "hl$::HighLightCount change"
        $::widgets($top,wLine2) insert end [myFormL $doingLine2] \
                "hl$::HighLightCount change"
        set new1 "new1"

    }
    if {[info exists ::diff($top,rightFileDiff)]} {
        set dFile2 $::diff($top,rightFileDiff)
    } else {
        set dFile2 $::diff($top,rightFile)
    }

    set differr [catch {eval DiffUtil::diffFiles $opts \
            \$dFile1 \$dFile2} diffres]

    # In conflict mode we can use the diff information collected when
    # parsing the conflict file. This makes sure the blocks in the conflict
    # file become change-blocks during merge.
    if {$::diff($top,mode) eq "conflict" && $::diff($top,modetype) eq "Pure"} {
        set diffres $::diff($top,conflictDiff)
    }

proc myOpenFile {args} {
    # When in tutorial mode, make sure the Tcl file dialog is used
    # to be able to access the files in a starkit.
    if {[info exists ::diff(tutorial)] && $::diff(tutorial)} {
        # Only do this if tk_getOpenFile is not a proc.
        if {[info procs tk_getOpenFile] eq ""} {
            # If there is any problem, call the real one
            if {![catch {set res [eval ::tk::dialog::file:: open $args]}]} {
                return $res
            }
        }
    }
    return [eval tk_getOpenFile $args]
}

proc doOpenLeft {top {forget 0}} {
    if {!$forget && [info exists ::diff($top,leftDir)]} {
        set initDir $::diff($top,leftDir)
    } elseif {[info exists ::diff($top,rightDir)]} {
        set initDir $::diff($top,rightDir)

        }
        default {
            return -code error "Bad scrolldirection \"$dir\""
        }
    }

    ttk::frame $w
    eval [list $class $w.s] $args

    # Move border properties to frame
    set bw [$w.s cget -borderwidth]
    set relief [$w.s cget -relief]
    $w configure -relief $relief -borderwidth $bw
    $w.s configure -borderwidth 0

    set wl $::widgets($top,wLine$n)

    if {$hl eq ""} {
        set range [$wd tag ranges sel]
    } else {
        set range [$wl tag ranges hl$::diff($top,separate$n)]
    }
    set text [eval $wd get $range]
    set ::diff($top,separatetext$n) $text

    # Get the lines involved in the display
    set from [lindex $range 0]
    set to   [lindex $range 1]
    foreach {froml fromi} [split $from "."] break
    foreach {tol   toi}   [split $to   "."] break

}
# Emulate a label that:
# 1 : Displays the right part of the text if there isn't enough room
# 2 : Justfify text to the left if there is enough room.
# 3 : Does not try to allocate space according to its contents
proc fileLabel {w args} {
    ttk::entryX $w -style TLabel
    eval $w configure $args

    $w configure -takefocus 0 -state readonly ;#-readonlybackground $bg

    set i [lsearch $args -textvariable]
    if {$i >= 0} {
	set var [lindex $args [expr {$i + 1}]]
	uplevel \#0 "trace variable $var w \

# Build the main window
proc makeDiffWin {{top {}}} {
    global Pref tcl_platform debug

    if {$top != "" && [winfo exists $top] && [winfo toplevel $top] eq $top} {
        # Reuse the old window
        eval destroy [winfo children $top]
    } else {
        # Locate a free toplevel name
        if {[info exists ::diff(topDiffCnt)]} {
            set t $::diff(topDiffCnt)
        } else {
            set t 0
        }

    text $top.ft1.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft1.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx1 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    catch {$top.ft1.tt configure -tabstyle wordprocessor} ;# 8.5
    tk::frame $top.ft1.f -width 2 -height 2 -background lightgray
    pack $top.ft1.tl -side left -fill y
    pack $top.ft1.f -side left -fill y
    pack $top.ft1.tt -side right -fill both -expand 1
    scrollbar $top.sby -orient vertical
    scrollbar $top.sbx1 -orient horizontal -command [list $top.ft1.tt xview]
    set ::widgets($top,wLine1) $top.ft1.tl
    set ::widgets($top,wDiff1) $top.ft1.tt

    ttk::frame $top.ft2 -borderwidth 2 -relief sunken
    text $top.ft2.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft2.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx2 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    catch {$top.ft2.tt configure -tabstyle wordprocessor} ;# 8.5
    tk::frame $top.ft2.f -width 2 -height 2 -background lightgray
    pack $top.ft2.tl -side left -fill y
    pack $top.ft2.f -side left -fill y
    pack $top.ft2.tt -side right -fill both -expand 1
    scrollbar $top.sbx2 -orient horizontal -command [list $top.ft2.tt xview]
    set ::widgets($top,wLine2) $top.ft2.tl
    set ::widgets($top,wDiff2) $top.ft2.tt

    insertTaggedText $t $doc
    $t configure -state disabled
}

proc createDocFonts {} {
    if {[catch {font create docFont -family Helvetica -size -16}]} return
    eval font create docFontB [font configure docFont] -weight bold

    set h [font metrics docFont -linespace]
    set t [expr {-$h + 4}]
    font create docFontP -family Courier -size $t
    for {} {$t > -20} {incr t -1} {
        font configure docFontP -size $t
        if {[font metrics docFontP -linespace] >= $h} break

        if {[file exists $::diff($top,rightFile)] && \
                $::diff($top,rightFile) eq $::diff($top,rightLabel)} {
            lappend buttons Right
            append text "\nRight: $::diff($top,rightFile)"
        }
        lappend buttons Browse Cancel
        if {[llength $buttons] > 2} {
            set apa [eval tk_dialog .savemerge {"Save merge file"} \
                    \$text \
                    questhead -1 $buttons]
            if {$apa < 0} return
            set apa [lindex $buttons $apa]
            if {$apa eq "Left"} {
                set ::diff($top,mergeFile) $::diff($top,leftFile)
            } elseif {$apa eq "Right"} {
                set ::diff($top,mergeFile) $::diff($top,rightFile)
            } elseif {$apa eq "Cancel"} {

# Create a window to display merge result.
proc makeMergeWin {top} {
    set w $top.merge
    if {![winfo exists $w]} {
        toplevel $w
    } else {
        eval destroy [winfo children $w]
    }

    wm title $w "Merge result"

    ttk::frame $w.f

    ttk::radiobutton $w.f.rb1 -text "LR" -value 12 \

        lappend enscriptCmd "--header=$lfile|Page \$% of \$=|$rfile"
        if {$::diff(prettyPrint) != ""} {
            lappend enscriptCmd -E$::diff(prettyPrint)
        }
        lappend enscriptCmd -p $tmpFile2 $tmpFile

        if {[catch {eval exec $enscriptCmd} result]} {
            if {[string index $result 0] != "\["} {
                tk_messageBox -message "Enscript error: $result\ncmd: $enscriptCmd"
                return
            }
        }
    }