df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Repository management (FOSSIL) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Requirements df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: package require Tcl 8.4 86a7f249c1 2007-09-09 aku: package require vc::tools::log ; # User feedback be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: namespace eval ::fossil { 86a7f249c1 2007-09-09 aku: vc::tools::log::system fossil 86a7f249c1 2007-09-09 aku: namespace import ::vc::tools::log::write be32ebcb41 2007-09-08 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # API df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Define repository file, and connect to workspace in CWD. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::fossil::new {} { df91d389d5 2007-09-04 aku: variable fr [file normalize [fileutil::tempfile import2_fsl_rp_]] df91d389d5 2007-09-04 aku: variable fossil df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # pwd = workspace df91d389d5 2007-09-04 aku: exec $fossil new $fr ; # create and df91d389d5 2007-09-04 aku: exec $fossil open $fr ; # connect df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: write 0 fossil "Repository: $fr" be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: return $fr df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Move generated fossil repository to final destination df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::fossil::destination {path} { df91d389d5 2007-09-04 aku: variable fr df91d389d5 2007-09-04 aku: file rename $fr $path df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::fossil { df91d389d5 2007-09-04 aku: # Repository file df91d389d5 2007-09-04 aku: variable fr {} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Fossil application df91d389d5 2007-09-04 aku: variable fossil [auto_execok fossil] 492531e3a8 2007-09-04 aku: 492531e3a8 2007-09-04 aku: # Debug the commit command (write a Tcl script containing the 492531e3a8 2007-09-04 aku: # exact command used). And the file the data goes to. 492531e3a8 2007-09-04 aku: variable debugcommit 0 492531e3a8 2007-09-04 aku: variable dcfile {} 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: 492531e3a8 2007-09-04 aku: proc ::fossil::debugcommit {flag} { 492531e3a8 2007-09-04 aku: variable debugcommit $flag 492531e3a8 2007-09-04 aku: if {$debugcommit} { 492531e3a8 2007-09-04 aku: variable dcfile [file normalize cvs2fossil_commit.tcl] 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 8469631cc9 2007-09-08 aku: proc ::fossil::commit {break appname nosign meta ignore} { df91d389d5 2007-09-04 aku: variable fossil df91d389d5 2007-09-04 aku: variable lastuuid 492531e3a8 2007-09-04 aku: variable debugcommit 492531e3a8 2007-09-04 aku: variable dcfile df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Commit the current state of the workspace. Scan for new and df91d389d5 2007-09-04 aku: # removed files and issue the appropriate fossil add/rm commands df91d389d5 2007-09-04 aku: # before actually comitting. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Modified/Removed files first, that way there won't be any ADDED df91d389d5 2007-09-04 aku: # indicators. Nor REMOVED, only EDITED. Removed files show up as df91d389d5 2007-09-04 aku: # EDITED while they are not registered as removed. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set added 0 df91d389d5 2007-09-04 aku: set removed 0 df91d389d5 2007-09-04 aku: set changed 0 df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach line [split [exec $fossil changes] \n] { df91d389d5 2007-09-04 aku: regsub {^\s*EDITED\s*} $line {} path df91d389d5 2007-09-04 aku: if {[IGNORE $ignore $path]} continue df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {![file exists $path]} { df91d389d5 2007-09-04 aku: exec $fossil rm $path df91d389d5 2007-09-04 aku: incr removed be32ebcb41 2007-09-08 aku: write 2 fossil "- $path" df91d389d5 2007-09-04 aku: } else { df91d389d5 2007-09-04 aku: incr changed be32ebcb41 2007-09-08 aku: write 2 fossil "* $path" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Now look for unregistered added files. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach path [split [exec $fossil extra] \n] { df91d389d5 2007-09-04 aku: if {[IGNORE $ignore $path]} continue df91d389d5 2007-09-04 aku: exec $fossil add $path df91d389d5 2007-09-04 aku: incr added be32ebcb41 2007-09-08 aku: write 2 fossil "+ $path" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Now commit, using the provided meta data, and capture the uuid df91d389d5 2007-09-04 aku: # of the new baseline. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {user message tstamp} $meta break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set message [join [list \ df91d389d5 2007-09-04 aku: "-- Originally by $user @ $tstamp" \ df91d389d5 2007-09-04 aku: "-- Imported by $appname" \ df91d389d5 2007-09-04 aku: $message] \n] df91d389d5 2007-09-04 aku: 492531e3a8 2007-09-04 aku: if {$nosign} { 492531e3a8 2007-09-04 aku: set cmd [list exec $fossil commit -m $message --nosign] 492531e3a8 2007-09-04 aku: } else { 492531e3a8 2007-09-04 aku: set cmd [list exec $fossil commit -m $message] 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: 492531e3a8 2007-09-04 aku: if {$debugcommit} { 492531e3a8 2007-09-04 aku: fileutil::writeFile $dcfile "\#!tclsh\n$cmd\n" 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: 8469631cc9 2007-09-08 aku: # Stop, do not actually commit. 8469631cc9 2007-09-08 aku: if {$break} return 8469631cc9 2007-09-08 aku: df91d389d5 2007-09-04 aku: if {[catch { 492531e3a8 2007-09-04 aku: eval $cmd df91d389d5 2007-09-04 aku: } line]} { df91d389d5 2007-09-04 aku: if {![string match "*nothing has changed*" $line]} { df91d389d5 2007-09-04 aku: return -code error $line df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # 'Nothing changed' can happen for changesets containing only df91d389d5 2007-09-04 aku: # dead-first revisions of one or more files. For fossil we df91d389d5 2007-09-04 aku: # re-use the last baseline. TODO: Mark them as branchpoint, df91d389d5 2007-09-04 aku: # and for what file. df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: write 1 fossil "UNCHANGED, keeping last" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: return [list $lastuuid 0 0 0] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set line [string trim $line] df91d389d5 2007-09-04 aku: regsub -nocase -- {^\s*New_Version:\s*} $line {} uuid df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set lastuuid $uuid df91d389d5 2007-09-04 aku: return [list $uuid $added $removed $changed] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Internal helper commands df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::fossil::IGNORE {ignore path} { df91d389d5 2007-09-04 aku: return [uplevel #0 [linsert $ignore end $path]] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Ready df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: package provide fossil 1.0 df91d389d5 2007-09-04 aku: return