Eskil

# eskil::rev::XXX::getPatch {revs {files {}}}
#
# Get a patch of the file tree, between the revisions given.
# revs is in any format understood by this system, and
# should be retrieved from ParseRevs
# An optional list of files that should be included can be given.
# Note that current directory must be correct before calling.

# eskil::rev::XXX::getChangedFiles {dir revs}
#
# Get a list of files changed between the revisions given.
# revs is in any format understood by this system, and
# should be retrieved from ParseRevs

# eskil::rev::XXX::commitFile {top args}
#
# If implemented, enables the commit feature when comparing edited
# file(s) agains latest check in.
# If no files are given, all edited files are committed.

proc eskil::rev::P4::detect {file} {
    if {[auto_execok icmp4] != ""} {
        if {[catch {exec csh -c "icmp4 have $file"} p4have]} { return 0 }
	if {[lindex $p4have 1] eq "-"} { return 1 }
    }
    return 0
}

# Find the repo top dir given a file/dir reference.
# Return the tail relative to top dir.
# cands is a list of candidates for top marker
proc GetTopDirCand {ref cands dirName tailName} {
    upvar 1 $dirName dir $tailName tail
    if {[file isdirectory $ref]} {
        set dir $ref
        set tail ""
    } else {
        set dir [file dirname $ref]
        set tail [file tail $ref]
    }
    # Locate the top directory
    while {[file readable $dir] && [file isdirectory $dir]} {
        set found 0
        foreach candidate $cands {
            if {[file exists [file join $dir $candidate]]} {
                set found 1
                break
            }
        }
        if {$found} break

        set parent [file dirname $dir]
        # Make sure to stop if we reach a dead end
        if {$parent eq $dir} break
        set tail [file join [file tail $dir] $tail]
        set dir $parent
    }
}

# Find the repo top dir given a file/dir reference.
# Return the tail relative to top dir.
proc eskil::rev::SVN::GetTopDir {ref dirName tailName} {
    upvar 1 $dirName dir $tailName tail
    GetTopDirCand $ref .svn dir tail
}

# Find the repo top dir given a file/dir reference.
# Return the tail relative to top dir.
proc eskil::rev::GIT::GetTopDir {ref dirName tailName} {
    upvar 1 $dirName dir $tailName tail
    GetTopDirCand $ref .git dir tail
}

# Find the repo top dir given a file/dir reference.
# Return the tail relative to top dir.
proc eskil::rev::HG::GetTopDir {ref dirName tailName} {
    upvar 1 $dirName dir $tailName tail
    GetTopDirCand $ref .hg dir tail
}

# Find the repo top dir given a file/dir reference.
# Return the tail relative to top dir.
proc eskil::rev::FOSSIL::GetTopDir {ref dirName tailName} {
    upvar 1 $dirName dir $tailName tail
    GetTopDirCand $ref ".fos .fslckout _FOSSIL_" dir tail
}

# Get a CVS revision
proc eskil::rev::CVS::get {filename outfile rev} {
    set old ""
    set dir [file dirname $filename]
    if {$dir != "."} {
        set old [pwd]

        if {![string match "*=========*" $res]} {
            tk_messageBox -icon error -title "CVS error" -message $res
            return ""
        }
    }
    return $res
}

proc eskil::rev::CVS::getChangedFiles {dir revs} {
    # Not supported yet
    return ""
}

# Get a SVN revision
proc eskil::rev::SVN::get {filename outfile rev} {
    set old ""
    set dir [file dirname $filename]
    if {$dir != "."} {
        set old [pwd]

    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "SVN error" -message $res
        return ""
    }
    return $res
}

proc eskil::rev::SVN::getChangedFiles {dir revs} {
    # Must call SVN in top dir to get full changeset
    GetTopDir $dir top tail
    set cmd [list execDir $top svn diff --summarize]
    set revs2 {}
    foreach rev $revs {
        # TODO: What happens in strange combinations ?
        if {[string match "*://*" $rev]} {
            # Full URL
            lappend cmd $rev
        } else {
            lappend revs2 $rev
        }
    }
    if {[llength $revs2] > 0} {
        lappend cmd -r [join $revs2 :]
    }

    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "SVN error" -message $res
        return ""
    }
    # Result is one file per line, with an info word before
    set files {}
    foreach line [split $res \n] {
        if {[regexp {^\S+\s+(.*)} $line -> f]} {
            lappend files [file join $top $f]
        }
    }
    return $files
}

# Get a HG revision
proc eskil::rev::HG::get {filename outfile rev} {
    set old ""
    set dir [file dirname $filename]
    if {$dir != "."} {
        set old [pwd]

    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "HG error" -message $res
        return ""
    }
    return $res
}

proc eskil::rev::HG::getChangedFiles {dir revs} {
    set cmd [list execDir $dir hg diff --stat]
    foreach rev $revs {
        lappend cmd -r $rev
    }

    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "HG error" -message $res
        return ""
    }
    # Result is one file per line, with an info word before
    GetTopDir $dir top tail
    set files {}
    foreach line [split $res \n] {
        if {[regexp {(.+)\|} $line -> f]} {
            set f [string trim $f]
            lappend files [file join $top $f]
        }
    }
    return $files
}

# Get a BZR revision
proc eskil::rev::BZR::get {filename outfile rev} {
    set old ""
    set dir [file dirname $filename]
    if {$dir != "."} {
        set old [pwd]

        if {![string match "*===*" $res]} {
            tk_messageBox -icon error -title "BZR error" -message $res
            return ""
        }
    }
    return $res
}

proc eskil::rev::BZR::getChangedFiles {dir revs} {
    # Not supported yet
    return ""
}

# Get an RCS revision
proc eskil::rev::RCS::get {filename outfile {rev {}}} {
    catch {exec co -p$rev [file nativename $filename] \
            > $outfile}
}

# Get a RCS patch
proc eskil::rev::RCS::getPatch {revs {files {}}} {
    # Not supported yet.
    return ""
}

proc eskil::rev::RCS::getChangedFiles {dir revs} {
    # Not supported yet.
    return ""
}

# Get a GIT revision
# No support for revisions yet
proc eskil::rev::GIT::get {filename outfile rev} {


    GetTopDir $filename dir tail






    if {$rev eq ""} {
        set rev HEAD
    }

    catch {execDir $dir git show $rev:$tail > $outfile}

    # example: git show HEAD^^^:apa
}

# Add file to GIT index
proc eskil::rev::GIT::add {filename} {


    GetTopDir $filename dir tail







    catch {execDir $dir git add $tail}

}

# Get a GIT patch
proc eskil::rev::GIT::getPatch {revs {files {}}} {
    set cmd [list exec git diff -p]
    if {[llength $revs] == 0} {
        # Always default to HEAD to see changes regardless of index

    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "GIT error" -message $res
        return ""
    }
    return $res
}

# Get a GIT change set

proc eskil::rev::GIT::getChangedFiles {dir revs} {
    set cmd [list execDir $dir git diff --name-only]
    if {[llength $revs] == 0} {
        # Always default to HEAD to see changes regardless of index
        lappend cmd HEAD
    } else {
        foreach rev $revs {
            lappend cmd $rev
        }
    }

    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "GIT error" -message $res
        return ""
    }
    # Result is one file per line, relative to repo
    GetTopDir $dir top tail
    set files {}
    foreach line [split $res \n] {
        lappend files [file join $top $line]
    }
    return $files
}

# Get a FOSSIL revision
# No support for revisions yet
proc eskil::rev::FOSSIL::get {filename outfile rev} {
    GetTopDir $filename dir tail
    if {$rev eq "HEAD" || $rev eq ""} {
        catch {execDir $dir fossil finfo -p $tail > $outfile}
    } else {
        catch {execDir $dir fossil finfo -p $tail -r $rev > $outfile}
    }

}

# Get a FOSSIL patch
proc eskil::rev::FOSSIL::getPatch {revs {files {}}} {
    set cmd [list exec fossil diff]

    if {[llength $revs] >= 1} {

                return ""
            }
            # Fake the per-file rows
            append res "Index: $file\n==================================\n"
            append res $fres
        }
    } else {
        # Include added files contents
        lappend cmd -N
        if {[catch {eval $cmd} res]} {
            tk_messageBox -icon error -title "FOSSIL error" -message $res
            return ""
        }
    }
    return $res
}

proc eskil::rev::FOSSIL::getChangedFiles {dir revs} {
    set cmd [list execDir $dir fossil diff]

    if {[llength $revs] >= 1} {
        lappend cmd --from [lindex $revs 0]
    }
    if {[llength $revs] >= 2} {
        lappend cmd --to [lindex $revs 1]
    }

    lappend cmd --brief
    if {[catch {eval $cmd} res]} {
        tk_messageBox -icon error -title "FOSSIL error" -message $res
        return ""
    }
    # Result is one file per line, with an info word before
    GetTopDir $dir top tail
    set files {}
    foreach line [split $res \n] {
        regexp {\S+\s+(.*)} $line -> f
        lappend files [file join $top $f]
    }
    return $files
}

# Get a ClearCase revision
proc eskil::rev::CT::get {filename outfile rev} {
    set filerev [file nativename $filename@@$rev]
    if {[catch {exec cleartool get -to $outfile $filerev} msg]} {
        tk_messageBox -icon error -title "Cleartool error" -message $msg
        return
    }
}

# Get a CT patch
proc eskil::rev::CT::getPatch {revs {files {}}} {
    # Not supported yet
    return ""
}

proc eskil::rev::CT::getChangedFiles {dir revs} {
    # Not supported yet
    return ""
}

# Get a P4 revision
proc eskil::rev::P4::get {filename outfile rev} {
    set dir [file dirname $filename]
    if {[catch {exec csh -c "icmp4 print -q $filename\\#$rev" > $outfile} msg]} {
        tk_messageBox -icon error -title "P4 error" -message $msg
        return

            if {[regexp {r(\d+)} $line -> rev]} {
                lappend revs $rev
            }
        }
    }
    return $revs
}

# Return revision list of a HG file
proc eskil::rev::HG::GetRevList {filename} {
    if {$filename eq ""} {
        set cmd [list exec hg log -q -l 50]
    } else {
        set cmd [list exec hg log -q -l 50 [file nativename $filename]]
    }
    if {[catch {eval $cmd} res]} {
        # What to do here?
        set revs [list 1]
    } else {
        set revs {}
        foreach line [split $res \n] {
            if {[regexp {^(\d+):} $line -> rev]} {
                lappend revs $rev
            }
        }
    }
    return $revs
}

# Return revision list of a GIT file
proc eskil::rev::GIT::GetRevList {filename} {
    set old ""
    set cmd [list exec git log --first-parent --oneline -n 50]
    if {$filename eq ""} {
        # Nothing

    }
    return $revs
}

# Return revision list of a FOSSIL file
proc eskil::rev::FOSSIL::GetRevList {filename} {
    # Keep on current branch
    set x [execDir $filename fossil branch list]
    if { ! [regexp -line {^\* (.*)$} $x -> branch]} {
        set branch ""
    }
    
    # First, traverse timeline to get a set of ancestor checkins on the
    # current branch
    set x [execDir $filename fossil timeline ancestors current -t ci -n 5000]
    set ancestors {}
    set lines ""
    set currentArtefact ""
    foreach line [split $x \n] {
        # Recognise the first line of each checkin
        if {[regexp {^\d\d:\d\d:\d\d \[(\w+)\]} $line -> newArtefact]} {
            # Check the accumulated lines before this for tags

    if {[file isdirectory $filename]} {
        # Just use the ancestors as is. TBD to filter this for a sub directory
        return [dict keys $ancestors]
    }

    # Now get all commits on the file. If finfo had a tag filter,
    # this would be much easier.
    set x [execDir $filename fossil finfo -l -b $filename]
    set fAncestors {}
    foreach line [split $x \n] {
        if {[regexp {^(\w+)} $line -> artefact]} {
            if {[dict exists $ancestors $artefact]} {
                lappend fAncestors $artefact
            }
        }

        if {[string is integer -strict $rev] && $rev < 0} {
            # A negative integer rev is a relative rev
            set revList [eskil::rev::FOSSIL::GetRevList $filename]

            set rev [lindex $revList [- $rev]]
            if {$rev eq ""} {
                set rev [lindex $revList end]
            }
        }
        # Let anything else through
        lappend result $rev
    }
    return $result
}

# Figure out HG revision from arguments
proc eskil::rev::HG::ParseRevs {filename revs} {
    set result ""
    foreach rev $revs {
        # Shortcut to HG special names
        if {$rev eq "_" || $rev eq "0"} {set rev tip}

        if {[string is integer -strict $rev] && $rev < 0} {
            # A negative integer rev is a relative rev
            set revList [eskil::rev::HG::GetRevList $filename]
            set rev [lindex $revList [- $rev]]
            if {$rev eq ""} {
                set rev [lindex $revList end]
            }

        }
        lappend result $rev
    }
    return $result
}

# Figure out BZR revision from arguments
proc eskil::rev::BZR::ParseRevs {filename revs} {

            # Use BASE since SVN then knows to use the local copy and avoid
            # server calls.
            set rev BASE
            #set rev [eskil::rev::SVN::GetCurrent $filename]
        } elseif {[string is integer -strict $rev] && $rev <= 0} {
            # Zero means current
            # A negative integer rev is a relative rev






            # Get a list from the log
            if {$filename eq ""} {
                set filename "."
            }
            if {$Url ne ""} {
                set revs [eskil::rev::SVN::GetRevList $Url]
            } else {
                set revs [eskil::rev::SVN::GetRevList $filename]
            }
            set rev [lindex $revs [- $rev]]
            if {$rev eq ""} {
                set rev [lindex $revs end]

            }
        }
        if {$Url ne ""} {
            if {$rev ne ""} {
                append Url @$rev
            }
            lappend result $Url

    if {[$::widgets($top,log) cget -state] eq "disabled"} return
    set type $::eskil($top,modetype)
    eskil::rev::${type}::viewLog $top $::eskil($top,RevFile) \
            $::eskil($top,RevRevs)
}

# Get a complete tree patch from this system.
# Note that current directory must be correct before calling.
proc getFullPatch {top} {
    $::widgets($top,commit) configure -state disabled
    $::widgets($top,revert) configure -state disabled
    $::widgets($top,log)    configure -state disabled

    set type $::eskil($top,modetype)
    set files $::eskil($top,reviewFiles)

    return [eskil::rev::${type}::getPatch $revs $files]
}

##############################################################################
# Utilities
##############################################################################

# Execute a command within a specific dir as pwd
proc execDir {dir args} {
    set old [pwd]
    if {[file isdirectory $dir]} {
        cd $dir
    } else {
        # A file may be given as reference
        cd [file dirname $dir]
    }
    try {
        exec {*}$args
    } finally {
        cd $old
    }
}

# Search upwards the directory structure for a file
proc SearchUpwardsFromFile {file args} {
    if {$file eq ""} {
        set dir [pwd]
    } elseif {[file isdirectory $file]} {
        set dir $file