cvs.zerfleddert.de Git - micropolis/blame_incremental - src/tclx/tclsrc/install.tcl

#
# installTcl.tcl --
#
# Tcl program to install Tcl onto the system.
#
#------------------------------------------------------------------------------
# Copyright 1992 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: installTcl.tcl,v 2.0 1992/10/16 04:52:08 markd Rel $
#------------------------------------------------------------------------------
#
# It is run in the following manner:
#
#     tcl installTcl.tcl
#
# This script reads the Extended Tcl Makefile confiugation file (Config.mk)
# and converts the Makefile macros in Tcl variables that control the
# installation.  The following variables are currently used:
#
#   TCL_UCB_DIR             TCL_DEFAULT             TCL_OWNER
#   TCL_GROUP               TCL_BINDIR              TCL_LIBDIR
#   TCL_INCLUDEDIR          TCL_TCLDIR              TCL_MAN_INSTALL
#   TCL_MAN_BASEDIR         TCL_MAN_CMD_SECTION     TCL_MAN_FUNC_SECTION
#   TK_MAN_CMD_SECTION      TK_MAN_FUNC_SECTION     TCL_MAN_STYLE*
#   TCL_MAN_INDEX*          TCL_TK_SHELL*
#
# (ones marked with * are optional)
#
# Notes:
#   o Must be run in the Extended Tcl top level directory.
#   o The routine InstallManPages has code to determine if a manual page
#     belongs to a command or function.  For Tcl the commands are assumed
#     to be in "Tcl.man",  for TclX functions are in TclX.man.  All others
#     are assumed to be functions.  For Tk, all manuals starting with Tk_
#     are assumed to be functions, all others are assumed to be commands.
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

#------------------------------------------------------------------------------
# ParseConfigFile --
#
#  Parse a configure file in the current directory and convert all make
#  macros to global Tcl variables.

proc ParseConfigFile {configFile} {
   set cfgFH [open $configFile]

   while {[gets $cfgFH line] >= 0} {
      if {[string match {[A-Za-z]*} $line]} {
          set idx [string first "=" $line]
          if {$idx < 0} {
              error "no `=' in: $line"}
          set name  [string trim [csubstr $line 0 $idx]]
          set value [string trim [crange  $line [expr $idx+1] end]]
          global $name
          set $name $value
      }
   }
   close $cfgFH

}

#------------------------------------------------------------------------------
# GiveAwayFile --
#   Give away a file to the Tcl owner and group and set its permissions.
#
# Globals:
#    TCL_OWNER - Owner name for Tcl files.
#    TCL_GROUP - Group nmae for Tcl file.
#------------------------------------------------------------------------------

proc GiveAwayFile {file} {
    global TCL_OWNER TCL_GROUP

    if {[file isdirectory $file]} {
        chmod a+rx,go-w $file
    } else {
        chmod a+r,go-w $file
    }
    chown [list $TCL_OWNER $TCL_GROUP] $file

} ;# GiveAwayFile

#------------------------------------------------------------------------------
# MakePath --
#
# Make sure all directories in a directory path exists, if not, create them.
#------------------------------------------------------------------------------
proc MakePath {pathlist} {
    foreach path $pathlist {
        set exploded_path [split $path /]
        set thisdir {}
        foreach element $exploded_path {
            append thisdir $element
            if {![file isdirectory $thisdir]} {
                mkdir $thisdir
                GiveAwayFile $thisdir
            }
            append thisdir /
        }
    }
}

#------------------------------------------------------------------------------
# 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.
#------------------------------------------------------------------------------

proc CopyFile {sourceFile target} {

    if {[file isdirectory $target]} {
        set targetFile "$target/[file tail $sourceFile]"
    } else {
        set targetFile $target
    }

    unlink -nocomplain $targetFile
    set sourceFH [open $sourceFile r]
    set targetFH [open $targetFile w]
    copyfile $sourceFH $targetFH
    close $sourceFH
    close $targetFH
    GiveAwayFile $targetFile

} ;# CopyFile

#------------------------------------------------------------------------------
# CopyManPage --
#
# Copy the specified manual page and change the ownership.  The manual page
# is edited to remove change bars (.VS and .VE macros). If target is a
# directory, then the file is copied to it, otherwise target is a new file
# name.
#------------------------------------------------------------------------------

proc CopyManPage {sourceFile target} {

    if {[file isdirectory $target]} {
        set targetFile "$target/[file tail $sourceFile]"
    } else {
        set targetFile $target
    }

    unlink -nocomplain $targetFile
    set sourceFH [open $sourceFile r]
    set targetFH [open $targetFile w]
    while {[gets $sourceFH line] >= 0} {
        if [string match {.V[SE]*} $line] continue
        puts $targetFH $line
    }
    close $sourceFH
    close $targetFH
    GiveAwayFile $targetFile

} ;# CopyManPage

#------------------------------------------------------------------------------
# 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 [glob -nocomplain $sourceDir/*] {

        if [file isdirectory $sourceFile] {
            set destFile $destDir/[file tail $sourceFile]
            if {![file exists $destFile]} {
                mkdir $destFile}
            GiveAwayFile $destFile
            CopySubDir $sourceFile $destFile
        } else {
            CopyFile $sourceFile $destDir
        }
    }
} ;# CopySubDir

#------------------------------------------------------------------------------
# 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 {![file exists $destDir]} {
        mkdir $destDir
        GiveAwayFile $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
    }
}

#------------------------------------------------------------------------------
# GenDefaultFile --
#
# Generate the tcl defaults file.
#------------------------------------------------------------------------------

proc GenDefaultFile {defaultFileBase sourceDir} {

    set defaultFile "$defaultFileBase[infox version]"

    if ![file writable [file dirname $defaultFile]] {
        puts stderr "Can't create $defaultFile -- directory is not writable"
        puts stderr "Please reinstall with correct permissions or rebuild"
        puts stderr "Tcl to select a default file where the directory path"
        puts stderr "you specify is writable by you."
        puts stderr ""
        exit 1
    }

    set fp [open $defaultFile w]

    puts $fp "# Extended Tcl [infox version] default file"
    puts $fp ""
    puts $fp "set TCLINIT $sourceDir/TclInit.tcl"
    puts $fp ""
    puts $fp "set TCLPATH $sourceDir"

    close $fp
    GiveAwayFile $defaultFile

} ;# GenDefaultFile

#------------------------------------------------------------------------------
# GetManNames --
#
#   Search a manual page (nroff source) for the name line.  Parse the name
# line into all of the functions or commands that it references.  This isn't
# comprehensive, but it works for all of the Tcl, TclX and Tk man pages.
#
# Parameters:
#   o manFile (I) - The path to the  manual page file.
# Returns:
#   A list contain the functions or commands or {} if the name line can't be
# found or parsed.
#------------------------------------------------------------------------------

proc GetManNames {manFile} {

   set manFH [open $manFile]

   #
   # Search for name line.  Once found, grab the next line that is not a
   # nroff macro.  If we end up with a blank line, we didn't find it.
   #
   while {[gets $manFH line] >= 0} {
       if [regexp {^.SH NAME.*$} $line] {
           break
       }
   }
   while {[gets $manFH line] >= 0} {
       if {![string match ".*" $line]} break
   }
   close $manFH

   set line [string trim $line]
   if {$line == ""} return

   #
   # Lets try and parse the name list out of the line
   #
   if {![regexp {^(.*)(\\-)} $line {} namePart]} {
       if {![regexp {^(.*)(-)} $line {} namePart]} return
   }

   #
   # This magic converts the name line into a list
   #

   if {[catch {join [split $namePart ,] " "} namePart] != 0} return

   return $namePart

}

#------------------------------------------------------------------------------
# SetUpManIndex --
#   Setup generation of manual page index for short manual pages, if required.
# Globals:
#   o TCL_MAN_INDEX - Boolean indicating if a manual page is to be created.
#     If it does not exists, false is assumed.
#   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
#     directories live.
# Returns:
#   The manual index file handle, or {} if the manual index is not to be
#  generated.
#------------------------------------------------------------------------------

proc SetUpManIndex {} {
    global TCL_MAN_BASEDIR TCL_MAN_INDEX

    if {!([info exists TCL_MAN_INDEX] && [set TCL_MAN_INDEX])} {
        return {}
    }
    set tclIndexFile $TCL_MAN_BASEDIR/index.TCL
    return [open $tclIndexFile w]
}

#------------------------------------------------------------------------------
# FinishUpManIndex --
#   Finish generation of manual page index for short manual pages, if required.
# Parameters:
#   o indexFileHdl - The file handle returned by SetUpManIndex, maybe {}.
# Globals:
#   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
#     directories live.
#------------------------------------------------------------------------------

proc FinishUpManIndex {indexFileHdl} {
    global TCL_MAN_BASEDIR TCL_MAN_INDEX_MERGE

    if [lempty $indexFileHdl] return

    set tclIndexFile $TCL_MAN_BASEDIR/index.TCL
    close $indexFileHdl
    GiveAwayFile $tclIndexFile

}

#------------------------------------------------------------------------------
# InstallShortMan --
#   Install a manual page on a system that does not have long file names,
#   optionally adding an entry to the man index.
#
# Parameters:
#   o sourceFile - Manual page source file path.
#   o section - Section to install the manual page in.
#   o indexFileHdl - File handle of the current index file being created, or
#     empty if no index is to be created.
# Globals:
#   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
#     directories live.
#   o TCL_MAN_SEPARATOR - The name separator between the directory and the
#     section.
#------------------------------------------------------------------------------

proc InstallShortMan {sourceFile section indexFileHdl} {
    global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR

    set manNames [GetManNames $sourceFile]
    if [lempty $manNames] {
        set baseName [file tail [file root $sourceFile]]
        puts stderr "Warning: can't parse NAME line for man page: $sourceFile."
        puts stderr "         Manual page only available as: $baseName"
    }

    set manFileBase [file tail [file root $sourceFile]]
    set manFileName "$manFileBase.$section"

    set destManDir "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$section"
    set destCatDir "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$section"

    CopyManPage $sourceFile "$destManDir/$manFileName"
    unlink -nocomplain  "$destCatDir/$manFileName"

    if {![lempty $indexFileHdl]} {
        foreach name $manNames {
            puts $indexFileHdl "$name\t$manFileBase\t$section"
        }
    }
}

#------------------------------------------------------------------------------
# InstallLongMan --
#   Install a manual page on a system that does have long file names.
#
# Parameters:
#   o sourceFile - Manual page source file path.
#   o section - Section to install the manual page in.
# Globals:
#   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
#     directories live.
#   o TCL_MAN_SEPARATOR - The name separator between the directory and the
#     section.
#------------------------------------------------------------------------------

proc InstallLongMan {sourceFile section} {
    global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR

    set manNames [GetManNames $sourceFile]
    if [lempty $manNames] {
        set baseName [file tail [file root $sourceFile]]
        puts stderr "Warning: can't parse NAME line for man page: $sourceFile."
        puts stderr "         Manual page only available as: $baseName"
        set manNames $baseName
    }

    set destManDir "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$section"
    set destCatDir "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$section"

    # Copy file to the first name in the list.

    set firstFile [lvarpop manNames]
    set firstFilePath "$destManDir/$firstFile.$section"

    CopyManPage $sourceFile $firstFilePath
    unlink -nocomplain   "$destCatDir/$firstFile.$section"

    # Link it to the rest of the names in the list.

    foreach manEntry $manNames {
        set destFilePath "$destManDir/$manEntry.$section"
        unlink -nocomplain  $destFilePath
        if {[catch {
                link $firstFilePath $destFilePath
            } msg] != 0} {
            puts stderr "error from: link $firstFilePath $destFilePath"
            puts stderr "    $msg"
        }
        unlink -nocomplain "$destCatDir/$manEntry.$section"
    }

}

#------------------------------------------------------------------------------
# InstallManPage --
#   Install a manual page on a system.
#
# Parameters:
#   o sourceFile - Manual page source file path.
#   o section - Section to install the manual page in.
#   o indexFileHdl - File handle of the current index file being created, or
#     empty if no index is to be created.
# Globals
#   o TCL_MAN_STYLE - SHORT if short manual page names are being used,
#     LONG if long manual pages are being used.
#------------------------------------------------------------------------------

proc InstallManPage {sourceFile section indexFileHdl} {
    global TCL_MAN_STYLE

    if {"$TCL_MAN_STYLE" == "SHORT"} {
        InstallShortMan $sourceFile $section $indexFileHdl
    } else {
        InstallLongMan $sourceFile $section
    }
}

#------------------------------------------------------------------------------
# InstallManPages --
#   Install the manual pages.
#------------------------------------------------------------------------------

proc InstallManPages {} {
    global TCL_UCB_DIR          TCL_TK_SHELL         TCL_TK_DIR
    global TCL_MAN_BASEDIR      TCL_MAN_SEPARATOR    TCL_MAN_STYLE
    global TCL_MAN_CMD_SECTION  TCL_MAN_FUNC_SECTION
    global TK_MAN_CMD_SECTION   TK_MAN_FUNC_SECTION

    if {![info exists TCL_MAN_STYLE]} {
        set TCL_MAN_STYLE LONG
    }
    set TCL_MAN_STYLE [string toupper $TCL_MAN_STYLE]
    case $TCL_MAN_STYLE in {
        {SHORT} {}
        {LONG}  {}
        default {error "invalid value for TCL_MAN_STYLE: `$TCL_MAN_STYLE'"}
    }

    MakePath $TCL_MAN_BASEDIR
    MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TCL_MAN_CMD_SECTION"
    MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TCL_MAN_CMD_SECTION"
    MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TCL_MAN_FUNC_SECTION"
    MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TCL_MAN_FUNC_SECTION"

    set indexFileHdl [SetUpManIndex]

    # Install all of the actual files.

    echo "    Installing Tcl [info tclversion] man files"
    foreach fileName [glob $TCL_UCB_DIR/doc/*.man] {
        if {[file root $fileName] == "Tcl.man"} {
            set section $TCL_MAN_CMD_SECTION
        } else {
            set section $TCL_MAN_FUNC_SECTION
        }
        InstallManPage $fileName $section $indexFileHdl
    }

    echo "    Installing Extended Tcl [infox version] man files"

    foreach fileName [glob man/*.man] {
        if {[file root $fileName] == "TclX.man"} {
            set section $TCL_MAN_CMD_SECTION
        } else {
            set section $TCL_MAN_FUNC_SECTION
        }
        InstallManPage $fileName $section $indexFileHdl
    }

    if {![info exists TCL_TK_SHELL]} {
        FinishUpManIndex $indexFileHdl
        return
    }

    MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TK_MAN_CMD_SECTION"
    MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TK_MAN_CMD_SECTION"
    MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TK_MAN_FUNC_SECTION"
    MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TK_MAN_FUNC_SECTION"

    echo "    Installing Tk man files"

    foreach fileName [glob $TCL_TK_DIR/doc/*.man] {
        if {![string match "Tk_*" [file root $fileName]]} {
            set section $TK_MAN_CMD_SECTION
        } else {
            set section $TK_MAN_FUNC_SECTION
        }
        InstallManPage $fileName $section $indexFileHdl
    }

    FinishUpManIndex $indexFileHdl

} ;# InstallLongManPages

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

echo ""
echo ">>> Installing Extended Tcl [infox version] <<<"

set argc [llength $argv]
if {$argc != 0} {
    puts stderr "usage: tcl installTcl.tcl"
    exit 1
}

#
# Bring in all of the macros defined bu the configuration file.
#
ParseConfigFile Config.mk
ParseConfigFile config/$TCL_CONFIG_FILE

#
# Make sure all directories exists that we will be installing in.
#

MakePath [list $TCL_TCLDIR [file dirname $TCL_DEFAULT] $TCL_BINDIR]
MakePath [list $TCL_LIBDIR $TCL_INCLUDEDIR $TCL_TCLDIR]

echo "    Creating default file: $TCL_DEFAULT[infox version]"
GenDefaultFile $TCL_DEFAULT $TCL_TCLDIR

echo "    Installing `tcl' program in: $TCL_BINDIR"
CopyFile tcl $TCL_BINDIR
chmod +rx $TCL_BINDIR/tcl

echo "    Installing `libtcl.a' library in: $TCL_LIBDIR"
CopyFile libtcl.a $TCL_LIBDIR

echo "    Installing Tcl .h files in: $TCL_INCLUDEDIR"
CopyFile $TCL_UCB_DIR/tcl.h $TCL_INCLUDEDIR
CopyFile $TCL_UCB_DIR/tclHash.h $TCL_INCLUDEDIR
CopyFile src/tclExtend.h $TCL_INCLUDEDIR
CopyFile src/tcl++.h $TCL_INCLUDEDIR

echo "    Installing Tcl run-time files in: $TCL_TCLDIR"
foreach srcFile [glob tcllib/*] {
    if {![file isdirectory $srcFile]} {
        CopyFile $srcFile $TCL_TCLDIR
    }
}

echo "    Installing Tcl help files in: $TCL_TCLDIR/help"
if [file exists $TCL_TCLDIR/help] {
     echo "       Purging old help tree"
     exec rm -rf $TCL_TCLDIR/help
}
CopyDir tcllib/help          $TCL_TCLDIR/help

if [info exists TCL_TK_SHELL] {
    echo "    Installing `wish' program in: $TCL_BINDIR"
    CopyFile wish $TCL_BINDIR
    chmod +rx $TCL_BINDIR/wish

    echo "    Installing `libtk.a' library in: $TCL_LIBDIR"
    CopyFile libtk.a $TCL_LIBDIR

    echo "    Installing `tk.h' in: $TCL_INCLUDEDIR"
    CopyFile $TCL_TK_DIR/tk.h $TCL_INCLUDEDIR
}

foreach file [glob $TCL_TCLDIR/*.tlib] {
    buildpackageindex $file
}

if {$TCL_MAN_INSTALL} {
    InstallManPages
}

echo "     *** TCL IS NOW INSTALLED ***"
Commit	Line	Data
	1	#
	2	# installTcl.tcl --
	3	#
	4	# Tcl program to install Tcl onto the system.
	5	#
	6	#------------------------------------------------------------------------------
	7	# Copyright 1992 Karl Lehenbauer and Mark Diekhans.
	8	#
	9	# Permission to use, copy, modify, and distribute this software and its
	10	# documentation for any purpose and without fee is hereby granted, provided
	11	# that the above copyright notice appear in all copies. Karl Lehenbauer and
	12	# Mark Diekhans make no representations about the suitability of this
	13	# software for any purpose. It is provided "as is" without express or
	14	# implied warranty.
	15	#------------------------------------------------------------------------------
	16	# $Id: installTcl.tcl,v 2.0 1992/10/16 04:52:08 markd Rel $
	17	#------------------------------------------------------------------------------
	18	#
	19	# It is run in the following manner:
	20	#
	21	# tcl installTcl.tcl
	22	#
	23	# This script reads the Extended Tcl Makefile confiugation file (Config.mk)
	24	# and converts the Makefile macros in Tcl variables that control the
	25	# installation. The following variables are currently used:
	26	#
	27	# TCL_UCB_DIR TCL_DEFAULT TCL_OWNER
	28	# TCL_GROUP TCL_BINDIR TCL_LIBDIR
	29	# TCL_INCLUDEDIR TCL_TCLDIR TCL_MAN_INSTALL
	30	# TCL_MAN_BASEDIR TCL_MAN_CMD_SECTION TCL_MAN_FUNC_SECTION
	31	# TK_MAN_CMD_SECTION TK_MAN_FUNC_SECTION TCL_MAN_STYLE*
	32	# TCL_MAN_INDEX* TCL_TK_SHELL*
	33	#
	34	# (ones marked with * are optional)
	35	#
	36	# Notes:
	37	# o Must be run in the Extended Tcl top level directory.
	38	# o The routine InstallManPages has code to determine if a manual page
	39	# belongs to a command or function. For Tcl the commands are assumed
	40	# to be in "Tcl.man", for TclX functions are in TclX.man. All others
	41	# are assumed to be functions. For Tk, all manuals starting with Tk_
	42	# are assumed to be functions, all others are assumed to be commands.
	43	#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
	44
	45	#------------------------------------------------------------------------------
	46	# ParseConfigFile --
	47	#
	48	# Parse a configure file in the current directory and convert all make
	49	# macros to global Tcl variables.
	50
	51	proc ParseConfigFile {configFile} {
	52	set cfgFH [open $configFile]
	53
	54	while {[gets $cfgFH line] >= 0} {
	55	if {[string match {[A-Za-z]*} $line]} {
	56	set idx [string first "=" $line]
	57	if {$idx < 0} {
	58	error "no `=' in: $line"}
	59	set name [string trim [csubstr $line 0 $idx]]
	60	set value [string trim [crange $line [expr $idx+1] end]]
	61	global $name
	62	set $name $value
	63	}
	64	}
	65	close $cfgFH
	66
	67	}
	68
	69	#------------------------------------------------------------------------------
	70	# GiveAwayFile --
	71	# Give away a file to the Tcl owner and group and set its permissions.
	72	#
	73	# Globals:
	74	# TCL_OWNER - Owner name for Tcl files.
	75	# TCL_GROUP - Group nmae for Tcl file.
	76	#------------------------------------------------------------------------------
	77
	78	proc GiveAwayFile {file} {
	79	global TCL_OWNER TCL_GROUP
	80
	81	if {[file isdirectory $file]} {
	82	chmod a+rx,go-w $file
	83	} else {
	84	chmod a+r,go-w $file
	85	}
	86	chown [list $TCL_OWNER $TCL_GROUP] $file
	87
	88	} ;# GiveAwayFile
	89
	90	#------------------------------------------------------------------------------
	91	# MakePath --
	92	#
	93	# Make sure all directories in a directory path exists, if not, create them.
	94	#------------------------------------------------------------------------------
	95	proc MakePath {pathlist} {
	96	foreach path $pathlist {
	97	set exploded_path [split $path /]
	98	set thisdir {}
	99	foreach element $exploded_path {
	100	append thisdir $element
	101	if {![file isdirectory $thisdir]} {
	102	mkdir $thisdir
	103	GiveAwayFile $thisdir
	104	}
	105	append thisdir /
	106	}
	107	}
	108	}
	109
	110	#------------------------------------------------------------------------------
	111	# CopyFile --
	112	#
	113	# Copy the specified file and change the ownership. If target is a directory,
	114	# then the file is copied to it, otherwise target is a new file name.
	115	#------------------------------------------------------------------------------
	116
	117	proc CopyFile {sourceFile target} {
	118
	119	if {[file isdirectory $target]} {
	120	set targetFile "$target/[file tail $sourceFile]"
	121	} else {
	122	set targetFile $target
	123	}
	124
	125	unlink -nocomplain $targetFile
	126	set sourceFH [open $sourceFile r]
	127	set targetFH [open $targetFile w]
	128	copyfile $sourceFH $targetFH
	129	close $sourceFH
	130	close $targetFH
	131	GiveAwayFile $targetFile
	132
	133	} ;# CopyFile
	134
	135	#------------------------------------------------------------------------------
	136	# CopyManPage --
	137	#
	138	# Copy the specified manual page and change the ownership. The manual page
	139	# is edited to remove change bars (.VS and .VE macros). If target is a
	140	# directory, then the file is copied to it, otherwise target is a new file
	141	# name.
	142	#------------------------------------------------------------------------------
	143
	144	proc CopyManPage {sourceFile target} {
	145
	146	if {[file isdirectory $target]} {
	147	set targetFile "$target/[file tail $sourceFile]"
	148	} else {
	149	set targetFile $target
	150	}
	151
	152	unlink -nocomplain $targetFile
	153	set sourceFH [open $sourceFile r]
	154	set targetFH [open $targetFile w]
	155	while {[gets $sourceFH line] >= 0} {
	156	if [string match {.V[SE]*} $line] continue
	157	puts $targetFH $line
	158	}
	159	close $sourceFH
	160	close $targetFH
	161	GiveAwayFile $targetFile
	162
	163	} ;# CopyManPage
	164
	165	#------------------------------------------------------------------------------
	166	# CopySubDir --
	167	#
	168	# Recursively copy part of a directory tree, changing ownership and
	169	# permissions. This is a utility routine that actually does the copying.
	170	#------------------------------------------------------------------------------
	171
	172	proc CopySubDir {sourceDir destDir} {
	173	foreach sourceFile [glob -nocomplain $sourceDir/*] {
	174
	175	if [file isdirectory $sourceFile] {
	176	set destFile $destDir/[file tail $sourceFile]
	177	if {![file exists $destFile]} {
	178	mkdir $destFile}
	179	GiveAwayFile $destFile
	180	CopySubDir $sourceFile $destFile
	181	} else {
	182	CopyFile $sourceFile $destDir
	183	}
	184	}
	185	} ;# CopySubDir
	186
	187	#------------------------------------------------------------------------------
	188	# CopyDir --
	189	#
	190	# Recurisvely copy a directory tree.
	191	#------------------------------------------------------------------------------
	192
	193	proc CopyDir {sourceDir destDir} {
	194
	195	set cwd [pwd]
	196	if ![file exists $sourceDir] {
	197	error "\"$sourceDir\" does not exist"
	198	}
	199	if ![file isdirectory $sourceDir] {
	200	error "\"$sourceDir\" isn't a directory"
	201	}
	202	if {![file exists $destDir]} {
	203	mkdir $destDir
	204	GiveAwayFile $destDir
	205	}
	206	if ![file isdirectory $destDir] {
	207	error "\"$destDir\" isn't a directory"
	208	}
	209	cd $sourceDir
	210	set status [catch {CopySubDir . $destDir} msg]
	211	cd $cwd
	212	if {$status != 0} {
	213	global errorInfo errorCode
	214	error $msg $errorInfo $errorCode
	215	}
	216	}
	217
	218	#------------------------------------------------------------------------------
	219	# GenDefaultFile --
	220	#
	221	# Generate the tcl defaults file.
	222	#------------------------------------------------------------------------------
	223
	224	proc GenDefaultFile {defaultFileBase sourceDir} {
	225
	226	set defaultFile "$defaultFileBase[infox version]"
	227
	228	if ![file writable [file dirname $defaultFile]] {
	229	puts stderr "Can't create $defaultFile -- directory is not writable"
	230	puts stderr "Please reinstall with correct permissions or rebuild"
	231	puts stderr "Tcl to select a default file where the directory path"
	232	puts stderr "you specify is writable by you."
	233	puts stderr ""
	234	exit 1
	235	}
	236
	237	set fp [open $defaultFile w]
	238
	239	puts $fp "# Extended Tcl [infox version] default file"
	240	puts $fp ""
	241	puts $fp "set TCLINIT $sourceDir/TclInit.tcl"
	242	puts $fp ""
	243	puts $fp "set TCLPATH $sourceDir"
	244
	245	close $fp
	246	GiveAwayFile $defaultFile
	247
	248	} ;# GenDefaultFile
	249
	250	#------------------------------------------------------------------------------
	251	# GetManNames --
	252	#
	253	# Search a manual page (nroff source) for the name line. Parse the name
	254	# line into all of the functions or commands that it references. This isn't
	255	# comprehensive, but it works for all of the Tcl, TclX and Tk man pages.
	256	#
	257	# Parameters:
	258	# o manFile (I) - The path to the manual page file.
	259	# Returns:
	260	# A list contain the functions or commands or {} if the name line can't be
	261	# found or parsed.
	262	#------------------------------------------------------------------------------
	263
	264	proc GetManNames {manFile} {
	265
	266	set manFH [open $manFile]
	267
	268	#
	269	# Search for name line. Once found, grab the next line that is not a
	270	# nroff macro. If we end up with a blank line, we didn't find it.
	271	#
	272	while {[gets $manFH line] >= 0} {
	273	if [regexp {^.SH NAME.*$} $line] {
	274	break
	275	}
	276	}
	277	while {[gets $manFH line] >= 0} {
	278	if {![string match ".*" $line]} break
	279	}
	280	close $manFH
	281
	282	set line [string trim $line]
	283	if {$line == ""} return
	284
	285	#
	286	# Lets try and parse the name list out of the line
	287	#
	288	if {![regexp {^(.*)(\\-)} $line {} namePart]} {
	289	if {![regexp {^(.*)(-)} $line {} namePart]} return
	290	}
	291
	292	#
	293	# This magic converts the name line into a list
	294	#
	295
	296	if {[catch {join [split $namePart ,] " "} namePart] != 0} return
	297
	298	return $namePart
	299
	300	}
	301
	302	#------------------------------------------------------------------------------
	303	# SetUpManIndex --
	304	# Setup generation of manual page index for short manual pages, if required.
	305	# Globals:
	306	# o TCL_MAN_INDEX - Boolean indicating if a manual page is to be created.
	307	# If it does not exists, false is assumed.
	308	# o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
	309	# directories live.
	310	# Returns:
	311	# The manual index file handle, or {} if the manual index is not to be
	312	# generated.
	313	#------------------------------------------------------------------------------
	314
	315	proc SetUpManIndex {} {
	316	global TCL_MAN_BASEDIR TCL_MAN_INDEX
	317
	318	if {!([info exists TCL_MAN_INDEX] && [set TCL_MAN_INDEX])} {
	319	return {}
	320	}
	321	set tclIndexFile $TCL_MAN_BASEDIR/index.TCL
	322	return [open $tclIndexFile w]
	323	}
	324
	325	#------------------------------------------------------------------------------
	326	# FinishUpManIndex --
	327	# Finish generation of manual page index for short manual pages, if required.
	328	# Parameters:
	329	# o indexFileHdl - The file handle returned by SetUpManIndex, maybe {}.
	330	# Globals:
	331	# o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
	332	# directories live.
	333	#------------------------------------------------------------------------------
	334
	335	proc FinishUpManIndex {indexFileHdl} {
	336	global TCL_MAN_BASEDIR TCL_MAN_INDEX_MERGE
	337
	338	if [lempty $indexFileHdl] return
	339
	340	set tclIndexFile $TCL_MAN_BASEDIR/index.TCL
	341	close $indexFileHdl
	342	GiveAwayFile $tclIndexFile
	343
	344	}
	345
	346	#------------------------------------------------------------------------------
	347	# InstallShortMan --
	348	# Install a manual page on a system that does not have long file names,
	349	# optionally adding an entry to the man index.
	350	#
	351	# Parameters:
	352	# o sourceFile - Manual page source file path.
	353	# o section - Section to install the manual page in.
	354	# o indexFileHdl - File handle of the current index file being created, or
	355	# empty if no index is to be created.
	356	# Globals:
	357	# o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
	358	# directories live.
	359	# o TCL_MAN_SEPARATOR - The name separator between the directory and the
	360	# section.
	361	#------------------------------------------------------------------------------
	362
	363	proc InstallShortMan {sourceFile section indexFileHdl} {
	364	global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR
	365
	366	set manNames [GetManNames $sourceFile]
	367	if [lempty $manNames] {
	368	set baseName [file tail [file root $sourceFile]]
	369	puts stderr "Warning: can't parse NAME line for man page: $sourceFile."
	370	puts stderr " Manual page only available as: $baseName"
	371	}
	372
	373	set manFileBase [file tail [file root $sourceFile]]
	374	set manFileName "$manFileBase.$section"
	375
	376	set destManDir "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$section"
	377	set destCatDir "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$section"
	378
	379	CopyManPage $sourceFile "$destManDir/$manFileName"
	380	unlink -nocomplain "$destCatDir/$manFileName"
	381
	382	if {![lempty $indexFileHdl]} {
	383	foreach name $manNames {
	384	puts $indexFileHdl "$name\t$manFileBase\t$section"
	385	}
	386	}
	387	}
	388
	389	#------------------------------------------------------------------------------
	390	# InstallLongMan --
	391	# Install a manual page on a system that does have long file names.
	392	#
	393	# Parameters:
	394	# o sourceFile - Manual page source file path.
	395	# o section - Section to install the manual page in.
	396	# Globals:
	397	# o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
	398	# directories live.
	399	# o TCL_MAN_SEPARATOR - The name separator between the directory and the
	400	# section.
	401	#------------------------------------------------------------------------------
	402
	403	proc InstallLongMan {sourceFile section} {
	404	global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR
	405
	406	set manNames [GetManNames $sourceFile]
	407	if [lempty $manNames] {
	408	set baseName [file tail [file root $sourceFile]]
	409	puts stderr "Warning: can't parse NAME line for man page: $sourceFile."
	410	puts stderr " Manual page only available as: $baseName"
	411	set manNames $baseName
	412	}
	413
	414	set destManDir "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$section"
	415	set destCatDir "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$section"
	416
	417	# Copy file to the first name in the list.
	418
	419	set firstFile [lvarpop manNames]
	420	set firstFilePath "$destManDir/$firstFile.$section"
	421
	422	CopyManPage $sourceFile $firstFilePath
	423	unlink -nocomplain "$destCatDir/$firstFile.$section"
	424
	425	# Link it to the rest of the names in the list.
	426
	427	foreach manEntry $manNames {
	428	set destFilePath "$destManDir/$manEntry.$section"
	429	unlink -nocomplain $destFilePath
	430	if {[catch {
	431	link $firstFilePath $destFilePath
	432	} msg] != 0} {
	433	puts stderr "error from: link $firstFilePath $destFilePath"
	434	puts stderr " $msg"
	435	}
	436	unlink -nocomplain "$destCatDir/$manEntry.$section"
	437	}
	438
	439	}
	440
	441	#------------------------------------------------------------------------------
	442	# InstallManPage --
	443	# Install a manual page on a system.
	444	#
	445	# Parameters:
	446	# o sourceFile - Manual page source file path.
	447	# o section - Section to install the manual page in.
	448	# o indexFileHdl - File handle of the current index file being created, or
	449	# empty if no index is to be created.
	450	# Globals
	451	# o TCL_MAN_STYLE - SHORT if short manual page names are being used,
	452	# LONG if long manual pages are being used.
	453	#------------------------------------------------------------------------------
	454
	455	proc InstallManPage {sourceFile section indexFileHdl} {
	456	global TCL_MAN_STYLE
	457
	458	if {"$TCL_MAN_STYLE" == "SHORT"} {
	459	InstallShortMan $sourceFile $section $indexFileHdl
	460	} else {
	461	InstallLongMan $sourceFile $section
	462	}
	463	}
	464
	465	#------------------------------------------------------------------------------
	466	# InstallManPages --
	467	# Install the manual pages.
	468	#------------------------------------------------------------------------------
	469
	470	proc InstallManPages {} {
	471	global TCL_UCB_DIR TCL_TK_SHELL TCL_TK_DIR
	472	global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR TCL_MAN_STYLE
	473	global TCL_MAN_CMD_SECTION TCL_MAN_FUNC_SECTION
	474	global TK_MAN_CMD_SECTION TK_MAN_FUNC_SECTION
	475
	476	if {![info exists TCL_MAN_STYLE]} {
	477	set TCL_MAN_STYLE LONG
	478	}
	479	set TCL_MAN_STYLE [string toupper $TCL_MAN_STYLE]
	480	case $TCL_MAN_STYLE in {
	481	{SHORT} {}
	482	{LONG} {}
	483	default {error "invalid value for TCL_MAN_STYLE: `$TCL_MAN_STYLE'"}
	484	}
	485
	486	MakePath $TCL_MAN_BASEDIR
	487	MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TCL_MAN_CMD_SECTION"
	488	MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TCL_MAN_CMD_SECTION"
	489	MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TCL_MAN_FUNC_SECTION"
	490	MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TCL_MAN_FUNC_SECTION"
	491
	492	set indexFileHdl [SetUpManIndex]
	493
	494	# Install all of the actual files.
	495
	496	echo " Installing Tcl [info tclversion] man files"
	497	foreach fileName [glob $TCL_UCB_DIR/doc/*.man] {
	498	if {[file root $fileName] == "Tcl.man"} {
	499	set section $TCL_MAN_CMD_SECTION
	500	} else {
	501	set section $TCL_MAN_FUNC_SECTION
	502	}
	503	InstallManPage $fileName $section $indexFileHdl
	504	}
	505
	506	echo " Installing Extended Tcl [infox version] man files"
	507
	508	foreach fileName [glob man/*.man] {
	509	if {[file root $fileName] == "TclX.man"} {
	510	set section $TCL_MAN_CMD_SECTION
	511	} else {
	512	set section $TCL_MAN_FUNC_SECTION
	513	}
	514	InstallManPage $fileName $section $indexFileHdl
	515	}
	516
	517	if {![info exists TCL_TK_SHELL]} {
	518	FinishUpManIndex $indexFileHdl
	519	return
	520	}
	521
	522	MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TK_MAN_CMD_SECTION"
	523	MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TK_MAN_CMD_SECTION"
	524	MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TK_MAN_FUNC_SECTION"
	525	MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TK_MAN_FUNC_SECTION"
	526
	527	echo " Installing Tk man files"
	528
	529	foreach fileName [glob $TCL_TK_DIR/doc/*.man] {
	530	if {![string match "Tk_*" [file root $fileName]]} {
	531	set section $TK_MAN_CMD_SECTION
	532	} else {
	533	set section $TK_MAN_FUNC_SECTION
	534	}
	535	InstallManPage $fileName $section $indexFileHdl
	536	}
	537
	538	FinishUpManIndex $indexFileHdl
	539
	540	} ;# InstallLongManPages
	541
	542	#------------------------------------------------------------------------------
	543	# Main program code.
	544	#------------------------------------------------------------------------------
	545
	546	echo ""
	547	echo ">>> Installing Extended Tcl [infox version] <<<"
	548
	549	set argc [llength $argv]
	550	if {$argc != 0} {
	551	puts stderr "usage: tcl installTcl.tcl"
	552	exit 1
	553	}
	554
	555	#
	556	# Bring in all of the macros defined bu the configuration file.
	557	#
	558	ParseConfigFile Config.mk
	559	ParseConfigFile config/$TCL_CONFIG_FILE
	560
	561	#
	562	# Make sure all directories exists that we will be installing in.
	563	#
	564
	565	MakePath [list $TCL_TCLDIR [file dirname $TCL_DEFAULT] $TCL_BINDIR]
	566	MakePath [list $TCL_LIBDIR $TCL_INCLUDEDIR $TCL_TCLDIR]
	567
	568	echo " Creating default file: $TCL_DEFAULT[infox version]"
	569	GenDefaultFile $TCL_DEFAULT $TCL_TCLDIR
	570
	571	echo " Installing `tcl' program in: $TCL_BINDIR"
	572	CopyFile tcl $TCL_BINDIR
	573	chmod +rx $TCL_BINDIR/tcl
	574
	575	echo " Installing `libtcl.a' library in: $TCL_LIBDIR"
	576	CopyFile libtcl.a $TCL_LIBDIR
	577
	578	echo " Installing Tcl .h files in: $TCL_INCLUDEDIR"
	579	CopyFile $TCL_UCB_DIR/tcl.h $TCL_INCLUDEDIR
	580	CopyFile $TCL_UCB_DIR/tclHash.h $TCL_INCLUDEDIR
	581	CopyFile src/tclExtend.h $TCL_INCLUDEDIR
	582	CopyFile src/tcl++.h $TCL_INCLUDEDIR
	583
	584	echo " Installing Tcl run-time files in: $TCL_TCLDIR"
	585	foreach srcFile [glob tcllib/*] {
	586	if {![file isdirectory $srcFile]} {
	587	CopyFile $srcFile $TCL_TCLDIR
	588	}
	589	}
	590
	591	echo " Installing Tcl help files in: $TCL_TCLDIR/help"
	592	if [file exists $TCL_TCLDIR/help] {
	593	echo " Purging old help tree"
	594	exec rm -rf $TCL_TCLDIR/help
	595	}
	596	CopyDir tcllib/help $TCL_TCLDIR/help
	597
	598	if [info exists TCL_TK_SHELL] {
	599	echo " Installing `wish' program in: $TCL_BINDIR"
	600	CopyFile wish $TCL_BINDIR
	601	chmod +rx $TCL_BINDIR/wish
	602
	603	echo " Installing `libtk.a' library in: $TCL_LIBDIR"
	604	CopyFile libtk.a $TCL_LIBDIR
	605
	606	echo " Installing `tk.h' in: $TCL_INCLUDEDIR"
	607	CopyFile $TCL_TK_DIR/tk.h $TCL_INCLUDEDIR
	608	}
	609
	610	foreach file [glob $TCL_TCLDIR/*.tlib] {
	611	buildpackageindex $file
	612	}
	613
	614	if {$TCL_MAN_INSTALL} {
	615	InstallManPages
	616	}
	617
	618	echo " * TCL IS NOW INSTALLED *"
	619