Eskil

#----------------------------------------------------------------------
#  Revision control systems support for Eskil.
#
#  Copyright (c) 1998-2008, Peter Spjuth
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,

##############################################################################
# Revision Control System specific procedures
##############################################################################

# eskil::rev::XXX::detect {file}
#
# Detect if a file is revision controlled under this system.
# If file is empty, check directory for control.
#
# Returns true if controlled or false if not.

# eskil::rev::XXX::ParseRevs {filename revs}
#
# Figure out revision from a list given by user
# 
# Returns a list of revisions to display.
#
# Filename may be empty, the rev corresponds to the working tree

# eskil::rev::XXX::get {filename outfile rev}
#
# Get a revision of a file and place it in outfile.
# rev is in any format understood by this system, and
# should be retrieved from ParseRevs

# eskil::rev::XXX::getPatch {revs}
#
# 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

namespace eval eskil::rev::CVS {}
namespace eval eskil::rev::RCS {}
namespace eval eskil::rev::CT {}
namespace eval eskil::rev::GIT {}
namespace eval eskil::rev::SVN {}
namespace eval eskil::rev::HG {}
namespace eval eskil::rev::BZR {}

proc eskil::rev::CVS::detect {file} {
    if {$file eq ""} {
        set dir [pwd]
    } else {
        set dir [file dirname $file]
    }
    if {[file isdirectory [file join $dir CVS]]} {
        if {[auto_execok cvs] ne ""} {
            return 1
        }
    }
    return 0
}

proc eskil::rev::SVN::detect {file} {
    if {$file eq ""} {
        set dir [pwd]
    } else {
        set dir [file dirname $file]
    }
    if {[file isdirectory [file join $dir .svn]]} {
        if {[auto_execok svn] ne ""} {
            return 1
        }
    }
    return 0
}

proc eskil::rev::HG::detect {file} {
    if {$file eq ""} {
        set dir [pwd]
    } else {
        set dir [file dirname $file]
    }
    # HG, detect two steps down. Could be improved. FIXA
    if {[file isdirectory [file join $dir .hg]] ||
        [file isdirectory [file join $dir .. .hg]] ||
        [file isdirectory [file join $dir .. .. .hg]]} {
        if {[auto_execok hg] ne ""} {
            return 1
        }
    }
    return 0
}

proc eskil::rev::BZR::detect {file} {
    if {$file eq ""} {
        set dir [pwd]
    } else {
        set dir [file dirname $file]
    }
    # HG, detect two steps down. Could be improved. FIXA
    if {[file isdirectory [file join $dir .bzr]] ||
        [file isdirectory [file join $dir .. .bzr]] ||
        [file isdirectory [file join $dir .. .. .bzr]]} {
        if {[auto_execok bzr] ne ""} {
            return 1
        }

            return 1
        }
    }
    return 0
}

proc eskil::rev::CT::detect {file} {
    if {$file eq ""} {
        set dir [pwd]
    } else {
        set dir [file dirname $file]
    }
    if {[auto_execok cleartool] != ""} {
        set old [pwd]
        cd $dir
        if {![catch {exec cleartool pwv -s} view] && $view != "** NONE **"} {
            cd $old
            return 1
        }
        cd $old
    }
    return 0
}

proc eskil::rev::GIT::detect {file} {
    if {$file eq ""} {
        set dir [pwd]
    } else {
        set dir [file dirname $file]
    }
    # Git, detect two steps down. Could be improved. FIXA
    if {[file isdirectory [file join $dir .git]] ||
        [file isdirectory [file join $dir .. .git]] ||
        [file isdirectory [file join $dir .. .. .git]]} {
        if {[auto_execok git] ne ""} {
            return 1
        }

        }
    }

    if {$old != ""} {
        cd $old
    }
}

# Get a CVS patch
proc eskil::rev::CVS::getPatch {revs} {
    set cmd [list exec cvs diff -C 5]
    foreach rev $revs {
        lappend cmd -r $rev
    }

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

# 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 {$old != ""} {
        cd $old
    }
}

# Get a SVN patch
proc eskil::rev::SVN::getPatch {revs} {
    set cmd [list exec svn diff]
    foreach rev $revs {
        lappend cmd -r $rev
    }

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

# 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 {$old != ""} {
        cd $old
    }
}

# Get a HG patch
proc eskil::rev::HG::getPatch {revs} {
    set cmd [list exec hg diff]
    foreach rev $revs {
        lappend cmd -r $rev
    }

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

# 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 {$old != ""} {
        cd $old
    }
}

# Get a BZR patch
proc eskil::rev::BZR::getPatch {revs} {
    set cmd [list exec bzr diff]
    if {[llength $revs] == 2} {
        lappend cmd -r [lindex $revs 0]..[lindex $revs 1]
    } elseif {[llength $revs] == 1} {
        lappend cmd -r [lindex $revs 0]
    }

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

# 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} {
    # Not supported yet.
    return ""
}

# Get a GIT revision
# No support for revisions yet
proc eskil::rev::GIT::get {filename outfile rev} {
    set old [pwd]
    set dir [file dirname $filename]
    set tail [file tail $filename]
    # Locate the top directory
    while {![file isdirectory $dir/.git]} {
        set thisdir [file tail $dir]
        set dir [file dirname $dir]
        set tail [file join $thisdir $tail]
    }
    cd $dir
    catch {exec git show $rev:$tail > $outfile}
    cd $old
    # example: git show HEAD^^^:apa
}

# Get a GIT patch
proc eskil::rev::GIT::getPatch {revs} {
    set cmd [list exec git diff]
    # No rev support yet

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

# 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} {
    # Not supported yet
    return ""
}

# Return current revision of a CVS file
proc eskil::rev::CVS::GetCurrent {filename} {
    set old ""
    set dir [file dirname $filename]
    if {$dir != "."} {
        set old [pwd]

        cd $old
    }
    return $rev
}

# Return current revision of a SVN file
proc eskil::rev::SVN::GetCurrent {filename} {
    if {$filename eq ""} {
        set cmd [list exec svn info]
    } else {
        set old ""
        set dir [file dirname $filename]
        if {$dir != "."} {
            set old [pwd]
            cd $dir
            set filename [file tail $filename]
        }

        set cmd [list exec svn info [file nativename $filename]]
    }
    if {[catch {eval $cmd} res]} {
        # What to do here?
        set rev "1"
    } else {
        if {![regexp {Last Changed Rev:\s+(\d+)} $res -> rev]} {
            set rev "1"
        }
    }

    if {$old != ""} {
        cd $old
    }
    return $rev
}

# Figure out RCS revision from arguments
proc eskil::rev::RCS::ParseRevs {filename revs} {
    if {$filename eq ""} {
        # RCS does not support tree versions
        return {}
    }
    return $revs
}

# Figure out GIT revision from arguments
proc eskil::rev::GIT::ParseRevs {filename revs} {
    set result ""
    foreach rev $revs {

        lappend result $rev
    }
    return $result
}

# Figure out CVS revision from arguments
proc eskil::rev::CVS::ParseRevs {filename revs} {
    if {$filename eq ""} {
        # CVS does not support tree versions
        return {}
    }
    set result {}
    foreach rev $revs {
        # An integer rev is a relative rev
        if {[string is integer -strict $rev]} {
            set curr [eskil::rev::CVS::GetCurrent $filename]
            regexp {^(.*\.)(\d+)$} $curr -> head tail
            set tail [expr {$tail + $rev}]

        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]
    foreach {stream latest} $tmp break
    if {[llength $revs] == 0} {
        return [list [file join $stream $latest]]
    }

    set result {}

##############################################################################

# Figure out what revision control system a file is under
# Returns name of rev system if detected, or "" if none.
proc detectRevSystem {file {preference GIT}} {
    variable eskil::rev::cache

    if {$file ne ""} {
        if {![file exists $file]} { return "" }

        if {[info exists cache($file)]} {
            return $cache($file)
        }
    }
    
    set searchlist [list $preference GIT HG BZR]
    foreach ns [namespace children eskil::rev] {
        lappend searchlist [namespace tail $ns]
    }
    foreach rev $searchlist {

    set ::diff($top,leftFile) $::diff($top,RevFile)
}

proc revCommit {top} {
    if {[$::widgets($top,commit) cget -state] eq "disabled"} return
    eskil::rev::CVS::commitFile $top $::diff($top,RevFile)
}

# Get a complete tree patch from this system.
proc getFullPatch {top} {
    global Pref

    set type $::diff($top,modetype)

    set revs {}

    # Search for revision options
    if {$::diff($top,doptrev1) != ""} {
        lappend revs $::diff($top,doptrev1)
    }
    if {$::diff($top,doptrev2) != ""} {
        lappend revs $::diff($top,doptrev2)
    }

    set revs [eskil::rev::${type}::ParseRevs "" $revs]
    set revlabels {}
    foreach rev $revs {
        lappend revlabels [GetLastTwoPath $rev]
    }

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

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

# Get the last two elements in a file path
proc GetLastTwoPath {path} {