Artifact 4cf480aa539c7a199e26f4deac9588b3a9f4721f

File tools/lib/cvs_csets.tcl part of check-in [ae54e928c2] - Further work on the CVS frontend. The main parts for doing the extraction and management of changesets are now in a separate package. by aku on 2007-09-17 07:05:01.

# -----------------------------------------------------------------------------
# Repository management (CVS), Changeset grouping and storage.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4

namespace eval ::vc::cvs::ws::csets::Current {}

# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::csets::init   - Initialize accumulator
# vc::cvs::ws::csets::add    - Add timeline entry to accumulor, may generate new cset
# vc::cvs::ws::csets::done   - Complete cset generation.
#
# vc::cvs::ws::csets::get id - Get data of a cset.
# vc::cvs::ws::csets::num    - Get number of csets.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::csets::init {} {
    Current::Clear
    return
}

proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
    if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
	Save [Current::Complete]
    }
    Current::Add $date $file $revision $operation $author $cmsg
    return
}

proc ::vc::cvs::ws::csets::done {} {
    if {![Current::Empty]} {
	Save [Current::Complete]
    }
    return
}

proc ::vc::cvs::ws::csets::get {id} {
    variable csets
    return  $csets($id)
}

proc ::vc::cvs::ws::csets::num {} {
    variable csets
    return [array size csets]
}

# -----------------------------------------------------------------------------
# Internal helper commands: Changeset inspection and construction.

proc ::vc::cvs::ws::csets::Save {data} {
    variable csets
    variable ncs

    set csets($ncs) $data
    incr ncs
    return
}

proc ::vc::cvs::ws::csets::Current::Clear {} {
    variable    start   {} ; # date the changeset begins
    variable    cmsg    {} ; # commit message of the changeset
    variable    author  {} ; # user creating the changeset
    variable    lastd   {} ; # version depth of last added file.
    variable    removed {} ; # file -> revision of removed files.
    variable    added   {} ; # file -> revision of added files.
    variable    changed {} ; # file -> revision of modified files.
    variable    files
    array unset files *
    array set   files {}   ; # file -> revision
    return
}

proc ::vc::cvs::ws::csets::Current::Empty {} {
    variable start
    return [expr {$start eq ""}]
}

proc ::vc::cvs::ws::csets::Current::New {nfile nrevision nauthor ncmsg} {
    upvar 1 reason reason
    variable cmsg
    variable author
    variable lastd
    variable files

    # User change
    if {$nauthor ne $author} {
	set reason user
	return 1
    }

    # File already in current cset
    if {[info exists files($nfile)]} {
	set reason file
	return 1
    }

    # Current cset trunk/branch different from entry.
    set ndepth [llength [split $nrevision .]]
    if {($lastd == 2) != ($ndepth == 2)} {
	set reason depth/$lastd/$ndepth/($nrevision)/$nfile
	return 1
    }

    # Commit message changed
    if {$ncmsg ne $cmsg} {
	set reason cmsg/<<$ncmsg>>
	return 1
    }

    # The new entry still belongs to the current changeset
    return 0
}

proc ::vc::cvs::ws::csets::Current::Add {ndate nfile nrevision noperation nauthor ncmsg} {
    variable start
    variable cmsg
    variable author
    variable lastd
    variable removed
    variable added
    variable changed
    variable files

    if {$start eq ""} {set start $ndate}
    set cmsg          $ncmsg
    set author        $nauthor
    set lastd         [llength [split $nrevision .]]
    set files($nfile) $nrevision

    if {$noperation eq "R"} {
	lappend removed $nfile $nrevision
    } elseif {$noperation eq "A"} {
	lappend added   $nfile $nrevision
    } else {
	lappend changed $nfile $nrevision
    }
    return
}

proc ::vc::cvs::ws::csets::Current::Complete {} {
    variable start
    variable cmsg
    variable author
    variable lastd
    variable removed
    variable added
    variable changed

    set res [list \
		date    $start \
		author  $author \
		cmsg    $cmsg \
		removed $removed \
		added   $added \
		changed $changed \
		lastd   $lastd]
    Clear
    return $res
}

# -----------------------------------------------------------------------------
# Internals

namespace eval ::vc::cvs::ws::csets {

    # Cset storage

    # csets: id -> dict
    # dict: date
    #       author
    #       csmg
    #       removed
    #       added
    #       changed
    #       lastd

    variable  ncs   0  ; # Counter for changesets
    variable  csets
    array set csets {} ; # Changeset data

    # Data of the current changeset built from timeline entries.
    namespace eval Current {
	variable  start   {} ; # date the changeset begins
	variable  cmsg    {} ; # commit message of the changeset
	variable  author  {} ; # user creating the changeset
	variable  lastd   {} ; # version depth of last added file.
	variable  removed {} ; # file -> revision of removed files.
	variable  added   {} ; # file -> revision of added files.
	variable  changed {} ; # file -> revision of modified files.
	variable  files
	array set files {}   ; # file -> revision
    }

    namespace export init add done get num
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::cvs::ws::csets 1.0
return