84de38d73f 2007-10-10 aku: ## -*- tcl -*- 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Copyright (c) 2007 Andreas Kupries. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software is licensed as described in the file LICENSE, which 84de38d73f 2007-10-10 aku: # you should have received as part of this distribution. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software consists of voluntary contributions made by many 84de38d73f 2007-10-10 aku: # individuals. For exact contribution history, see the revision 84de38d73f 2007-10-10 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: ## Revisions per file. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Requirements 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package require Tcl 8.4 ; # Required runtime. 84de38d73f 2007-10-10 aku: package require snit ; # OO system. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: snit::type ::vc::fossil::import::cvs::file::rev { 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Public API 84de38d73f 2007-10-10 aku: da9295c6f6 2007-10-12 aku: constructor {revnr date author state thefile} { cb70cf4ad6 2007-10-13 aku: set myrevnr $revnr cb70cf4ad6 2007-10-13 aku: set mydate $date cb70cf4ad6 2007-10-13 aku: set myorigdate $date cb70cf4ad6 2007-10-13 aku: set myauthor $author cb70cf4ad6 2007-10-13 aku: set mystate $state cb70cf4ad6 2007-10-13 aku: set myfile $thefile da9295c6f6 2007-10-12 aku: return da9295c6f6 2007-10-12 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Basic pieces ________________________ da9295c6f6 2007-10-12 aku: da9295c6f6 2007-10-12 aku: method hascommitmsg {} { return $myhascm } da9295c6f6 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: method setcommitmsg {cm} { set mycommitmsg $cm ; set myhascm 1 ; return } cb70cf4ad6 2007-10-13 aku: method settext {text} { set mytext $text ; return } cb70cf4ad6 2007-10-13 aku: method setbranchname {name} { set mybranchname $name ; return } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method revnr {} { return $myrevnr } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Basic parent/child linkage __________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method hasparent {} { return [expr {$myparent ne ""}] } cb70cf4ad6 2007-10-13 aku: method haschild {} { return [expr {$mychild ne ""}] } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setparent {parent} { cb70cf4ad6 2007-10-13 aku: if {$myparent ne ""} { trouble internal "Parent already defined" } cb70cf4ad6 2007-10-13 aku: set myparent $parent cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setchild {child} { cb70cf4ad6 2007-10-13 aku: if {$mychild ne ""} { trouble internal "Child already defined" } cb70cf4ad6 2007-10-13 aku: set mychild $child cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method parent {} { return $myparent } cb70cf4ad6 2007-10-13 aku: method child {} { return $mychild } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Branch linkage ______________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setparentbranch {branch} { cb70cf4ad6 2007-10-13 aku: if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" } cb70cf4ad6 2007-10-13 aku: set myparentbranch $branch cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method addbranch {branch} { cb70cf4ad6 2007-10-13 aku: lappend mybranches $branch cb70cf4ad6 2007-10-13 aku: #sorted in ascending order by branch number? cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method addchildonbranch {child} { cb70cf4ad6 2007-10-13 aku: lappend mybranchchildren $child da9295c6f6 2007-10-12 aku: return da9295c6f6 2007-10-12 aku: } da9295c6f6 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: # Tag linkage _________________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method addtag {tag} { cb70cf4ad6 2007-10-13 aku: lappend mytags $tag bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: method sortbranches {} { cb70cf4ad6 2007-10-13 aku: if {![llength $mybranches]} return cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Sort the branches spawned by this revision in creation cb70cf4ad6 2007-10-13 aku: # order. To help in this our file gave all branches a position cb70cf4ad6 2007-10-13 aku: # id, in order of their definition by the RCS archive. cb70cf4ad6 2007-10-13 aku: # cb70cf4ad6 2007-10-13 aku: # The creation order is (apparently) the reverse of the cb70cf4ad6 2007-10-13 aku: # definition order. (If a branch is created then deleted, a cb70cf4ad6 2007-10-13 aku: # later branch can be assigned the recycled branch number; cb70cf4ad6 2007-10-13 aku: # therefore branch numbers are not an indication of creation cb70cf4ad6 2007-10-13 aku: # order.) cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: set tmp {} cb70cf4ad6 2007-10-13 aku: foreach branch $mybranches { cb70cf4ad6 2007-10-13 aku: lappend tmp [list $branch [$branch position]] cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: set mybranches {} cb70cf4ad6 2007-10-13 aku: foreach item [lsort -index 1 -decreasing $tmp] { cb70cf4ad6 2007-10-13 aku: struct::list assign $item -> branch position cb70cf4ad6 2007-10-13 aku: lappend mybranches $branch cb70cf4ad6 2007-10-13 aku: } 84de38d73f 2007-10-10 aku: return 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# bd131addb9 2007-10-12 aku: ## Type API bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: typemethod istrunkrevnr {revnr} { da9295c6f6 2007-10-12 aku: return [expr {[llength [split $revnr .]] == 2}] cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: typemethod isbranchrevnr {revnr _ bv} { cb70cf4ad6 2007-10-13 aku: if {[regexp $mybranchpattern $revnr -> head tail]} { cb70cf4ad6 2007-10-13 aku: upvar 1 $bv branchnr cb70cf4ad6 2007-10-13 aku: set branchnr ${head}$tail cb70cf4ad6 2007-10-13 aku: return 1 cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: return 0 bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: typemethod 2branchnr {revnr} { bd131addb9 2007-10-12 aku: # Input is a branch revision number, i.e. a revision number bd131addb9 2007-10-12 aku: # with an even number of components; for example '2.9.2.1' bd131addb9 2007-10-12 aku: # (never '2.9.2' nor '2.9.0.2'). The return value is the bd131addb9 2007-10-12 aku: # branch number (for example, '2.9.2'). For trunk revisions, bd131addb9 2007-10-12 aku: # like '3.4', we return the empty string. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {[$type istrunkrevnr $revnr]} { bd131addb9 2007-10-12 aku: return "" bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: return [join [lrange [split $revnr .] 0 end-1] .] bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: typemethod 2branchparentrevnr {branchnr} { cb70cf4ad6 2007-10-13 aku: # Chop the last segment off cb70cf4ad6 2007-10-13 aku: return [join [lrange [split $branchnr .] 0 end-1] .] bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## State bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: typevariable mybranchpattern {^((?:\d+\.\d+\.)+)(?:0\.)?(\d+)$} bd131addb9 2007-10-12 aku: # First a nonzero even number of digit groups with trailing dot bd131addb9 2007-10-12 aku: # CVS then sticks an extra 0 in here; RCS does not. bd131addb9 2007-10-12 aku: # And the last digit group. bd131addb9 2007-10-12 aku: da9295c6f6 2007-10-12 aku: variable myrevnr {} ; # Revision number of the revision. da9295c6f6 2007-10-12 aku: variable mydate {} ; # Timestamp of the revision, seconds since epoch cb70cf4ad6 2007-10-13 aku: variable myorigdate {} ; # Original unmodified timestamp. da9295c6f6 2007-10-12 aku: variable mystate {} ; # State of the revision. da9295c6f6 2007-10-12 aku: variable myfile {} ; # Ref to the file object the revision belongs to. da9295c6f6 2007-10-12 aku: variable myhascm 0 ; # Bool flag, set when the commit msg was set. da9295c6f6 2007-10-12 aku: variable mytext {} ; # Range of the (delta) text for this revision in the file. da9295c6f6 2007-10-12 aku: da9295c6f6 2007-10-12 aku: # The meta data block used later to group revisions into changesets. da9295c6f6 2007-10-12 aku: # The project name factors into this as well, but is not stored da9295c6f6 2007-10-12 aku: # here. The name is acessible via myfile's project. da9295c6f6 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: variable myauthor {} ; # Name of the user who committed the revision. cb70cf4ad6 2007-10-13 aku: variable mycommitmsg {} ; # The message entered as part of the commit. cb70cf4ad6 2007-10-13 aku: variable mybranchname {} ; # The name of the branch the revision was committed on. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Basic parent/child linkage (lines of development) cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable myparent {} ; # Ref to parent revision object. Link required because of cb70cf4ad6 2007-10-13 aku: # ; # 'cvsadmin -o', which can create arbitrary gaps in the cb70cf4ad6 2007-10-13 aku: # ; # numbering sequence. This is in the same line of development cb70cf4ad6 2007-10-13 aku: # ; # Note: For the first revision on a branch the revision cb70cf4ad6 2007-10-13 aku: # ; # it was spawned from is the parent. Only the root revision cb70cf4ad6 2007-10-13 aku: # ; # of myfile's revision tree has nothing set here. cb70cf4ad6 2007-10-13 aku: # ; # cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mychild {} ; # Ref to the primary child revision object, i.e. the next cb70cf4ad6 2007-10-13 aku: # ; # revision in the same line of development. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Branch linkage ____________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mybranches {} ; # List of the branches (objs) spawned by this revision. cb70cf4ad6 2007-10-13 aku: variable myparentbranch {} ; # For the first revision on a branch the relevant cb70cf4ad6 2007-10-13 aku: # ; # branch object. This also allows us to determine if cb70cf4ad6 2007-10-13 aku: # ; # myparent is in the same LOD, or the revision the cb70cf4ad6 2007-10-13 aku: # ; # branch spawned from. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # List of the revision objects of the first commits on any cb70cf4ad6 2007-10-13 aku: # branches spawned by this revision on which commits occurred. cb70cf4ad6 2007-10-13 aku: # This dependency is kept explicitly because otherwise a cb70cf4ad6 2007-10-13 aku: # revision-only topological sort would miss the dependency that cb70cf4ad6 2007-10-13 aku: # exists via -> mybranches. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mybranchchildren {} ; # List of the revisions (objs) which are the first cb70cf4ad6 2007-10-13 aku: # ; # commits on any of the branches spawned from this cb70cf4ad6 2007-10-13 aku: # ; # revision. The dependency is kept explicitly to cb70cf4ad6 2007-10-13 aku: # ; # ensure that a revision-only topological sort will cb70cf4ad6 2007-10-13 aku: # ; # not miss it, as it otherwise exists only via cb70cf4ad6 2007-10-13 aku: # ; # mybranches. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Tag linkage ________________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mytags {} ; # List of tags (objs) associated with this revision. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Configuration 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: pragma -hastypeinfo no ; # no type introspection 84de38d73f 2007-10-10 aku: pragma -hasinfo no ; # no object introspection 84de38d73f 2007-10-10 aku: pragma -simpledispatch yes ; # simple fast dispatch 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: namespace eval ::vc::fossil::import::cvs::file { 84de38d73f 2007-10-10 aku: namespace export rev 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Ready 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package provide vc::fossil::import::cvs::file::rev 1.0 84de38d73f 2007-10-10 aku: return
File Annotation