#
# buildutil.tcl -- 
#
# Utility procedures used by the build and install tools.
#------------------------------------------------------------------------------
# Copyright 1992-1997 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: buildutil.tcl,v 8.6 1997/12/14 21:33:04 markd Exp $
#------------------------------------------------------------------------------
#

#------------------------------------------------------------------------------
# MakeAbs -- 
#   Base a file name absolute.
#------------------------------------------------------------------------------
proc MakeAbs fname {
    switch [file pathtype $fname] {
        absolute {
            return $fname
        }
        relative {
            return [file join [pwd] $fname]
        }
        volumerelative {
            return [eval file join [linsert [file split $fname] 1 [pwd]]]
        }
    }
}


#------------------------------------------------------------------------------
# CopyFile -- 
#
# Copy the specified file and change the ownership.  If target is a directory,
# then the file is copied to it, otherwise target is a new file name.
# If the source file was owner-executable, the all-executable is set on the
# created file.
#------------------------------------------------------------------------------

proc CopyFile {sourceFile target} {
    global tcl_platform

    if {[lsearch {.orig .diff .rej} [file extension $sourceFile]] >= 0} {
	return
    }
    if {[file isdirectory $target]} {
        set targetFile [file join $target [file tail $sourceFile]]
    } else {
        set targetFile $target
    }

    file delete $targetFile
    set sourceFH [open $sourceFile r]
    set targetFH [open $targetFile w]
    fconfigure $sourceFH -translation binary -eofchar {}
    fconfigure $targetFH -translation binary -eofchar {}
    fcopy $sourceFH $targetFH
    close $sourceFH
    close $targetFH

    # Fixup the mode.

    # FIX: chmod not ported to windows yet.
    if ![cequal $tcl_platform(platform) windows] {
        file stat $sourceFile sourceStat
        if {$sourceStat(mode) & 0100} {
            chmod a+rx $targetFile
        } else {
            chmod a+r  $targetFile
        }
    }
}

#------------------------------------------------------------------------------
# CopySubDir --
#
# Recursively copy part of a directory tree, changing ownership and 
# permissions.  This is a utility routine that actually does the copying.
#------------------------------------------------------------------------------

proc CopySubDir {sourceDir destDir} {
    foreach sourceFile [readdir $sourceDir] {
        set sourcePath [file join $sourceDir $sourceFile]
        if [file isdirectory $sourcePath] {
            if [cequal [file tail $sourceFile] "CVS"] {
                continue
            }
            set destFile [file join $destDir $sourceFile]
            file mkdir $destFile
            CopySubDir $sourcePath $destFile
        } else {
            CopyFile $sourcePath $destDir
        }
    }
}

#------------------------------------------------------------------------------
# CopyDir --
#
# Recurisvely copy a directory tree.
#------------------------------------------------------------------------------

proc CopyDir {sourceDir destDir} {
    set cwd [pwd]
    if ![file exists $sourceDir] {
        error "\"$sourceDir\" does not exist"
    }
    if ![file isdirectory $sourceDir] {
        error "\"$sourceDir\" isn't a directory"
    }
    if [cequal [file tail $sourceDir] "CVS"] {
          return
    }
    
    # Dirs must be absolutes paths, as we are going to change directories.

    set sourceDir [MakeAbs $sourceDir]
    set destDir [MakeAbs $destDir]

    file mkdir $destDir
    if ![file isdirectory $destDir] {
        error "\"$destDir\" isn't a directory"
    }
    cd $sourceDir
    set status [catch {CopySubDir . $destDir} msg]
    cd $cwd
    if {$status != 0} {
        global errorInfo errorCode
        error $msg $errorInfo $errorCode
    }
}



#
# instcopy.tcl -- 
#
# Tcl program to copy files during the installation of Tcl.  This is used
# because "copy -r" is not ubiquitous.  It also adds some minor additional
# functionallity.
#
#------------------------------------------------------------------------------
# Copyright 1992-1997 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: instcopy.tcl,v 8.3 1997/12/14 21:33:05 markd Exp $
#------------------------------------------------------------------------------
#
# It is run in the following manner:
#
#  instcopy file1 file2 ... targetdir
#  instcopy -filename file1 targetfile
#
#  o -filename - If specified, then the last file is the name of a file rather
#    than a directory. 
#  o -bin - Force file to be copied without translation. (not implemented).
#  o files - List of files to copy. If one of directories are specified, they
#    are copied.
#  o targetdir - Target directory to copy the files to.  If the directory does
#    not exist, it is created (including parent directories).
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

#------------------------------------------------------------------------------
# Usage --
#
#   Issue a usage message and exit.
#------------------------------------------------------------------------------
proc Usage {{msg {}}} {
    if {"$msg" != ""} {
        puts stderr "Error: $msg"
    }
    puts stderr {usage: instcopy ?-filename? file1 file2 ... targetdir}
    exit 1
}

#------------------------------------------------------------------------------
# DoACopy --
#------------------------------------------------------------------------------

proc DoACopy {file target mode} {

    if [cequal [file tail $file] "CVS"] {
        return
    }
    if {$mode == "FILENAME"} {
        set targetDir [file dirname $target]
        if [file exists $target] {
            file delete $target
        }
    } else {
        set targetDir $target
    }
    file mkdir $targetDir

    if [file isdirectory $file] {
        CopyDir $file $target
    } else {
        CopyFile $file $target
    }
}


#------------------------------------------------------------------------------
# Main program code.
#------------------------------------------------------------------------------

#
# Parse the arguments
#
if {$argc < 2} {
    Usage "Not enough arguments"
}

set mode {}
set binary 0
while {[string match -* [lindex $argv 0]]} {
    set flag [lvarpop argv]
    incr argc -1
    switch -exact -- $flag {
        -filename {
            set mode FILENAME
        }
        -bin {
            set binary 1
        }
        default {
            puts stderr "unknown flag"
        }
    }
}

set files {}
foreach file [lrange $argv 0 [expr $argc-2]] {
    lappend files [eval file join [file split $file]]
}
set targetDir [eval file join [file split [lindex $argv [expr $argc-1]]]]

if {[file exists $targetDir] && ![file isdirectory $targetDir] &&
    ($mode != "FILENAME")} {
   Usage "Target is not a directory: $targetDir"
}

umask 022

if [catch {
    foreach file $files {
        DoACopy $file $targetDir $mode
    }
} msg] {
    puts stderr "Error: $msg"
    exit 1
}


