Eskil

spell:
	@cat doc/*.txt | ispell -d british -l | sort -u

CHKFILES = $(SRCFILES) $(wildcard plugins/*.tcl) \
	eskil.vfs/lib/psballoon/psballoon.tcl \
	eskil.vfs/lib/pstools/pstools.tcl
NAGELFARFLAGS = -s syntaxdb.tcl -pkgpicky -filter "*Non constant definition*" -quiet -plugin nfplugin.tcl

# Create a common "header" file for all source files.
eskil_h.syntax: $(SRCFILES) src/eskil.syntax nfplugin.tcl
	@echo Creating syntax header file...
	@$(NAGELFAR) $(NAGELFARFLAGS) -header eskil_h.syntax $(SRCFILES)

check: eskil_h.syntax
	@echo Checking...
	@for i in $(CHKFILES); do $(NAGELFAR)  $(NAGELFARFLAGS) eskil_h.syntax $$i ; done

##Nagelfar Plugin : Check of Eskil's sources

proc statementWords {words info} {
    set caller [dict get $info caller]
    set callee [lindex $words 0]
    set res {}

    # Experiment with coding standard
    if {$callee eq "if"} {
        set e [lindex $words 1]
        if {[regexp {\{(\s*)!(\s*)\[} $e -> pre post]} {
            # Trying two possible rules for whitespace
            if 1 {
                if {$pre ne "" || $post ne ""} {
                    lappend res warning
                    lappend res "Not (!) should not be surrounded by space"
                }
            } else {
                if {$pre ne " " || $post ne " "} {
                    lappend res warning
                    lappend res "Not (!) should be surrounded by one space"
                }
            }
        }
    }
    return $res
}

            # FIXA: update file info in tree too
            #$self SetNodeStatus $node equal
        }
    }

    # Copy a file from one directory to the other
    method CopyFile {node from} {
        ##nagelfar vartype tree _obj,tablelist
        if {$from eq "left"} {
            set to right
        } elseif {$from eq "right"} {
            set to left
        } else {
            error "Bad from argument to CopyFile: $from"
        }

            }} continue
            
            trace add execution $cmd enter [mymethod Dlog]
            puts "Traced $cmd"
        }
    }
    method UpdateIdle {} {
        ##nagelfar vartype tree _obj,tablelist
        $self Dlog UpdateIdle
        set AfterId "X"

        if {$PauseBgProcessing} {
            $self Dlog Pause
            set AfterId [after 200 [mymethod UpdateIdle]]
            return

                set AfterId ""
                return
            }
        }

        if {[llength $IdleQueue] > 0} {
            set node [lindex $IdleQueue end]
            set leftfull [$tree rowattrib $node "leftfull"]
            set rightfull [$tree rowattrib $node "rightfull"]
            if {$leftfull ne ""} {
                set statusvar "$leftfull  ($count)"
            } else {
                set statusvar "$rightfull  ($count)"
            }

            $self Dlog Reschedule

                    $size2 $time2]
            # TODO: Configurable large file value?
            if {$size1 > 1000000 && $size2 > 1000000} {
                set largeFile 1
            }
        }
        set id [$tree insertchild $node end $values]
        $tree rowattrib $id "type" $type
        set NodeStatus($id) unknown
        $tree rowattrib $id leftfull $df1
        $tree rowattrib $id rightfull $df2
        $tree rowattrib $id largefile $largeFile
        if {$type ne "directory"} {
            if {$type eq "link"} {
                $tree cellconfigure $id,structure -image $::img(link)

    method DoDirCompare {} {
        # Reconfiguring the dirdiff widget triggers a rerun
        $tree configure -leftdirvariable ::dirdiff(leftDir) \
                -rightdirvariable ::dirdiff(rightDir)
    }

    method DoNice {} {
        ##nagelfar vartype tree _obj,tablelist
        $tree nice $::Pref(dir,nice)
    }

    # Go up one level in directory hierarchy.
    # 0 = both
    method UpDir {{n 0}} {
        global dirdiff

    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:\$"
    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

##nagelfar package known vfs

##nagelfar syntax pdf4tcl::getPaperSize x
##nagelfar syntax pdf4tcl::getPaperSizeList
##nagelfar syntax pdf4tcl::loadBaseType1Font 3
##nagelfar syntax pdf4tcl::loadBaseTrueTypeFont r 2 3
##nagelfar syntax pdf4tcl::createFont 3
##nagelfar syntax _obj,pdf4tcl s x*
##nagelfar package known pdf4tcl

##nagelfar syntax twapi::get_foreground_window
##nagelfar syntax twapi::get_window_coordinates x
##nagelfar syntax twapi::get_window_at_location x x
##nagelfar syntax twapi::set_focus x
##nagelfar syntax twapi::send_keys x
##nagelfar syntax twapi::get_window_coordinates x
##nagelfar package known twapi

##nagelfar syntax tablelist::tablelist x p*
##nagelfar syntax tablelist::convEventFields x x x
##nagelfar syntax tablelist::synchronize x
##nagelfar syntax tablelist::updateKeyToRowMap x
##nagelfar syntax tablelist::displayItems x
##nagelfar syntax tablelist::cellIndex x x x
##nagelfar syntax tablelist::findTabs x x x x n n
##nagelfar syntax mwutil::wrongNumArgs x
##nagelfar syntax _obj,tablelist s x*
##nagelfar subcmd _obj,tablelist parent rowattrib nice
##nagelfar package known tablelist_tile

##nagelfar syntax MySpinBox x p*
##nagelfar option MySpinBox -textvariable -from -to -increment -width -format
##nagelfar option MySpinBox\ -textvariable n

# Operators

            catch {file delete -force $f}
        }
        set ::tmpfiles {}
    }
}

# 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 {
            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 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 r  "0 0 1 1"
            }
            incr col
        }
    }
}

# Insert lineno and text
proc insertLine {top side line text {tag {equal}} {linetag {}}} {
    if {$::eskil($top,view) eq "table"} {
        insertLineTable $top $side $line $text $tag
        return
    }
    $::widgets($top,wDiff$side) insert end "$text\n" $tag
    if {$linetag ne ""} {
        append tag " $linetag"
    }
    if {$tag != "equal"} {
        set tag "hl$::HighLightCount $tag"
    }
    $::widgets($top,wLine$side) insert end [myFormL $line] $tag
}

# Insert an empty line on one side of the diff.
proc emptyLine {top side {highlight 1}} {
    if {$::eskil($top,view) eq "table"} {
        # This should be ignored for table
        return
    }
    if {$highlight} {
        $::widgets($top,wLine$side) insert end "\n" hl$::HighLightCount
    } else {
        $::widgets($top,wLine$side) insert end "*****\n"
    }
    $::widgets($top,wDiff$side) insert end "\n" padding
}

# Helper to take care of -sep case
# This can be used when diffing e.g. a CSV file.
# Each column will be handled separately, so differences will never be shown
# crossing a separator
proc diffWithSeparator {RE line1 line2 opts} {

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

proc highlightTabs {top} {
    foreach item {wDiff1 wDiff2} {
        set w $::widgets($top,$item)
        ##nagelfar vartype w _obj,text
        set count {}
        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 configure tab -background bisque
        $w tag raise tab

    }
    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} {
        $::widgets($top,wLine1) tag configure hl$::eskil($top,currHighLight) \
                -background {}
        $::widgets($top,wLine2) tag configure hl$::eskil($top,currHighLight) \
                -background {}
    }
    set ::eskil($top,currHighLight) $changeIndex
    if {$::eskil($top,currHighLight) < 0} {
        set ::eskil($top,currHighLight) -1
    } elseif {$::eskil($top,currHighLight) >= [llength $::eskil($top,changes)]} {
        set ::eskil($top,currHighLight) [llength $::eskil($top,changes)]
    } else {
        $::widgets($top,wLine1) tag configure hl$::eskil($top,currHighLight) \
                -background yellow
        $::widgets($top,wLine2) tag configure hl$::eskil($top,currHighLight) \
                -background yellow
    }
}

# Highlight a diff and scroll windows to it.
proc showDiff {top changeIndex} {
    # TBD TABLE
    if {$::eskil($top,view) eq "table"} return
    highLightChange $top $changeIndex

    set change [lindex $::eskil($top,changes) $::eskil($top,currHighLight)]
    set line1 [lindex $change 0]

    if {$::eskil($top,currHighLight) < 0} {
        set line1 1.0
        set line2 1.0

        $w edit separator
        set ::eskil($w,allowChange) line
    }
}

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

    set wfrom $::widgets($top,wDiff$from)
    set wto   $::widgets($top,wDiff$to)

    set tags ""
    set dump [$wfrom dump -all $first.0 $last.end+1c]

        }
    }
    endUndoBlock $wfrom $wto
}

# Copy a row between text widgets
proc copyRow {top from row} {
    set to [expr {$from == 1 ? 2 : 1}]

    set wfrom $::widgets($top,wDiff$from)
    set wto   $::widgets($top,wDiff$to)

    set text [$wfrom get $row.0 $row.end+1c]

    startUndoBlock $wfrom $wto

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

    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)

        # Get the row that was clicked
        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]]

        # Row copy
        if {$lineo ne ""} {
            $m add command -label "Copy Row from other side" \
                    -command [list copyRow $top $other $row]
        } else {
            $m add command -label "Delete Row" \
                    -command [list deleteBlock $top $side $row]
        }
        if {$line ne "" && $editOther} {
            $m 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]

        # 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}]
        }
        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" \
                        -command [list copyBlock $top $other $fromo $too]
            } else {
                $m 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" \
                        -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]

    return 0
}

proc saveFile {top side} {
    if {$side == 1} {
        if {!$::eskil($top,leftEdit)} return

    lassign [grid size $w._dyn] mCols mRows
    if {$mCols != $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
    $W configure -width 100 -height 10
    set children [winfo children $W]
    # Add an inner frame
    ttk::frame $W._dyn
    lower $W._dyn
    pack $W._dyn -fill both -expand 1
    # Get all children managed
    grid {*}$children -in $W._dyn -padx 3 -pady 3 -sticky w
    # React
    bind $W <Configure> "DynGridRedo $W"
}

################
# Align function
################

proc enableAlign {top} {

    unset -nocomplain ::eskil($top,align1)
    unset -nocomplain ::eskil($top,align2)
    unset -nocomplain ::eskil($top,aligntext1)
    unset -nocomplain ::eskil($top,aligntext2)
}

# 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)]} {
            set apa [tk_messageBox -icon question -title "Align" -type yesno \
                    -message "Those lines are not equal.\nReally align them?"]
            if {$apa != "yes"} {
                return 0

        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} {
    # Get the row that was clicked
    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]
    # Must be a line number
    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)]} {
        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

    bind $right <B1-Motion> [list motionAlignDrag $top 2 0 %x %y %X %Y]\;break
    bind $right <Shift-B1-Motion> [list motionAlignDrag $top 2 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 row [lindex [split $index "."] 0]

    set data [$w get $row.0 $row.end]
    set ::eskil($top,alignDrag,state) none
    # Must be a line number
    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
    set ::eskil($top,alignDrag,from) $side
    set ::eskil($top,alignDrag,line$side) $line
    set ::eskil($top,alignDrag,text$side) $text
    set ::eskil($top,alignDrag,line$other) "?"
    set ::eskil($top,alignDrag,state) press
}

# Mouse moves with button down
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

    }
    if {$::eskil($top,alignDrag,state) eq "drag"} {
        set w $::eskil($top,alignDrag,W)
        # Move drag label with cursor
        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]

            append txt "\nAnd Redo Diff"
        }
        $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)
        # Are both line numbers valid? I.e. is this a full align operation?
        if {$::eskil($top,alignDrag,line1) ne "?" && \
                $::eskil($top,alignDrag,line2) ne "?"} {
            NoMarkAlign $top
            markAlign $top 1 $::eskil($top,alignDrag,line1) \

    set ::eskil($top,alignDrag,state) none
}

###################
# Diff highlighting
###################

proc hlSelect {top changeIndex} {
    highLightChange $top $changeIndex
}

proc hlSeparate {top side changeIndex} {
    set ::eskil($top,separate$side) $changeIndex
    set wd $::widgets($top,wDiff$side)
    set wl $::widgets($top,wLine$side)

    if {$changeIndex eq ""} {
        set range [$wd tag ranges sel]
    } else {
        set range [$wl tag ranges hl$::eskil($top,separate$side)]
    }
    set text [$wd get {*}$range]
    set ::eskil($top,separatetext$side) $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 ::eskil($top,separatelines$side) [list $froml $tol]

    if {[info exists ::eskil($top,separate1)] && \
            [info exists ::eskil($top,separate2)]} {
        cloneDiff $top [concat $::eskil($top,separatelines1) \
                               $::eskil($top,separatelines2)]
        unset ::eskil($top,separate1)
        unset ::eskil($top,separate2)
    }
}

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]} {
        .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)]} {
        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]
    if {[info exists ::eskil($top,nopopup)] && $::eskil($top,nopopup)} return
    destroy .lpm
    menu .lpm

    regexp {(\d+)\D*$} $w -> side
    set tmp1 [editMenu  .lpm $top $side "" $x $y]
    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}

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

proc nextHighlight {top} {
    # TBD TABLE, stop for now?
    if {$::eskil($top,view) eq "table"} {
        return
    }
    set tag hl$::HighLightCount
    foreach side {1 2} {
        set W $::widgets($top,wLine$side)
        ##nagelfar vartype W _obj,text
        $W tag bind $tag <ButtonPress-3> \
                "hlPopup $top $side $::HighLightCount %X %Y %x %y ; break"
        $W tag bind $tag <ButtonPress-1> \
                "hlSelect $top $::HighLightCount"
    }
    incr ::HighLightCount
}

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

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 row [lindex [split $index "."] 0]

    # Check if it is selected
    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]
    if {[llength $data(1)] == 0 && [llength $data(2)] == 0} return

}

# Fill up the merge window with the initial version of merged files.
proc fillMergeWindow {top} {
    global eskil

    set w $top.merge.t
    ##nagelfar vartype w _obj,text
    $w delete 1.0 end
    set marks {}
    set t 0
    set firstConflict -1
    foreach {commLeft diffLeft} $eskil($top,leftMergeData) \
            {commRight diffRight} $eskil($top,rightMergeData) {
        $w insert end $commRight