72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: package require struct::set
72dac950c3 2007-09-26       aku: package require vc::cvs::ws::branch
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: namespace eval ::vc::cvs::ws::sig::branch {
72dac950c3 2007-09-26       aku:     namespace import ::vc::cvs::ws::branch::*
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: # Save the mapping from changesets to file/rev signatures, and further
72dac950c3 2007-09-26       aku: # remember all the csets a specific file/rev combination belongs to.
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: proc ::vc::cvs::ws::sig::def {id parent added changed removed} {
72dac950c3 2007-09-26       aku:     variable sig
72dac950c3 2007-09-26       aku:     variable csl
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     array set new $sig($parent)
72dac950c3 2007-09-26       aku:     array set new $added
72dac950c3 2007-09-26       aku:     array set new $changed
72dac950c3 2007-09-26       aku:     foreach {f r} $removed {catch {unset new($f)}}
72dac950c3 2007-09-26       aku:     set sig($id) [DictSort [array get new]]
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     foreach {f r} [array get new] {
72dac950c3 2007-09-26       aku: 	lappend csl($f,$r) $id
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku:     return
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: proc ::vc::cvs::ws::sig::next {id added changed removed tag ts} {
72dac950c3 2007-09-26       aku:     variable sig
72dac950c3 2007-09-26       aku:     array set rev $sig($id)
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     foreach {f r} [concat $changed $removed] {
72dac950c3 2007-09-26       aku: 	if {![info exists rev($f)] || ![branch::successor $r $rev($f)]} {
72dac950c3 2007-09-26       aku: 	    return 0
72dac950c3 2007-09-26       aku: 	}
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     if {[llength $added]} {
72dac950c3 2007-09-26       aku: 	# Check that added files belong to the branch too!
72dac950c3 2007-09-26       aku: 	if {$tag ne [branch::has $ts $added]} {
72dac950c3 2007-09-26       aku: 	    return 0
72dac950c3 2007-09-26       aku: 	}
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku:     return 1
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: proc ::vc::cvs::ws::sig::find {id sig} {
72dac950c3 2007-09-26       aku:     set cslist [Cut $id [Find $sig]]
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     if {[llength $cslist] < 1} {
72dac950c3 2007-09-26       aku: 	puts "NO ROOT"
72dac950c3 2007-09-26       aku: 	# Deal how?
72dac950c3 2007-09-26       aku: 	# - Abort
72dac950c3 2007-09-26       aku: 	# - Ignore this changeset and try the next one
72dac950c3 2007-09-26       aku: 	#   (Which has higher probability of not matching as it might
72dac950c3 2007-09-26       aku: 	#    be the successor in the branch to this cset and not a base).
72dac950c3 2007-09-26       aku: 	exit
72dac950c3 2007-09-26       aku:     } elseif {[llength $cslist] > 1} {
72dac950c3 2007-09-26       aku: 	puts "AMBIGOUS. Following csets match root requirements:"
72dac950c3 2007-09-26       aku: 	# Deal how? S.a.
72dac950c3 2007-09-26       aku: 	puts \t[join $cslist \n\t]
72dac950c3 2007-09-26       aku: 	exit
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     set r [lindex $cslist 0]
72dac950c3 2007-09-26       aku:     #puts "ROOT = $r"
72dac950c3 2007-09-26       aku:     return $r
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: proc ::vc::cvs::ws::sig::Cut {id cslist} {
72dac950c3 2007-09-26       aku:     # Changesets have to be before id! This makes for another
72dac950c3 2007-09-26       aku:     # intersection, programmatic.
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     set res {}
72dac950c3 2007-09-26       aku:     foreach c $cslist {
72dac950c3 2007-09-26       aku: 	if {$c >= $id} continue
72dac950c3 2007-09-26       aku: 	lappend res $c
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku:     return $res
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: proc ::vc::cvs::ws::sig::Find {sig} {
72dac950c3 2007-09-26       aku:     # Locate all changesets which contain the given signature.
72dac950c3 2007-09-26       aku:     variable csl
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     set res {}
72dac950c3 2007-09-26       aku:     set first 1
72dac950c3 2007-09-26       aku:     foreach {f r} $sig {
72dac950c3 2007-09-26       aku: 	#puts $f/$r?
72dac950c3 2007-09-26       aku: 	# Unknown file not used anywhere
72dac950c3 2007-09-26       aku: 	if {![info exists csl($f,$r)]} {return {}}
72dac950c3 2007-09-26       aku: 	puts $f/$r\t=\t($csl($f,$r))*($res)/$first
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: 	if {$first} {
72dac950c3 2007-09-26       aku: 	    set res $csl($f,$r)
72dac950c3 2007-09-26       aku: 	    set first 0
72dac950c3 2007-09-26       aku: 	    #puts F($res)
72dac950c3 2007-09-26       aku: 	} else {
72dac950c3 2007-09-26       aku: 	    set new [struct::set intersect $res $csl($f,$r)]
72dac950c3 2007-09-26       aku: 	    set rv $r
72dac950c3 2007-09-26       aku: 	    while {![llength $new]} {
72dac950c3 2007-09-26       aku: 		# Assume that the problem file was added and as such
72dac950c3 2007-09-26       aku: 		# does not exist yet at the root revision. However its
72dac950c3 2007-09-26       aku: 		# root should exist, and some point.
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: 	       set rv [branch::revroot $rv]
72dac950c3 2007-09-26       aku: 	       if {$rv eq ""} {
72dac950c3 2007-09-26       aku: 		   puts BREAK/\t($f\ $r)
72dac950c3 2007-09-26       aku: 		   exit
72dac950c3 2007-09-26       aku: 	       }
72dac950c3 2007-09-26       aku: 	       if {![info exists csl($f,$rv)]} {return {}}
72dac950c3 2007-09-26       aku: 	       #puts $f/$r\t=\t($csl($f,$rv))
72dac950c3 2007-09-26       aku: 	       set new [struct::set intersect $res $csl($f,$rv)]
72dac950c3 2007-09-26       aku: 	    }
72dac950c3 2007-09-26       aku: 	    set res $new
72dac950c3 2007-09-26       aku: 	    #puts R($res)
72dac950c3 2007-09-26       aku: 	    #if {![llength $res]} {return {}}
72dac950c3 2007-09-26       aku: 	}
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku:     return $res
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: proc ::vc::cvs::ws::sig::DictSort {dict} {
72dac950c3 2007-09-26       aku:     array set a $dict
72dac950c3 2007-09-26       aku:     set r {}
72dac950c3 2007-09-26       aku:     foreach k [lsort [array names a]] {
72dac950c3 2007-09-26       aku: 	lappend r $k $a($k)
72dac950c3 2007-09-26       aku:     }
72dac950c3 2007-09-26       aku:     return $r
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: namespace eval ::vc::cvs::ws::sig {
72dac950c3 2007-09-26       aku:     variable  sig ; # cset id -> signature
72dac950c3 2007-09-26       aku:     array set sig {{} {}}
72dac950c3 2007-09-26       aku:     variable  csl ; # file x rev -> list (cset id)
72dac950c3 2007-09-26       aku:     array set csl {}
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku:     namespace export def find next
72dac950c3 2007-09-26       aku: }
72dac950c3 2007-09-26       aku: 
72dac950c3 2007-09-26       aku: package provide vc::cvs::ws::sig 1.0
72dac950c3 2007-09-26       aku: return