Eskil

# cleanupAndExit can be used to get rid of it.
proc eskilRegisterToplevel {top} {
    lappend ::eskil(diffWindows) $top
}

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

# Get a name for a temporary file
# A tail can be given to make the file more recognisable.
proc tmpFile {{tail {}}} {
    if {[info exists ::tmpcnt]} {

    set name [file join $::eskil(tmpdir) $name]
    lappend ::tmpfiles $name
    return $name
}

# Delete temporary files
proc clearTmp {args} {
    if {![info exists ::tmpfiles]} {
    if { ! [info exists ::tmpfiles]} {
        set ::tmpfiles {}
        return
    }
    if {[llength $args] > 0} {
        foreach f $args {
            set i [lsearch -exact $::tmpfiles $f]
            if {$i >= 0} {

# insertLine, when in table mode
proc insertLineTable {top side line text {tag equal}} {
    set RE $::eskil($top,separator)
    set words [split $text $RE]
    set id [$::widgets($top,wTable) insert end $words]
    if {$tag ne "equal"} {
        set col 0
        foreach w $words {
        foreach word $words {
            if {$side == 1} {
                # TBD TABLE, r is faked here for now
                dict set ::eskil($top,tablechanges) $id,$col w1 $w
                dict set ::eskil($top,tablechanges) $id,$col w1 $word
                dict set ::eskil($top,tablechanges) $id,$col w2 ""
                dict set ::eskil($top,tablechanges) $id,$col r  "0 0 1 1"
            } else {
                dict set ::eskil($top,tablechanges) $id,$col w1 ""
                dict set ::eskil($top,tablechanges) $id,$col w2 $w
                dict set ::eskil($top,tablechanges) $id,$col w2 $word
                dict set ::eskil($top,tablechanges) $id,$col r  "0 0 1 1"
            }
            incr col
        }
    }
}

    }
    #puts "RES   '$res'"
    return $res
}

# This is called from the table view whenever a cell is drawn.
# Add color as needed.
proc tblModeColorCallback {win w key row col tabIdx1 tabIdx2 inStripe selected} {
proc tblModeColorCallback {win W key row col tabIdx1 tabIdx2 inStripe selected} {
    set cellX $key,$col
    set top [winfo toplevel $win]
    if {![dict exists $::eskil($top,tablechanges) $cellX]} {
    if { ! [dict exists $::eskil($top,tablechanges) $cellX]} {
        # No changes, nothing to do here
        return
    }
    set cinfo [dict get $::eskil($top,tablechanges) $cellX]
    set w1 [dict get $cinfo w1]
    set w2 [dict get $cinfo w2]

    #puts "COLOR UPDATE W $win K $key R $row C $col TB1 $tabIdx1 TB2 $tabIdx2"
    #puts "   [string length $xxx] '$xxx'"
    #puts "   CHANGEME"

    # Currently the displayed string is just $w1$w2
    # The table might have cut of display of a cell so make sure to stay
    # within the boundaries.
    set txIdx1 [$w index $tabIdx1+1c]
    set txIdx1 [$W index $tabIdx1+1c]
    set l1 [string length $w1]
    set mid "$txIdx1 + $l1 char"
    if {[$w compare $mid >= $tabIdx2]} {
    if {[$W compare $mid >= $tabIdx2]} {
        set mid $tabIdx2
    }
    $w tag add new1 $txIdx1 $mid
    $w tag add new2 $mid    $tabIdx2
    $W tag add new1 $txIdx1 $mid
    $W tag add new2 $mid    $tabIdx2

    # Get the displayed string
    set xxx [$w get $txIdx1 $tabIdx2]
    set xxx [$W get $txIdx1 $tabIdx2]
    if {$xxx ne "$w1$w2"} {
        # Make sure dots are coloured
        $w tag add change "$tabIdx2 - 3c" $tabIdx2
        $W tag add change "$tabIdx2 - 3c" $tabIdx2
    }
}

# insertMatchingLines, when in table mode
proc insertMatchingLinesTable {top line1 line2} {
    global doingLine1 doingLine2

            set block1nostar [string map {* {}} $block1nospace]
            set block2nostar [string map {* {}} $block2nospace]
            if {$block1nostar eq $block2nostar} {
                set equal 1
            }
        }
    }
    if {!$equal} {
    if { ! $equal} {
        return 0
    }

    if {$visible} {
        set tag change
    } else {
        set tag {}

                if {$::eskil($top,ancestorRight,$t) eq "c"} {
                    set rightChange 1
                    break
                }
            }
        }
        # Avoid fine grain if either side has no changes against ancestor
        if {!$leftChangeOrAdd || !$rightChangeOrAdd} {
        if { ! $leftChangeOrAdd || !$rightChangeOrAdd} {
            set finegrain 0
        }
        # Avoid fine grain if both sides have at most additions
        if {!$leftChange && !$rightChange} {
        if { ! $leftChange && !$rightChange} {
            set finegrain 0
        }
    }

    set t1 0
    set t2 0
    foreach c $apa {

                addChange $top 1 new2 [expr {$line1 + $t1}] 0 \
                        [expr {$line2 + $t2}] 1
                nextHighlight $top
            }
            incr t2
        }
    }
    if {!$finegrain} {
    if { ! $finegrain} {
        if {$details} {
            addChange $top [llength $apa] change $line1 $n1 $line2 $n2
            nextHighlight $top
        } else {
            addMapLines $top [llength $apa]
        }
    }

proc busyCursor {top} {
    global oldcursor oldcursor2
    if {$::eskil($top,view) eq "table"} {
        set items wTable
    } else {
        set items {wLine1 wDiff1 wLine2 wDiff2}
    }
    if {![info exists oldcursor]} {
    if { ! [info exists oldcursor]} {
        set oldcursor [$top cget -cursor]
        set i1 [lindex $items 0]
        set oldcursor2 [$::widgets($top,$i1) cget -cursor]
    }
    $top config -cursor watch
    foreach item $items {
        if {[info exists ::widgets($top,$item)]} {
            set w $::widgets($top,$item)
            $w config -cursor watch
            set W $::widgets($top,$item)
            $W config -cursor watch
        }
    }
}

proc normalCursor {top} {
    global oldcursor oldcursor2
    if {$::eskil($top,view) eq "table"} {
        set items wTable
    } else {
        set items {wLine1 wDiff1 wLine2 wDiff2}
    }
    $top config -cursor $oldcursor
    foreach item $items {
        if {[info exists ::widgets($top,$item)]} {
            set w $::widgets($top,$item)
            $w config -cursor $oldcursor2
            set W $::widgets($top,$item)
            $W config -cursor $oldcursor2
        }
    }
}

#####################################
# Special cases.  Conflict/patch
#####################################

            if {[regexp {^---\s*(\d*)} $line -> sub]} {
                if {$sub != ""} {
                    set rightLine $sub
                }
                set state right
                continue
            }
            if {![regexp {^[\s!+-]} $line]} 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 eq "right"} {
            if {![regexp {^[\s!+-]} $line]} continue
            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 eq "both"} {
            if {![regexp {^[\s+-]} $line]} continue
            if { ! [regexp {^[\s+-]} $line]} continue
            set sig [string trim [string index $line 0]]
            set str [string range $line 1 end]
            if {$sig eq ""} {
                lappend leftLines [list $leftLine "" $str]
                lappend rightLines [list $rightLine "" $str]
                incr leftLine
                incr rightLine

#####################################
# Main diff
#####################################

proc highlightTabs {top} {
    foreach item {wDiff1 wDiff2} {
        set w $::widgets($top,$item)
        ##nagelfar vartype w _obj,text
        set W $::widgets($top,$item)
        ##nagelfar vartype W _obj,text
        set count {}
        set x [$w search -regexp -all -count count {\t+} 1.0]
        set x [$W search -regexp -all -count count {\t+} 1.0]
        foreach si $x l $count {
            $w tag add tab $si "$si + $l chars"
            $W tag add tab $si "$si + $l chars"
        }
        $w tag configure tab -background bisque
        $w tag raise tab
        $W tag configure tab -background bisque
        $W tag raise tab
    }
}

# Prepare for a diff by creating needed temporary files
proc prepareFiles {top} {
    set ::eskil($top,cleanup) {}
    if {$::eskil($top,mode) eq "rev"} {

        # TBD TABLE
        doDiff $top
        # Restore view
        return
    }

    # Note what rows are being displayed
    set w $::widgets($top,wDiff1)
    set W $::widgets($top,wDiff1)

    set width  [winfo width $w]
    set height [winfo height $w]
    set width  [winfo width $W]
    set height [winfo height $W]

    set first [$w index @0,0]
    set last  [$w index @[- $width 4],[- $height 4]]
    set first [$W index @0,0]
    set last  [$W index @[- $width 4],[- $height 4]]

    set first [lindex [split $first .] 0]
    set last  [lindex [split $last  .] 0]

    # Narrow it 5 lines since seeText will try to view 5 lines extra
    incr first 5
    incr last -5
    if {$last < $first} {
        set last $first
    }

    doDiff $top

    # Restore view
    foreach item {wLine1 wDiff1 wLine2 wDiff2} {
        set w $::widgets($top,$item)
        seeText $w $first.0 $last.0
        set W $::widgets($top,$item)
        seeText $W $first.0 $last.0
    }
}

# Make an appropriate tail for a window title, depending on mode and files.
proc TitleTail {top} {
    set tail1 [file tail $::eskil($top,rightLabel)]
    set tail2 [file tail $::eskil($top,leftLabel)]

    }

    busyCursor $top
    resetEdit $top

    # Clear up everything before starting processing
    if {$::eskil($top,view) eq "table"} {
        set w $::widgets($top,wTable)
        set W $::widgets($top,wTable)
        # TBD TABLE
        $w configure -state normal
        $w delete 0 end
        $W configure -state normal
        $W delete 0 end
        set ::eskil($top,tablechanges) {}
    } else {
        foreach item {wLine1 wDiff1 wLine2 wDiff2 wTb} {
            set w $::widgets($top,$item)
            $w configure -state normal
            $w delete 1.0 end
            set W $::widgets($top,$item)
            $W configure -state normal
            $W delete 1.0 end
        }
    }
    clearMap $top
    set ::HighLightCount 0
    highLightChange $top -1
    # Display a star during diff execution, to know when the internal
    # processing starts, and when the label is "valid".
    set ::widgets($top,eqLabel) "*"

    wm title $top "Eskil:"
    update idletasks

    if {$::eskil($top,mode) eq "patch"} {
        disallowEdit $top
        displayPatch $top
        drawMap $top -1
        #drawEditButtons $top
        foreach item {wLine1 wLine2} {
            set w $::widgets($top,$item)
            $w configure -state disabled
            set W $::widgets($top,$item)
            $W configure -state disabled
        }
        update idletasks
        wm title $top "Eskil: [file tail $::eskil($top,patchFile)]"
        # TBD TABLE
        $::widgets($top,wLine2) see 1.0
        if {$::eskil($top,printFileCmd) && $::eskil($top,printFile) ne ""} {
            after idle "doPrint $top 1 ; cleanupAndExit all"

    doText $top $ch1 $ch2 0 0 $end1 $end2

    if {$::eskil($top,view) ne "table"} {
        # Make sure all text widgets have the same number of lines.
        # The common y scroll doesn't work well if not.
        set max 0.0
        foreach item {wLine1 wDiff1 wLine2 wDiff2} {
            set w $::widgets($top,$item)
            if {[$w index end] > $max} {
                set max [$w index end]
            set W $::widgets($top,$item)
            if {[$W index end] > $max} {
                set max [$W index end]
            }
        }
        foreach item {wLine1 wDiff1 wLine2 wDiff2} {
            set w $::widgets($top,$item)
            set d [expr {int($max) - int([$w index end])}]
            set W $::widgets($top,$item)
            set d [expr {int($max) - int([$W index end])}]
            for {set t 0} {$t < $d} {incr t} {
                $w insert end \n padding
                $W insert end \n padding
            }
        }
    }

    close $ch1
    close $ch2

        }
    }

    drawMap $top -1
    #drawEditButtons $top
    if {$::eskil($top,view) ne "table"} {
        foreach item {wLine1 wLine2 wTb} {
            set w $::widgets($top,$item)
            $w configure -state disabled
            set W $::widgets($top,$item)
            $W configure -state disabled
        }
        update idletasks
        $::widgets($top,wLine2) see 1.0
    }
    normalCursor $top
    showDiff $top 0
    if {$::widgets($top,eqLabel) eq "!"} {

# Scroll windows to next/previous diff
proc findDiff {top delta} {
    showDiff $top [expr {$::eskil($top,currHighLight) + $delta}]
}

# Scroll a text window to view a certain range, and possibly some
# lines before and after.
proc seeText {w si ei} {
    $w see $ei
    $w see $si
    $w see $si-5lines
    $w see $ei+5lines
    if {[llength [$w bbox $si]] == 0} {
        $w yview $si-5lines
proc seeText {W si ei} {
    $W see $ei
    $W see $si
    $W see $si-5lines
    $W see $ei+5lines
    if {[llength [$W bbox $si]] == 0} {
        $W yview $si-5lines
    }
    if {[llength [$w bbox $ei]] == 0} {
        $w yview $si
    if {[llength [$W bbox $ei]] == 0} {
        $W yview $si
    }
}

# Highlight a diff
proc highLightChange {top changeIndex} {
    if {[info exists ::eskil($top,currHighLight)] && \
            $::eskil($top,currHighLight) >= 0} {

        set line2 [expr {$line1 + [lindex $change 1]}]
        incr line1
        set line1 $line1.0
        set line2 $line2.0
    }

    foreach item {wLine1 wDiff1 wLine2 wDiff2} {
        set w $::widgets($top,$item)
        seeText $w $line1 $line2
        set W $::widgets($top,$item)
        seeText $W $line1 $line2
    }
}

#####################################
# Editing
#####################################

        return
    }
    resetEditW $::widgets($top,wDiff1)
    resetEditW $::widgets($top,wDiff2)
}

# Clear Editing state for a Text widget
proc resetEditW {w} {
    $w tag configure padding -background {}
    $w edit reset
    $w configure -undo 0
proc resetEditW {W} {
    $W tag configure padding -background {}
    $W edit reset
    $W configure -undo 0

    set ::eskil($w,allowChange) all
    set ::eskil($W,allowChange) all

    wcb::callback $w before insert {}
    wcb::callback $w before delete {}
    wcb::callback $W before insert {}
    wcb::callback $W before delete {}
}

# Do not allow any editing
proc noEdit {top} {
    if {$::eskil($top,view) eq "table"} {
        return
    }
    noEditW $::widgets($top,wDiff1)
    noEditW $::widgets($top,wDiff2)
}

# Do not allow any editing in a Text widget
proc noEditW {w} {
    set ::eskil($w,allowChange) none
proc noEditW {W} {
    set ::eskil($W,allowChange) none

    wcb::callback $w before insert [list TextInterceptInsert $w]
    wcb::callback $w before delete [list TextInterceptDelete $w]
    wcb::callback $W before insert [list TextInterceptInsert $W]
    wcb::callback $W before delete [list TextInterceptDelete $W]
}

proc TextInterceptInsert {w ow index str args} {
    if {$::eskil($w,allowChange) eq "none"} {
proc TextInterceptInsert {W oW index str args} {
    if {$::eskil($W,allowChange) eq "none"} {
        wcb::cancel
        return
    }
    if {$::eskil($w,allowChange) eq "all"} return
    if {$::eskil($W,allowChange) eq "all"} return

    #wcb::cancel - Cancel a widget command
    #wcb::replace - Replace arguments of a widget command with new ones

    # Disallow all new lines
    if {[string first "\n" $str] >= 0} {
        wcb::cancel
        return
    }
    foreach {tag str2} $args {
        if {[string first "\n" $str2] >= 0} {
            wcb::cancel
            return
        }
    }
}

proc TextInterceptDelete {w ow from {to {}}} {
    if {$::eskil($w,allowChange) eq "none"} {
proc TextInterceptDelete {W oW from {to {}}} {
    if {$::eskil($W,allowChange) eq "none"} {
        wcb::cancel
        return
    }
    if {$::eskil($w,allowChange) eq "all"} return
    if {$::eskil($W,allowChange) eq "all"} return

    if {$to eq ""} {
        set to $from+1char
    }
    set text [$ow get $from $to]
    set text [$oW get $from $to]
    # Disallow all new lines
    if {[string first "\n" $text] >= 0} {
        wcb::cancel
        return
    }
}

# Turn on editing for a Text widget
proc turnOnEdit {w} {
    $w tag configure padding -background \#f0f0f0
    $w configure -undo 1
proc turnOnEdit {W} {
    $W tag configure padding -background \#f0f0f0
    $W configure -undo 1

    set ::eskil($w,allowChange) line
    set ::eskil($W,allowChange) line
}

# Turn on editing on sides where it has not been disallowed
proc allowEdit {top} {
    $top.m.mt entryconfigure "Edit Mode" -state disable
    if {$::eskil($top,leftEdit) == 0} {
        set ::eskil($top,leftEdit) 1

    } else {
        return [expr {$::eskil($top,rightEdit) == 1}]
    }
}

# Start an undo block in a bunch of text widgets
proc startUndoBlock {args} {
    foreach w $args {
        $w configure -autoseparators 0
    foreach W $args {
        $W configure -autoseparators 0
        # Open up editing for copy functions
        set ::eskil($w,allowChange) all
        set ::eskil($W,allowChange) all
    }
}

# End an undo block in a bunch of text widgets
proc endUndoBlock {args} {
    foreach w $args {
        $w configure -autoseparators 1
        $w edit separator
        set ::eskil($w,allowChange) line
    foreach W $args {
        $W configure -autoseparators 1
        $W edit separator
        set ::eskil($W,allowChange) line
    }
}

# Copy a block
proc copyBlock {top from first last} {
    set to [expr {$from == 1 ? 2 : 1}]

    $wfrom insert $row.0 $text ""

    endUndoBlock $wfrom $wto
}

# Delete a row filling it with padding
proc deleteBlock {top side from {to {}}} {
    set w $::widgets($top,wDiff$side)
    set W $::widgets($top,wDiff$side)

    if {$to eq ""} {set to $from}
    startUndoBlock $w
    $w delete $from.0 $to.end+1c
    $w insert $from.0 [string repeat \n [expr {$to - $from + 1}]] padding
    endUndoBlock $w
    startUndoBlock $W
    $W delete $from.0 $to.end+1c
    $W insert $from.0 [string repeat \n [expr {$to - $from + 1}]] padding
    endUndoBlock $W
}

# Get the lines involved in the display
proc getLinesFromRange {w range} {
proc getLinesFromRange {W range} {
    set from [lindex $range 0]
    set to   [lindex $range 1]
    lassign [split $from "."] fromr fromi
    lassign [split $to   "."] tor   toi
    if {$toi == 0} {incr tor -1}

    # Get the corresponding lines in the file
    set t [$w get $fromr.0 $tor.end]
    set t [$W get $fromr.0 $tor.end]
    set lines [lsort -integer [regexp -all -inline {\d+} $t]]
    set froml [lindex $lines 0]
    set tol [lindex $lines end]
    return [list $fromr $tor $froml $tol]
}

# Called by popup menus over row numbers to add commands for editing.
# Returns 1 if nothing was added.
proc editMenu {m top side changeIndex x y} {
proc editMenu {mW top side changeIndex x y} {

    if {![mayEdit $top $side]} {return 1}
    if { ! [mayEdit $top $side]} {return 1}

    # Only copy when in a change block
    if {$changeIndex ne ""} {
        set other [expr {$side == 1 ? 2 : 1}]
        set editOther [mayEdit $top $other]

        set w $::widgets($top,wLine$side)
        set wo $::widgets($top,wLine$other)
        set W $::widgets($top,wLine$side)
        set oW $::widgets($top,wLine$other)

        # Get the row that was clicked
        set index [$w index @$x,$y]
        set index [$W index @$x,$y]
        set row [lindex [split $index "."] 0]

        set line  [regexp -inline {\d+} [$w  get $row.0 $row.end]]
        set lineo [regexp -inline {\d+} [$wo get $row.0 $row.end]]
        set line  [regexp -inline {\d+} [$W  get $row.0 $row.end]]
        set lineo [regexp -inline {\d+} [$oW get $row.0 $row.end]]

        # Row copy
        if {$lineo ne ""} {
            $m add command -label "Copy Row from other side" \
            $mW add command -label "Copy Row from other side" \
                    -command [list copyRow $top $other $row]
        } else {
            $m add command -label "Delete Row" \
            $mW add command -label "Delete Row" \
                    -command [list deleteBlock $top $side $row]
        }
        if {$line ne "" && $editOther} {
            $m add command -label "Copy Row to other side" \
            $mW add command -label "Copy Row to other side" \
                    -command [list copyRow $top $side $row]
        }

        # Get ranges for the change block
        set range  [$w tag ranges hl$changeIndex]
        set rangeo [$wo tag ranges hl$changeIndex]
        set range  [$W tag ranges hl$changeIndex]
        set rangeo [$oW tag ranges hl$changeIndex]

        # Get the lines involved in the block
        lassign [getLinesFromRange $w  $range ] from  to  froml  tol
        lassign [getLinesFromRange $wo $rangeo] fromo too fromlo tolo
        lassign [getLinesFromRange $W  $range ] from  to  froml  tol
        lassign [getLinesFromRange $oW $rangeo] fromo too fromlo tolo

        # More than one line in the block?
        set thisSize 0
        set otherSize 0
        if {$froml ne "" && $tol ne ""} {
            set thisSize [expr {$tol - $froml + 1}]
        }
        if {$fromlo ne "" && $tolo ne ""} {
            set otherSize [expr {$tolo - $fromlo + 1}]
        }
        if {$thisSize > 1 || $otherSize > 1} {
            if {$otherSize > 0} {
                $m add command -label "Copy Block from other side" \
                $mW add command -label "Copy Block from other side" \
                        -command [list copyBlock $top $other $fromo $too]
            } else {
                $m add command -label "Delete Block" \
                $mW add command -label "Delete Block" \
                        -command [list deleteBlock $top $side $from $to]
            }
            if {$editOther && $thisSize > 0} {
                $m add command -label "Copy Block to other side" \
                $mW add command -label "Copy Block to other side" \
                        -command [list copyBlock $top $side $from $to]
            }
        }
    }

    $m add command -label "Save File" -command [list saveFile $top $side]
    $m add command -label "Save File, Reload" -command [list saveFileR $top $side]
    $mW add command -label "Save File" -command [list saveFile $top $side]
    $mW add command -label "Save File, Reload" -command [list saveFileR $top $side]

    return 0
}

proc saveFile {top side} {
    if {$side == 1} {
        if {!$::eskil($top,leftEdit)} return
        if { ! $::eskil($top,leftEdit)} return
        set fileName $::eskil($top,leftFile)
        set trans $::eskil($top,lefttranslation)
    } else {
        if {!$::eskil($top,rightEdit)} return
        if { ! $::eskil($top,rightEdit)} return
        set fileName $::eskil($top,rightFile)
        set trans $::eskil($top,righttranslation)
    }

    set w $::widgets($top,wDiff$side)
    set W $::widgets($top,wDiff$side)

    # Confirm dialog
    set apa no
    if {$::Pref(askOverwrite)} {
        set apa [tk_messageBox -parent $top -icon question \
                -title "Overwrite file" -type yesnocancel -message \
                "Overwriting file [file tail $fileName]\nDo you want to\

    }

    set ch [open $fileName "w"]
    if {$trans ne ""} {
        fconfigure $ch -translation $trans
    }
    set save 1
    foreach {key value index} [$w dump -all 1.0 end-1c] {
    foreach {key value index} [$W dump -all 1.0 end-1c] {
        switch -- $key {
            text {
                if {$save} {
                    puts -nonewline $ch $value
                }
            }
            tagon {

# Check if a filename is a directory and handle starkits
proc FileIsDirectory {file {kitcheck 0}} {
    # Skip directories
    if {[file isdirectory $file]} {return 1}

    # This detects .kit but how to detect starpacks?
    if {[file extension $file] eq ".kit" || $kitcheck} {
        if {![catch {package require vfs::mk4}]} {
            if {![catch {vfs::mk4::Mount $file $file -readonly}]} {
        if { ! [catch {package require vfs::mk4}]} {
            if { ! [catch {vfs::mk4::Mount $file $file -readonly}]} {
                # Check for contents to ensure it is a kit
                if {[llength [glob -nocomplain $file/*]] == 0} {
                    vfs::unmount $file
                }
            }
            # Now it is possible that the isdirectory status has changed
            return [file isdirectory $file]

    }
    # When in a vfs, make sure the Tcl file dialog is used
    # to be able to access the files in a starkit.
    if {$isVfs} {
        # 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 [::tk::dialog::file:: open {*}$args]}]} {
            if { ! [catch {set res [::tk::dialog::file:: open {*}$args]}]} {
                return $res
            }
        }
    }
    return [tk_getOpenFile {*}$args]
}

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

    set apa [myOpenFile -title "Select left file" -initialdir $initDir \
            -parent $top]
    if {$apa != ""} {
        set ::eskil($top,leftDir) [file dirname $apa]
        set ::eskil($top,leftFile) $apa
        set ::eskil($top,leftLabel) $apa
        set ::eskil($top,leftOK) 1
        return 1
    }
    return 0
}

proc doOpenRight {top {forget 0}} {
    if {!$forget && [info exists ::eskil($top,rightDir)]} {
    if { ! $forget && [info exists ::eskil($top,rightDir)]} {
        set initDir $::eskil($top,rightDir)
    } elseif {[info exists ::eskil($top,leftDir)]} {
        set initDir $::eskil($top,leftDir)
    } else {
        set initDir [pwd]
    }

    # Dropping two files mean set both
    if {[llength $files] >= 2} {
        set leftFile [lindex $files 0]
        set rightFile [lindex $files 1]
    } else {
        if {$side eq "any"} {
            # Dropped outside the text widgets. Try to be clever.
            if {![info exists ::eskil($top,lastDrop)]} {
            if { ! [info exists ::eskil($top,lastDrop)]} {
                set side left
            } elseif {$::eskil($top,lastDrop) eq "left"} {
                set side right
            } else {
                set side left
            }
        }

#####################################
# GUI stuff
#####################################

# A little helper to make a window with scrollbars
# It returns the name of the scrolled window
proc Scroll {dir class w args} {
proc Scroll {dir class W args} {
    switch -- $dir {
        both {
            set scrollx 1
            set scrolly 1
        }
        x {
            set scrollx 1
            set scrolly 0
        }
        y {
            set scrollx 0
            set scrolly 1
        }
        default {
            return -code error "Bad scrolldirection \"$dir\""
        }
    }

    ttk::frame $w
    $class $w.s {*}$args
    ttk::frame $W
    $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 bw [$W.s cget -borderwidth]
    set relief [$W.s cget -relief]
    $W configure -relief $relief -borderwidth $bw
    $W.s configure -borderwidth 0

    grid $w.s -sticky news
    grid $W.s -sticky news

    if {$scrollx} {
        $w.s configure -xscrollcommand [list $w.sbx set]
        ttk::scrollbar $w.sbx -orient horizontal -command [list $w.s xview]
        grid $w.sbx -row 1 -sticky we
        $W.s configure -xscrollcommand [list $W.sbx set]
        ttk::scrollbar $W.sbx -orient horizontal -command [list $W.s xview]
        grid $W.sbx -row 1 -sticky we
    }
    if {$scrolly} {
        $w.s configure -yscrollcommand [list $w.sby set]
        ttk::scrollbar $w.sby -orient vertical -command [list $w.s yview]
        grid $w.sby -row 0 -column 1 -sticky ns
        $W.s configure -yscrollcommand [list $W.sby set]
        ttk::scrollbar $W.sby -orient vertical -command [list $W.s yview]
        grid $W.sby -row 0 -column 1 -sticky ns
    }
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure    $w 0 -weight 1
    grid columnconfigure $W 0 -weight 1
    grid rowconfigure    $W 0 -weight 1

    return $w.s
    return $W.s
}

# Rearrange a dynamic grid to a specified number of columns
proc DynGridRearrange {w cols} {
proc DynGridRearrange {W cols} {
    # Go down columns first. Thus we must know how many rows there will be.
    set children [grid slaves $w._dyn]
    set children [grid slaves $W._dyn]
    set rows [expr {([llength $children] + $cols - 1) / $cols}]
    set row 0
    set col 0
    foreach child $children {
        grid $child -row $row -column $col
        grid columnconfigure $w._dyn $col -uniform a
        grid columnconfigure $W._dyn $col -uniform a
        incr row
        if {$row >= $rows} {
            incr col
            set row 0
        }
    }
    # Clear other columns from uniform in case we shrunk
    if {$row != 0} {
        incr col
    }
    for {} {$col < 15} {incr col} {
        grid columnconfigure $w._dyn $col -uniform ""
        grid columnconfigure $W._dyn $col -uniform ""
    }
    # Recalculate
    update idletasks
    # Propagate Height
    set height [winfo reqheight $w._dyn]
    $w configure -width 100 -height $height
    set height [winfo reqheight $W._dyn]
    $W configure -width 100 -height $height
}

# Update dynamic grid on configure event
proc DynGridRedo {w} {
proc DynGridRedo {W} {
    set maxW 0
    set children [grid slaves $w._dyn]
    set children [grid slaves $W._dyn]
    foreach child $children {
        set maxW [expr {max($maxW,[winfo reqwidth $child])}]
    }
    set fW [winfo width $w]
    set fW [winfo width $W]
    set cols [expr {max(1,$fW / $maxW)}]
    # Rerrange if needed
    lassign [grid size $w._dyn] mCols mRows
    lassign [grid size $W._dyn] mCols mRows
    if {$mCols != $cols} {
        DynGridRearrange $w $cols
        DynGridRearrange $W $cols
    }
}

# Ask for widget to have its children managed by dynGrid.
proc dynGridManage {W} {
    # Limit its inital requirements
    pack propagate $W 0

# Mark a line as aligned.
proc markAlign {top side line text} {
    set ::eskil($top,align$side) $line
    set ::eskil($top,aligntext$side) $text

    if {[info exists ::eskil($top,align1)] && [info exists ::eskil($top,align2)]} {
        if {![string equal $::eskil($top,aligntext1) $::eskil($top,aligntext2)]} {
        if { ! [string equal $::eskil($top,aligntext1) $::eskil($top,aligntext2)]} {
            set apa [tk_messageBox -icon question -title "Align" -type yesno \
                    -message "Those lines are not equal.\nReally align them?"]
            if {$apa != "yes"} {
                return 0
            }
        }

        lappend ::eskil($top,aligns) $::eskil($top,align1) $::eskil($top,align2)
        enableAlign $top

        NoMarkAlign $top
        return 1
    }
    return 0
}

# Called by popup menus over row numbers to add command for alignment.
# Returns 1 if nothing was added.
proc alignMenu {m top side x y} {
proc alignMenu {mW top side x y} {
    # Get the row that was clicked
    set w $::widgets($top,wLine$side)
    set index [$w index @$x,$y]
    set W $::widgets($top,wLine$side)
    set index [$W index @$x,$y]
    set row [lindex [split $index "."] 0]

    set data [$w get $row.0 $row.end]
    set data [$W get $row.0 $row.end]
    # Must be a line number
    if {![regexp {\d+} $data line]} {
    if { ! [regexp {\d+} $data line]} {
        return 1
    }
    set text [$::widgets($top,wDiff$side) get $row.0 $row.end]

    set other [expr {$side == 1 ? 2 : 1}]
    set cmd [list markAlign $top $side $line $text]
    if {![info exists ::eskil($top,align$other)]} {
    if { ! [info exists ::eskil($top,align$other)]} {
        set label "Mark line for alignment"
    } else {
        set label "Align with line $::eskil($top,align$other) on other side"
    }

    if {[info exists ::eskil($top,aligns)]} {
        foreach {align1 align2} $::eskil($top,aligns) {
            if {$side == 1 && $line == $align1} {
                set label "Remove alignment with line $align2"
                set cmd [list clearAlign $top $align1]
            } elseif {$side == 2 && $line == $align2} {
                set label "Remove alignment with line $align1"
                set cmd [list clearAlign $top $align1]
            }
        }
    }

    $m add command -label $label -command $cmd
    $mW add command -label $label -command $cmd

    return 0
}

# Set up bindings to allow setting alignment using drag
proc SetupAlignDrag {top left right} {
    bind $left <ButtonPress-1> [list startAlignDrag $top 1 %x %y %X %Y]\;break

    bind $right <ButtonRelease-1> [list endAlignDrag $top 2 %x %y %X %Y]\;break
    bind $right <B1-Leave> break
}

# Button has been pressed over line window
proc startAlignDrag {top side x y X Y} {
    # Get the row that was clicked
    set w $::widgets($top,wLine$side)
    set index [$w index @$x,$y]
    set W $::widgets($top,wLine$side)
    set index [$W index @$x,$y]
    set row [lindex [split $index "."] 0]

    set data [$w get $row.0 $row.end]
    set data [$W get $row.0 $row.end]
    set ::eskil($top,alignDrag,state) none
    # Must be a line number
    if {![regexp {\d+} $data line]} {
    if { ! [regexp {\d+} $data line]} {
        return 1
    }
    # Set up information about start of drag
    set text [$::widgets($top,wDiff$side) get $row.0 $row.end]
    set other [expr {$side == 1 ? 2 : 1}]
    set ::eskil($top,alignDrag,X) $X
    set ::eskil($top,alignDrag,Y) $Y

proc motionAlignDrag {top side shift x y X Y} {
    if {$::eskil($top,alignDrag,state) eq "press"} {
        # Have we moved enough to call it dragging?
        set dX [expr {abs($X - $::eskil($top,alignDrag,X))}]
        set dY [expr {abs($Y - $::eskil($top,alignDrag,Y))}]
        if {$dX + $dY > 3} {
            # Start a drag action
            set w $top.alignDrag
            destroy $w
            toplevel $w
            wm overrideredirect $w 1
            label $w.l -borderwidth 1 -relief solid -justify left
            pack $w.l
            set ::eskil($top,alignDrag,W) $w
            set W $top.alignDrag
            destroy $W
            toplevel $W
            wm overrideredirect $W 1
            label $W.l -borderwidth 1 -relief solid -justify left
            pack $W.l
            set ::eskil($top,alignDrag,W) $W
            set ::eskil($top,alignDrag,state) "drag"
        }
    }
    if {$::eskil($top,alignDrag,state) eq "drag"} {
        set w $::eskil($top,alignDrag,W)
        set W $::eskil($top,alignDrag,W)
        # Move drag label with cursor
        wm geometry $w +[expr {$X + 1}]+[expr {$Y + 1}]
        wm geometry $W +[expr {$X + 1}]+[expr {$Y + 1}]

        set n $::eskil($top,alignDrag,from)
        set other [expr {$side == 1 ? 2 : 1}]
        set w2 $::widgets($top,wLine$other)
        # Are we over the other line window?
        if {[winfo containing $X $Y] eq $w2} {
            set x [expr {$X - [winfo rootx $w2]}]
            set y [expr {$Y - [winfo rooty $w2]}]
            set index [$w2 index @$x,$y]
            set row [lindex [split $index "."] 0]
            set data [$w2 get $row.0 $row.end]
            if {![regexp {\d+} $data line]} {
            if { ! [regexp {\d+} $data line]} {
                set ::eskil($top,alignDrag,line$other) "?"
            } else {
                set ::eskil($top,alignDrag,line$other) $line
                set text [$::widgets($top,wDiff$other) get $row.0 $row.end]
                set ::eskil($top,alignDrag,text$other) $text
            }
        } else {
            set ::eskil($top,alignDrag,line$other) "?"
        }
        set txt "Align Left $::eskil($top,alignDrag,line1)"
        append txt "\nwith Right $::eskil($top,alignDrag,line2)"
        set ::eskil($top,alignDrag,shift) $shift
        if {$shift} {
            append txt "\nAnd Redo Diff"
        }
        $w.l configure -text $txt
        $W.l configure -text $txt
    }
}

# Button has been released
proc endAlignDrag {top side x y X Y} {
    if {$::eskil($top,alignDrag,state) eq "drag"} {
        destroy $::eskil($top,alignDrag,W)

}

proc hlPopup {top side changeIndex X Y x y} {
    if {[info exists ::eskil($top,nopopup)] && $::eskil($top,nopopup)} return
    destroy .lpm
    menu .lpm

    if {![editMenu .lpm $top $side $changeIndex $x $y]} {
    if { ! [editMenu .lpm $top $side $changeIndex $x $y]} {
        .lpm add separator
    }

    if {$changeIndex != ""} {
        .lpm add command -label "Select" \
                -command [list hlSelect $top $changeIndex]
    }

    set other [expr {$side == 1 ? 2 : 1}]
    if {![info exists ::eskil($top,separate$other)]} {
    if { ! [info exists ::eskil($top,separate$other)]} {
        set label "Mark for Separate Diff"
    } else {
        set label "Separate Diff"
    }

    .lpm add command -label $label -command [list hlSeparate $top $side $changeIndex]
    alignMenu .lpm $top $side $x $y

    set ::eskil($top,nopopup) 1
    tk_popup .lpm $X $Y
    after idle [list after 1 [list set "::eskil($top,nopopup)" 0]]

    return
}

# This is called when right clicking over the line numbers which are not
# marked for changes
proc rowPopup {w X Y x y} {
    set top [winfo toplevel $w]
proc rowPopup {W X Y x y} {
    set top [winfo toplevel $W]
    if {[info exists ::eskil($top,nopopup)] && $::eskil($top,nopopup)} return
    destroy .lpm
    menu .lpm

    regexp {(\d+)\D*$} $w -> side
    regexp {(\d+)\D*$} $W -> side
    set tmp1 [editMenu  .lpm $top $side "" $x $y]
    if {!$tmp1} {.lpm add separator}
    if { ! $tmp1} {.lpm add separator}
    set tmp2 [alignMenu .lpm $top $side $x $y]
    if {$tmp1 && $tmp2} {
        # Nothing in the menu
        return
    }
    if {!$tmp1 && $tmp2} {.lpm delete last}
    if { ! $tmp1 && $tmp2} {.lpm delete last}

    set ::eskil($top,nopopup) 1
    tk_popup .lpm $X $Y
    after idle [list after 1 [list set "::eskil($top,nopopup)" 0]]
}

proc nextHighlight {top} {

    incr ::HighLightCount
}

#########
# Zooming
#########

proc zoomRow {w X Y x y} {
    set top [winfo toplevel $w]
proc zoomRow {W X Y x y} {
    set top [winfo toplevel $W]
    # Get the row that was clicked
    set index [$w index @$x,$y]
    set index [$W index @$x,$y]
    set row [lindex [split $index "."] 0]

    # Check if it is selected
    if {[lsearch [$w tag names $index] sel] >= 0} {
        regexp {(\d+)\D*$} $w -> side
    if {[lsearch [$W tag names $index] sel] >= 0} {
        regexp {(\d+)\D*$} $W -> side
        hlPopup $top $side "" $X $Y $x $y
        return
    }

    # Extract the data
    set data(1) [$::widgets($top,wDiff1) dump -tag -text $row.0 $row.end]
    set data(2) [$::widgets($top,wDiff2) dump -tag -text $row.0 $row.end]

                [winfo screenwidth $top]x[winfo reqheight $top.balloon]
        set wx 0
    }
    wm geometry $top.balloon +$wx+$wy
    wm deiconify $top.balloon
}

proc unzoomRow {w} {
    set top [winfo toplevel $w]
proc unzoomRow {W} {
    set top [winfo toplevel $W]
    destroy $top.balloon
}

# Reconfigure font
proc chFont {} {
    font configure myfont -size $::Pref(fontsize) -family $::Pref(fontfamily)
}

# Change color settings
proc applyColor {} {
    global dirdiff

    foreach top $::eskil(diffWindows) {
        if {$top eq ".clipdiff"} continue
        if {[string match .fourway* $top]} continue
        if {$top != ".dirdiff"} {
            foreach item {wLine1 wDiff1 wLine2 wDiff2} {
                if {![info exists ::widgets($top,$item)]} continue
                set w $::widgets($top,$item)
                if { ! [info exists ::widgets($top,$item)]} continue
                set W $::widgets($top,$item)

                $w tag configure equal -foreground $::Pref(colorequal) \
                $W tag configure equal -foreground $::Pref(colorequal) \
                        -background $::Pref(bgequal)
                $w tag configure new1 -foreground $::Pref(colornew1) \
                $W tag configure new1 -foreground $::Pref(colornew1) \
                        -background $::Pref(bgnew1)
                $w tag configure change -foreground $::Pref(colorchange) \
                $W tag configure change -foreground $::Pref(colorchange) \
                        -background $::Pref(bgchange)
                $w tag configure new2 -foreground $::Pref(colornew2) \
                $W tag configure new2 -foreground $::Pref(colornew2) \
                        -background $::Pref(bgnew2)
            }
            continue
        }
    }
}

    }
}

# 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
    $w configure {*}$args
proc fileLabel {W args} {
    ttk::entryX $W -style TLabel
    $W configure {*}$args

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

    set i [lsearch $args -textvariable]
    if {$i >= 0} {
        set var [lindex $args [+ $i 1]]
        uplevel \#0 "trace variable $var w \
                {after idle {$w xview end} ;#}"
                {after idle {$W xview end} ;#}"
    }
}

# Fill in default data for a diff window
proc initDiffData {top} {
    set ::eskil($top,leftOK) 0
    set ::eskil($top,rightOK) 0

    wm deiconify $top
    raise $top
    update
    doDiff $top
}

# A thing to easily get to debug mode
proc backDoor {top a} {
    append ::eskil(backdoor) $a
proc backDoor {top aVal} {
    append ::eskil(backdoor) $aVal
    set ::eskil(backdoor) [string range $::eskil(backdoor) end-9 end]
    if {$::eskil(backdoor) eq "EskilDebug"} {
        set ::eskil(debug) 1
        catch {console show}
        set ::eskil(backdoor) ""
        AddDebugMenu $top
    }

    wm title $top "Eskil:"
    wm protocol $top WM_DELETE_WINDOW [list cleanupAndExit $top]

    ttk::frame $top.f
    grid $top.f -row 0 -columnspan 5 -sticky nws
    lappend ::widgets(toolbars) $top.f
    if {!$::Pref(toolbar)} {
    if { ! $::Pref(toolbar)} {
        grid remove $top.f
    }

    menu $top.m
    $top configure -menu $top.m

    $top.m add cascade -label "File" -underline 0 -menu $top.m.mf

            -command [list highlightTabs $top]
    set ::widgets($top,enableAlignCmd) [list \
            $top.m.mt entryconfigure "Clear Align" -state normal]
    set ::widgets($top,disableAlignCmd) [list \
            $top.m.mt entryconfigure "Clear Align" -state disabled]

    if {$::tcl_platform(platform) eq "windows"} {
        if {![catch {package require registry}]} {
        if { ! [catch {package require registry}]} {
            $top.m.mt add separator
            $top.m.mt add command -label "Setup Registry" -underline 6 \
                    -command makeRegistryWin
        }
    }

    $top.m add cascade -label "Help" -underline 0 -menu $top.m.help

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

        # Set up file dropping in text windows if TkDnd is available
        if {![catch {package require tkdnd}]} {
        if { ! [catch {package require tkdnd}]} {
            dnd bindtarget $top text/uri-list <Drop> "fileDrop $top any %D"
            dnd bindtarget $top.ft1.tl text/uri-list <Drop> "fileDrop $top left %D"
            dnd bindtarget $top.ft1.tt text/uri-list <Drop> "fileDrop $top left %D"
            dnd bindtarget $top.ft2.tl text/uri-list <Drop> "fileDrop $top right %D"
            dnd bindtarget $top.ft2.tt text/uri-list <Drop> "fileDrop $top right %D"
        }

        text $top.tb -width 4 -wrap none -background $bg \
                -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
                -takefocus 0
        commonYScroll $top.sby $top.ft1.tl $top.ft1.tt $top.ft2.tl $top.ft2.tt \
                ;#$top.tb

        applyColor
        foreach w [list $top.ft1.tt $top.ft2.tt] {
        foreach W [list $top.ft1.tt $top.ft2.tt] {
            # The last change in a row is underlined
            $w tag configure last -underline 1
            $W tag configure last -underline 1
            # Each file in a patch view starts with a block of this type
            $w tag configure patch -background gray
            $W tag configure patch -background gray
            # Make sure selection is visible
            $w tag raise sel
            bind $w <ButtonPress-3> "zoomRow %W %X %Y %x %y"
            bind $w <ButtonRelease-3> "unzoomRow %W"
            $W tag raise sel
            bind $W <ButtonPress-3> "zoomRow %W %X %Y %x %y"
            bind $W <ButtonRelease-3> "unzoomRow %W"
        }
        foreach w [list $top.ft1.tl $top.ft2.tl] {
            $w tag configure align -underline 1
            bind $w <ButtonPress-3> "rowPopup %W %X %Y %x %y"
        foreach W [list $top.ft1.tl $top.ft2.tl] {
            $W tag configure align -underline 1
            bind $W <ButtonPress-3> "rowPopup %W %X %Y %x %y"
        }
        SetupAlignDrag $top $top.ft1.tl $top.ft2.tl

        grid $top.l1   $top.le -    -        $top.l2   -row 1 -sticky news
        grid $top.ft1  $top.tb $map $top.sby $top.ft2  -row 2 -sticky news
        grid $top.sbx1 $top.ls -    -        $top.sbx2 -row 3 -sticky news
        grid columnconfigure $top "$top.ft1 $top.ft2" -weight 1

    resetEdit $top
    return $top
}

proc ValidateNewColors {} {
    foreach item {colorchange bgchange colornew1 bgnew1
        colornew2 bgnew2 colorequal bgequal} {
        if {![info exists ::TmpPref($item)]} continue
        if { ! [info exists ::TmpPref($item)]} continue
        set col $::TmpPref($item)
        if {$col eq ""} continue
        if {[catch {winfo rgb . $col}]} {
            # FIXA: Error message
            # Just restore for now
            set ::TmpPref($item) $::Pref($item)
        }

    ttk::labelframe .fo.ls -text "Size" -padding 3
    spinbox .fo.ls.sp -from 1 -to 30 -increment 1 -width 3 -state readonly \
            -textvariable ::TmpPref(fontsize) -command [list exampleFont $lb]
    pack .fo.ls.sp -fill both -expand 1

    ttk::label .fo.le -text "Example\n0Ooi1Il" -anchor w -font tmpfont \
            -width 1 -justify left
    if {![info exists ::eskil(fixedfont)]} {set ::eskil(fixedfont) 1}
    if { ! [info exists ::eskil(fixedfont)]} {set ::eskil(fixedfont) 1}
    ttk::checkbutton .fo.cb -text "Fixed" -variable ::eskil(fixedfont) \
            -command [list UpdateFontBox $lb]
    ttk::button .fo.bo -text "Ok"    -command "applyFont $lb ; destroy .fo"
    ttk::button .fo.ba -text "Apply" -command "applyFont $lb"
    ttk::button .fo.bc -text "Close" -command "destroy .fo"

    if {![info exists FontCache]} {
    if { ! [info exists FontCache]} {
        set fam [lsort -dictionary [font families]]
        font create testfont
        foreach f $fam {
            if {![string equal $f ""]} {
            if { ! [string equal $f ""]} {
                font configure testfont -family $f
                lappend FontCache $f [font metrics testfont -fixed]
            }
        }
        font delete testfont
    }
    UpdateFontBox $lb