Eskil

    ArmCatch
    set win [twapi::get_foreground_window]
    if {$win eq ""} {
        #puts "No fg window"
        return
    }
    #puts "Locating windows"
    lassign [twapi::get_window_coordinates $win] x1 y1 x2 y2
    set width  [expr {$x2 - $x1}]
    set height [expr {$y2 - $y1}]

    set windows {}
    foreach x [list [expr {$x1 + $width / 4}] [expr {$x1 + 3*$width /4}]] {
        foreach y [list [expr {$y1 + $height / 4}] [expr {$y1 + 3*$height /4}]] {
            lappend windows [twapi::get_window_at_location $x $y]
        }
    }
    set windows [lsort -unique $windows]
    #puts $windows
    after 50 "set ::CatchFromWinWait 1" ; vwait ::CatchFromWinWait
    set capturedData {}
    foreach win $windows {
        clipboard clear
        clipboard append ""
        twapi::set_focus $win
        after 50 "set ::CatchFromWinWait 1" ; vwait ::CatchFromWinWait
        twapi::send_keys ^(ac)
        after 50 "set ::CatchFromWinWait 1" ; vwait ::CatchFromWinWait
        lassign [twapi::get_window_coordinates $win] x1 y1 x2 y2
        if {[catch {clipboard get} text]} continue
        if {$text eq ""} continue
        lappend capturedData [list $x1 $text]
    }
    $::diff(wClip1) delete 1.0 end
    $::diff(wClip2) delete 1.0 end
    if {[llength $capturedData] == 0} return

#    puts "D1   ($diffs1)"
#    puts "D2   ($diffs2)"
#    puts "S $sumsame  D $sumdiff1 D $sumdiff2"
    return [expr {$sumsame - [maxAbs $sumdiff1 $sumdiff2]}]
}

# Initialise a multidimensional list with some value

# The args are in the same order as indexes to lset/lindex
proc Linit {elem args} {
    # Go through backwards
    foreach n [lreverse $args] {




	set elem [lrepeat $n $elem]
    }
    return $elem
}

# Decide how to display change blocks
# This tries to match the lines that resemble each other and put them
# next to each other.

    }

    # Start with a check if the theoretical best works, since often that
    # is the case.
    set order 1
    set result $origresult
    for {set i 0} {$i < ($size1 - 1)} {incr i} {
        if {[lindex $result $i] >= [lindex $result [+ $i 1]]} {
            set order 0
            break
        }
    }
    if {$order} {
        #puts "ORDER"
        return $origresult

set ::eskil(argc) $::argc
set ::argv {}
set ::argc 0

set debug 1
set diffver "Version 2.4+ 2009-02-12"
set ::thisScript [file join [pwd] [info script]]

namespace import tcl::mathop::+
namespace import tcl::mathop::-
namespace import tcl::mathop::*
namespace import tcl::mathop::/

# 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}
    package require wcb

                gets $ch2 apa
                lappend block2 $apa
            }
            set apa [insertMatchingBlocks $top $block1 $block2]
            if {$apa >= 0} {
                addChange $top $apa change $line1 $n1 $line2 $n2
            } else {
                addMapLines $top [- $apa]
                # In this case, a change is not visible
                return 1
            }
        } else {
            # No extra parsing at all.
            for {set t 0} {$t < $n1} {incr t} {
                gets $ch1 apa

    set rightc 0
    set lblock {}
    set lblockl 0
    set rblock {}
    set rblockl 0

    while {$leftc < $leftlen || $rightc < $rightlen} {
        lassign [lindex $leftLines $leftc]   lline lmode lstr
        lassign [lindex $rightLines $rightc] rline rmode rstr

        # Fix the case where one side's block is empty.
        # That means that each line not marked should show up on both sides.
        if {$leftc >= $leftlen} {
            set lline $leftLine
            incr leftLine
            set lmode ""

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

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

    }
    if {[llength $Pref(regsub)] > 0} {
        lappend opts -regsub $Pref(regsub)
    }
    # Apply nodigit after preprocess
    if {$Pref(nodigit)} {lappend opts -nodigit}

    # If a special file for diffing is present, use it.
    if {[info exists ::diff($top,leftFileDiff)]} {
        set dFile1 $::diff($top,leftFileDiff)
    } else {
        set dFile1 $::diff($top,leftFile)
    }
    if {[info exists ::diff($top,rightFileDiff)]} {
        set dFile2 $::diff($top,rightFileDiff)

    set ch2 [open $::diff($top,rightFile)]
    set doingLine1 1
    set doingLine2 1

    # If there is a range, skip lines up to the range
    if {[llength $range] != 0} {
        disallowEdit $top
        lassign $range start1 end1 start2 end2
        while {$doingLine1 < $start1 && [gets $ch1 line] >= 0} {
            incr doingLine1
        }
        while {$doingLine2 < $start2 && [gets $ch2 line] >= 0} {
            incr doingLine2
        }
    }

    set t 0
    foreach i $diffres {
        lassign $i line1 n1 line2 n2
        set notvisible [doText $top $ch1 $ch2 $n1 $n2 $line1 $line2]
        if {$::diff($top,limitlines) && \
                ($::diff($top,mapMax) > $::diff($top,limitlines))} {
            break
        }
        if {$notvisible != 1} {
            bindHighlight $top

	    update idletasks
            set t 0
        }
    }

    # If there is a range, just display the range
    if {[llength $range] != 0} {
        lassign $range start1 end1 start2 end2
    } else {
        set end1 0
        set end2 0
    }
    doText $top $ch1 $ch2 0 0 $end1 $end2

    # Make sure all text widgets have the same number of lines.

proc TextInterceptInsert {w ow index str args} {
    if {$::diff($w,allowChange) eq "none"} {
        wcb::cancel
        return
    }
    if {$::diff($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
    }

    endUndoBlock $w
}

# Get the lines involved in the display
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 lines [lsort -integer [regexp -all -inline {\d+} $t]]
    set froml [lindex $lines 0]
    set tol [lindex $lines end]

        }

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

        # Get the lines involved in the block
        lassign [getLinesFromRange $w  $range ] from  to  froml  tol
        lassign [getLinesFromRange $wo $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}]
        }

    } else {
        set i 0
        while 1 {
            set i [lsearch -integer -start $i $::diff($top,aligns) $leftline]
            if {$i < 0} break
            if {($i % 2) == 0} {
                set ::diff($top,aligns) [lreplace $::diff($top,aligns) \
                        $i [+ $i 1]]
                break
            }
            incr i
        }
    }

    if {[llength $::diff($top,aligns)] == 0} {

    }
    set text [$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]
    lassign [split $from "."] froml fromi
    lassign [split $to   "."] tol   toi
    if {$toi == 0} {incr tol -1}
    # Get the corresponding lines in the file
    set t [$wl get $froml.0 $tol.end]
    set lines [lsort -integer [regexp -all -inline {\d+} $t]]
    set froml [lindex $lines 0]
    set tol [lindex $lines end]
    set ::diff($top,separatelines$n) [list $froml $tol]

    ttk::entryX $w -style TLabel
    $w configure {*}$args

    $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} ;#}"
    }
}

# Fill in default data for a diff window
proc initDiffData {top} {

    puts {Usage: eskil [options] [file1] [file2]
  [options]              See below.
  [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 version control of the file, and
                         if found, runs in version control mode.
  Options:

  -nodiff     : Normally, if there are enough information on the
                command line to run diff, Eskil will do so unless
                this option is specified.
  -dir        : Start in directory diff mode. Ignores other args.

  -nonewline  : Try to ignore newline changes.
  -nonewline+ : Try to ignore newline changes, and don't display.

  -prefix <str> : Care mainly about words starting with "str".
  -preprocess <pair> : TBW

  -r <ver>    : Version info for version control mode.
  -cvs        : Detect CVS first, if multiple version systems are used.
  -svn        : Detect SVN first, if multiple version systems are used.

  -conflict   : Treat file as a merge conflict file and enter merge
                mode.
  -o <file>   : Specify merge result output file.

  -browse     : Automatically bring up file dialog after starting.
  -server     : Set up Eskil to be controllable from the outside.

    set ::eskil(ignorenewline) 0

    if {$::eskil(argc) == 0} {
        Init
        makeDiffWin
        return
    }

    set allOpts {
        -w --help -help -b -noignore -i -nocase -nodigit -nokeyword -prefix
        -noparse -line -smallblock -block -char -word -limit -nodiff -dir
        -clip -patch -browse -conflict -print -printps -printpdf
        -server -o -r -context -cvs -svn -review
        -foreach -preprocess -close -nonewline -plugin -plugininfo
        -plugindump

        # If not, let it fall through to the file check.
        if {[lsearch -exact $allOpts $arg] < 0} {
            set match [lsearch -glob -all -inline $allOpts $arg*]
            if {[llength $match] == 1} {
                set arg [lindex $match 0]
            }
        }

        if {$arg eq "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg eq "--help" || $arg eq "-help"} {
            printUsage
            exit
        } elseif {$arg eq "-b"} {
            set Pref(ignore) "-b"

    set Pref(marklast) 1
    set Pref(linewidth) 80
    set Pref(lines) 60
    set Pref(editor) ""
    set Pref(regsub) {}
    set Pref(toolbar) 0
    set Pref(wideMap) 0 ;# Not settable in GUI yet

    # Print options
    set Pref(grayLevel1) 0.6
    set Pref(grayLevel2) 0.8
    set Pref(wideLines) 0
    set Pref(printHeaderSize) 10
    set Pref(printCharsPerLine) 80
    set Pref(printPaper) a4

}

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

    set h [font metrics docFont -linespace]
    # Use negative size to get pixels. Search from small to bigger
    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
    }
}

    set h [winfo height $top.c_map]
    set x2 [expr {$w - ($Pref(wideMap) ? 5 : 1)}]
    if {$x2 < 0} { set x2 0 }
    map$top configure -width $w -height $h
    incr h -1
    set y0 0
    foreach change $::diff($top,changes) {
	lassign $change start length type
	set y1 [expr {$start * $h / $::diff($top,mapMax) + 1}]
	if {!$y0} { set y0 $y1 } ;# Record first occurance
	if {$y1 < 1} {set y1 1}
	if {$y1 > $h} {set y1 $h}
	set y2 [expr {($start + $length) * $h / $::diff($top,mapMax) + 1}]
	if {$y2 < 1} {set y2 1}
	if {$y2 <= $y1} {set y2 [expr {$y1 + 1}]}

    set ch1 [open $::diff($top,leftFile) r]
    set ch2 [open $::diff($top,rightFile) r]
    set doingLine1 1
    set doingLine2 1
    set changeNo 0
    foreach change $::diff($top,changes) {
        lassign $change start length type line1 n1 line2 n2
        set data1 {}
        set data2 {}
        while {$doingLine1 < $line1} {
            gets $ch1 apa
            append data1 $apa\n
            incr doingLine1
        }

#  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------





# Format a line number for printing
# It will always be maxlen chars wide.
proc FormatLineno {lineno maxlen} {
    if {[string is integer -strict $lineno]} {
        set res [format "%d: " $lineno]
    } else {
        # Non-numerical linenumbers might turn up in some cases
        set res $lineno
        if {[string length $res] > $maxlen} {
            set res [string range $res 0 [- $maxlen 1]]
        }
    }
    if {[string length $res] < $maxlen} {
        set res [format "%*s" $maxlen $res]
    }
    return $res
}

                    if {[string index $value end] eq "\n"} {
                        set newline 1
                        set value [string trimright $value "\n"]
                    }
                    set len [string length $value]
                    while {$chars + $len > $wraplength} {
                        set wrap [expr {$wraplength - $chars}]
                        set val1 [string range $value 0 [- $wrap 1]]
                        set value [string range $value $wrap end]
                        # The newline has its own element to simplify finding
                        # it later.
                        lappend line $val1 $tag "\n" {} $linepad {}
                        set chars $maxlen
                        incr wrapc
                        set len [string length $value]

    }
    destructor {
        catch {$pdf destroy}
    }

    method StartPrint {} {
        # Page size
        lassign [$pdf getDrawableArea] width height

        # Header metrics
        $pdf setFont $options(-headsize) Courier
        set headoffset [expr {$options(-headsize) + [$pdf getFontMetric bboxy]}]
        set hoy $headoffset

        # Figure out font size from number of chars per line

        # Draw borders
        $pdf setStrokeColor 0 0 0
        $pdf setFillColor 0.0 0.0 0.0
        $pdf setLineStyle 0.5
        # Outer border
        $pdf rectangle 0 $options(-headsize) \
                $width [- $height $options(-headsize)]
        # Center line
        $pdf line [/ $width 2.0] $options(-headsize) \
                [/ $width 2.0] $height

        # Header
        $pdf setFont $options(-headsize) Courier
        $pdf text $options(-headleft) -x 0 -y $hoy 
        $pdf text "Page $page of $options(-headnpages)" \
                -x [expr {$width / 2.0}] -y $hoy -align center
        $pdf text $options(-headright) -x $width -y $hoy -align right

            } else {
                # Get a list from the log
                if {$filename eq ""} {
                    set filename "."
                }
                set cmd [list svn log -q [file nativename $filename]]
                set revs [eskil::rev::SVN::GetRevList $filename]
                set rev [lindex $revs [- $rev]]
                if {$rev eq ""} {
                    set rev [lindex $revs end]
                }
            }
        }
        lappend result $rev
    }
    return $result
}

# Figure out ClearCase revision from arguments
proc eskil::rev::CT::ParseRevs {filename revs} {
    if {$filename eq ""} {
        # CT does not support tree versions
        return {}
    }
    set tmp [eskil::rev::CT::current $filename]
    lassign $tmp stream latest
    if {[llength $revs] == 0} {
        return [list [file join $stream $latest]]
    }

    set result {}
    foreach rev $revs {
        # A negative version number is offset from latest.

#!/bin/sh
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
# the next line restarts using tclsh \
exec tclsh8.5 "$0" "$@"

set testScript [file normalize [file join [pwd] [info script]]]
set testDir    [file dirname $testScript]

lappend auto_path eskil.vfs/lib

package require tcltest 2.2

# Tests for comparing misc procedures.                      -*- tcl -*-
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------

test procs-1.1 {
    Linit
} -body {
    # Make sure argument ordering is same as lindex
    lindex [Linit x 3 4 5] 2 3 4
} -result x

test procs-1.2 {
    Linit
} -body {
    lindex [Linit x 3 4 5] 4 3 2
} -result {}