Change CVS details for a checked out tree.

# cvsmod.tcl - Copyright (c) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Walk a directory tree looking for CVS control files and modify them
# appropriately. Useful for changing the CVS root (esp. when the cvs tree
# has changed hosts.)
#
# Usage: cvsmod ?-tree "root of working dir"? -root "new cvs root"
#  eg: cvsmod -tree . -root :ext:luser@tcllib.cvs.sourceforge.net:/cvsroot/tcllib
#
# $Id$

namespace eval cvsmod {
    variable opts
}

proc cvsmod::cvsmod {args} {
    variable opts
    array set opts [list tree [pwd] root {} repository {}]
    while {[string match -* [set option [lindex $args 0]]]} {
	switch -glob -- $option {
	    -tree { set opts(tree) [Pop args 1] }
	    -rep* { set opts(repository) [Pop args 1] }
	    -root { set opts(root) [Pop args 1] }
	    -- {Pop args ; break }
	    default {
		set err [join [array names opts] ", -"]
		return -code error "invalid option \"$option\":\
			should be one of -$err"
	    }
	}
	Pop args
    }
    
    if {$opts(root) == {} && $opts(repository) == {}} {
	return -code error "duh: cvsmod -root NewRoot"
    }

    return [search $opts(tree)]
}

# Look for CVS subdirectories
proc cvsmod::search {Path} {
    set r {}
    set dirs [glob -nocomplain -types d -join $Path *]
    # With CVSNT, the CVS dir may be hidden
    if {[file exists [file join $Path CVS]]} {
        lappend dirs [file join $Path CVS]
    }
    set dirs [lsort -unique $dirs]

    foreach path $dirs {
        if {[file isdirectory $path]} {
            if {[string equal [file tail $path] "CVS"]} {
                set r [concat $r [modify $path]]
            } else {
                set r [concat $r [search $path]]
            }
        }
    }
    return $r
}

proc cvsmod::modify {path} {
    variable opts
    set mod {}
    if {$opts(root) != {} && [file exists [file join $path Root]]} {
	set mod [file join $path Root]
	set f [open $mod r]
	set data [string trim [read $f]]
	close $f

	set f [open $mod w]
	puts $f $opts(root)
	close $f

        Log $mod
    }
    return $mod
}

proc cvsmod::Pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

proc cvsmod::Log {s} {
    puts $s
}

if {!$::tcl_interactive} {

    if {[package provide Tk] == {}} {
        eval [list cvsmod::cvsmod] $argv
    } else {
        set t [text .t -background white -yscrollcommand {.s set}]
        set s [scrollbar .s -command [list $t yview]]
        set b [button .b -text Dismiss -command {destroy .}]
        grid $t $s -sticky news
        grid $b -  -sticky ns
        grid rowconfigure . 0 -weight 1
        grid columnconfigure . 0 -weight 1

        proc cvsmod::Log {s} {
            .t insert end "$s\n"
        }

        eval [list cvsmod::cvsmod] $::argv

        tkwait window .
    }

    exit
}