Eskil

# 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

set debug 0
set diffver "Version 2.3+ 2008-01-18"
set ::thisScript [file join [pwd] [info script]]

# Do initalisations for needed packages and globals.
# This is not run until needed to speed up command line error reporting.
proc Init {} {
    package require Tk 8.4
    catch {package require textSearch}
    if {[catch {package require Ttk}]} {
        if {[catch {package require tile}]} {
            puts "Themed Tk not found"
            exit
        }
    }
    # 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
        }
    }
    ::snit::widgetadaptor entry {
        delegate method * to hull
        delegate option * to hull

        constructor {args} {
            installhull using ttk::entry
            $self configurelist $args
            # Make sure textvariable is initialised
            set varName [from args -textvariable ""]
            if {$varName ne ""} {
                upvar \#0 $varName var
                if {![info exists var]} {
                    set var ""
                }
            }
        }
        # 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
            }
        }
    }

    ::snit::widgetadaptor frame {
        delegate method * to hull
        # Fix since stuff that use -bd must work (like bgerror)
        delegate option -bd to hull as -borderwidth
        # Translate padding options, assuming x and y is always equal.
        delegate option -padx to hull as -padding
        delegate option -pady to hull as -padding
        delegate option * to hull

        constructor {args} {
            set cl [from args -class ""]
            if {$cl ne ""} {
                set hullargs [list -class $cl]
            } else {
                set hullargs {}
            }
            eval installhull using ttk::frame $hullargs
            $self configurelist $args
        }
    }
    ::snit::widgetadaptor labelframe {
        delegate method * to hull
        delegate option -bd to hull as -borderwidth
        delegate option -padx to hull as -padding
        delegate option -pady to hull as -padding
        delegate option * to hull

        constructor {args} {
            installhull using ttk::labelframe
            $self configurelist $args
        }
    }

    #interp alias {} frame {} ttk::frame
    interp alias {} toplevel {} ttk::toplevel
    #interp alias {} labelframe {} ttk::labelframe
    interp alias {} label {} ttk::label
    #interp alias {} entry {} ttk::entry ;# need to support xview end
    interp alias {} radiobutton {} ttk::radiobutton
    #interp alias {} menubutton {} ttk::menubutton ;# Enough with bg set
    interp alias {} checkbutton {} ttk::checkbutton
    interp alias {} button {} ttk::button

    package require wcb

    if {[catch {package require psballoon}]} {
        # Add a dummy if it does not exist.
        proc addBalloon {args} {}
    } else {

}

# 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} {





    entry $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 \
		{after idle {$w xview end} ;#}"
    }

    addBalloon $top.lr1 "Revision number for CVS/RCS/ClearCase diff."
    entry $top.er1 -width 12 -textvariable diff($top,doptrev1)
    set ::widgets($top,rev1) $top.er1
    label $top.lr2 -text "Rev 2"
    addBalloon $top.lr2 "Revision number for CVS/RCS/ClearCase diff."
    entry $top.er2 -width 12 -textvariable diff($top,doptrev2)
    set ::widgets($top,rev2) $top.er2
    button $top.bcm -text Commit -command [list revCommit $top] \
            -state disabled -underline 0
    set ::widgets($top,commit) $top.bcm
    button $top.bfp -text "Prev Diff" \
            -command [list findDiff $top -1] \
            -underline 0
    button $top.bfn -text "Next Diff" \
            -command [list findDiff $top 1] \
            -underline 0
    bind $top <Alt-n> [list findDiff $top 1]
    bind $top <Alt-p> [list findDiff $top -1]
    bind $top <Alt-c> [list revCommit $top]

    catch {font delete myfont}
    font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)

    fileLabel $top.l1 -textvariable diff($top,leftLabel)
    fileLabel $top.l2 -textvariable diff($top,rightLabel)

    frame $top.ft1 -borderwidth 2 -relief sunken
    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
    tk::frame $top.ft1.f -width 2 -height 2 -bg 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

    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
    tk::frame $top.ft2.f -width 2 -height 2 -bg 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
    commonYScroll $top.sby $top.ft1.tl $top.ft1.tt $top.ft2.tl $top.ft2.tt

    # Set up a tag for incremental search bindings
    if {[info procs textSearch::enableSearch] != ""} {
        textSearch::enableSearch $top.ft1.tt -label ::widgets($top,isearchLabel)
        textSearch::enableSearch $top.ft2.tt -label ::widgets($top,isearchLabel)
    }

    label $top.le -textvariable ::widgets($top,eqLabel) -width 1
    addBalloon $top.le "* means external diff is running.\n= means files do\
            not differ.\n! means a large block is being processed.\nBlank\
            means files differ."
    # FIXA: verify that this label is ok after Tile migration
    label $top.ls -width 1 \
            -textvariable ::widgets($top,isearchLabel)
    addBalloon $top.ls "Incremental search indicator"
    set map [createMap $top]

    applyColor
    foreach w [list $top.ft1.tt $top.ft2.tt] {
        # The last change in a row is underlined

    if {$debug == 0} {
        bind $top <Key> "backDoor %A"
    }

    pack $top.bfn -in $top.f -side right -padx {3 6}
    pack $top.bfp $top.bcm $top.er2 $top.lr2 $top.er1 $top.lr1 \
            -in $top.f -side right -padx 3
    pack $top.bfn $top.bfp $top.bcm -ipadx 15

    if {$debug == 1} {
        $top.m add cascade -label "Debug" -menu $top.m.md -underline 0
        menu $top.m.md
        if {$tcl_platform(platform) eq "windows"} {
            $top.m.md add checkbutton -label "Console" -variable consolestate \
                    -onvalue show -offvalue hide \
                    -command {console $consolestate}

        raise $w
        focus $w
    } else {
        toplevel $w -padx 3 -pady 3
        wm title $w "Preferences: Preprocess"
    }

    button $w.b -text "Add" -command [list AddPrefRegsub $top $w]

    # Result example part
    if {![info exists ::diff($top,prefregexa)]} {
        set ::diff($top,prefregexa) \
                "An example TextString FOR_REGSUB /* Comment */"
        set ::diff($top,prefregexa2) \
                "An example TextString FOR_REGSUB /* Comment */"

    set ::widgets($top,prefRegsubOk) $w.fb.b1

    grid $w.fb.b1 x $w.fb.b2 -sticky we
    grid columnconfigure $w.fb {0 2} -uniform a
    grid columnconfigure $w.fb 1 -weight 1

    # Top layout
    pack $w.b -side "top" -anchor "w" -padx 3 -pady 3 -ipadx 15
    pack $w.fb $w.res -side bottom -fill x -padx 3 -pady 3

    # Fill in existing or an empty line
    if {[llength $::Pref(regsub)] == 0} {
        AddPrefRegsub $top $w
    } else {
        set t 1