d011e0b008 2008-02-04 aku: ## -*- tcl -*- d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# ##################### d011e0b008 2008-02-04 aku: ## Copyright (c) 2008 Andreas Kupries. d011e0b008 2008-02-04 aku: # d011e0b008 2008-02-04 aku: # This software is licensed as described in the file LICENSE, which d011e0b008 2008-02-04 aku: # you should have received as part of this distribution. d011e0b008 2008-02-04 aku: # d011e0b008 2008-02-04 aku: # This software consists of voluntary contributions made by many d011e0b008 2008-02-04 aku: # individuals. For exact contribution history, see the revision d011e0b008 2008-02-04 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# ##################### d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: ## Track the state of a cvs workspace as changesets are committed to d011e0b008 2008-02-04 aku: ## it. Nothing actually happens in the filesystem, this is completely d011e0b008 2008-02-04 aku: ## virtual. d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# ##################### d011e0b008 2008-02-04 aku: ## Requirements d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: package require Tcl 8.4 ; # Required runtime. d011e0b008 2008-02-04 aku: package require snit ; # OO system. d011e0b008 2008-02-04 aku: package require struct::list ; # List assignment c9270189c2 2008-02-05 aku: package require vc::tools::log ; # User feedback. d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# ##################### d011e0b008 2008-02-04 aku: ## d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: snit::type ::vc::fossil::import::cvs::wsstate { d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# d011e0b008 2008-02-04 aku: ## Public API d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: constructor {lod} { d011e0b008 2008-02-04 aku: # Start with an empty state d011e0b008 2008-02-04 aku: set myname $lod d011e0b008 2008-02-04 aku: return d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: method name {} { return $myname } d011e0b008 2008-02-04 aku: c9270189c2 2008-02-05 aku: method add {oprevisioninfo} { c9270189c2 2008-02-05 aku: # oprevisioninfo = list (rid path label op ...) /quadruples d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: # Overwrite all changed files (identified by path) with the c9270189c2 2008-02-05 aku: # new revisions. This keeps all unchanged files. Files marked c9270189c2 2008-02-05 aku: # as dead are removed. c9270189c2 2008-02-05 aku: c9270189c2 2008-02-05 aku: foreach {rid path label rop} $oprevisioninfo { c9270189c2 2008-02-05 aku: log write 5 wss {$myop($rop) $label} c9270189c2 2008-02-05 aku: c9270189c2 2008-02-05 aku: if {$rop < 0} { a25bafb76a 2008-02-14 aku: if {[catch { a25bafb76a 2008-02-14 aku: unset mystate($path) a25bafb76a 2008-02-14 aku: }]} { a25bafb76a 2008-02-14 aku: log write 0 wss "Removed path \"$path\" is not known to the workspace" a25bafb76a 2008-02-14 aku: } c9270189c2 2008-02-05 aku: } else { c9270189c2 2008-02-05 aku: set mystate($path) [list $rid $label] c9270189c2 2008-02-05 aku: } d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: return d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: method get {} { d011e0b008 2008-02-04 aku: set res {} d011e0b008 2008-02-04 aku: foreach path [lsort -dict [array names mystate]] { d011e0b008 2008-02-04 aku: struct::list assign $mystate($path) rid label d011e0b008 2008-02-04 aku: lappend res $rid $path $label d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: return $res d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: method defid {id} { d011e0b008 2008-02-04 aku: set myid $id d011e0b008 2008-02-04 aku: return d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: method getid {} { return $myid } d011e0b008 2008-02-04 aku: c9270189c2 2008-02-05 aku: method defstate {s} { array set mystate $s ; return } c9270189c2 2008-02-05 aku: method getstate {} { return [array get mystate] } c9270189c2 2008-02-05 aku: d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# d011e0b008 2008-02-04 aku: ## State d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: variable myname {} ; # Name of the LOD the workspace is d011e0b008 2008-02-04 aku: # for. d011e0b008 2008-02-04 aku: variable myid {} ; # Record id of the fossil manifest d011e0b008 2008-02-04 aku: # associated with the current state. d011e0b008 2008-02-04 aku: variable mystate -array {} ; # Map from paths to the recordid of d011e0b008 2008-02-04 aku: # the file revision behind it, and d011e0b008 2008-02-04 aku: # the associated label for logging. c9270189c2 2008-02-05 aku: c9270189c2 2008-02-05 aku: typevariable myop -array { c9270189c2 2008-02-05 aku: -1 REM c9270189c2 2008-02-05 aku: 0 --- c9270189c2 2008-02-05 aku: 1 ADD c9270189c2 2008-02-05 aku: 2 CHG c9270189c2 2008-02-05 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# d011e0b008 2008-02-04 aku: ## Configuration d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: pragma -hastypeinfo no ; # no type introspection d011e0b008 2008-02-04 aku: pragma -hasinfo no ; # no object introspection d011e0b008 2008-02-04 aku: pragma -hastypemethods no ; # type is not relevant. d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: namespace eval ::vc::fossil::import::cvs { d011e0b008 2008-02-04 aku: namespace export wsstate d011e0b008 2008-02-04 aku: namespace eval wsstate { c9270189c2 2008-02-05 aku: namespace import ::vc::tools::log c9270189c2 2008-02-05 aku: log register wss d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: } d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: # # ## ### ##### ######## ############# ##################### d011e0b008 2008-02-04 aku: ## Ready d011e0b008 2008-02-04 aku: d011e0b008 2008-02-04 aku: package provide vc::fossil::import::cvs::wsstate 1.0 d011e0b008 2008-02-04 aku: return
File Annotation