#!/bin/sh
# \
exec wish "$0" ${1+"$@"}

if {$tcl_version < 7.6} {
    puts stderr "requires Tcl 7.6 or later"
    exit
}

# teki.tcl --
#
#   The Tcl Extension Kit/Installer.  This file manages packages for
#   Tcl/Tk

# Notes about the organization of this file:
#   Major sections are delimited by a string of "-" characters -- e.g. "-------"
#   At the beginning of each major section, the purpose and routines in that
#   section are described.
#   teki-specific packages reside in the "tekilib" directory below teki.tcl

#set tk_version 7.6
set home [string trimright [file dirname [info script]] ./]
set home [file join [pwd] $home tekilib]
lappend auto_path $home
set TekiInfo(library) $home
unset home

if [catch {package require http}] {
    set TekiInfo(http) 0
} else {
    set TekiInfo(http) 1
}

package require Debug
package require Undo

# Define some useful fonts

if [info exists tk_version] {
    set TekiInfo(gui) 1
    set majorversion [lindex [split $tk_version .] 0]
    if {$majorversion >= 8} {
        set TekiInfo(varfont) [font create -family Times -weight bold -size 18]
        set TekiInfo(fixedfont) [font create -family Courier -size 10]
    } else {
        set TekiInfo(varfont) *-Times-Bold-R-Normal--*-240-*-*-*-*-*-*
        set TekiInfo(fixedfont) -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
    }
    unset majorversion
} else {
    set TekiInfo(gui) 0
}

if $TekiInfo(gui) {
    package require Progress-Tk
    package require Wise
} else {
    package require Progress-Tcl
}

# -----------------------------------------------------------------------
#
# Error handling, general UI commands.
#
# This section contains code to handle errors and print messages.
# It defines basic functions whose interface can be a GUI (if we're
# running in wish) or a text based interface (if we're running in
# a shell)

# TekiError prints an error message
# TekiWarning is called to ask the user for confirmation or a decision
#    (such as deleting a file or set of files)

if $TekiInfo(gui) {
  proc TekiError {msg} {
    bgerror "$msg"
  }
  proc TekiWarning {msg default options} {
    Wise_Message "Warning" $msg $options 0
  }
} else {
  proc TekiError {msg} {
    puts stderr $msg
  }
  proc TekiWarning {msg default options} {
    global x
    puts stderr "Warning: $msg"
    set len [llength $options]
    set done 0
    while {!$done} {
        for {set i 0} {$i < $len} {incr i} {
            puts stderr "Type $i to [lindex $options $i]"
        }
        set x [string trim [gets stdin]]
        if [string match {[0-9]} "$x"] {
            set done [expr ($x >=0) && ($x < $len)]
        }
    }
    return $x
  }
}

# -----------------------------------------------------------------------
#
# User Interface
#
# This section of code creates and manages the user interface.  The UI
# consists of a main window with two parts (top and bottom), plus a  menu
# bar.  The top contains the readme file of the currently selected package,
# the bottom a list of packages installed on the system.  The
# functions TekiCreateMenus and TekiCreateWindow create this interface.
# The function TekiCreateUI creates the menus and main window (by
# calling TekiCreateMenus and TekiCreateWindow).
#
# The function TekiUpdateReadme redraws the top portion, and should
# be called whenever the current package -- TekiInfo(currPackage) --  is changed.
# The function TekiUpdateBrowser redraws the bottom, and should be
# called whenever tclPkgInfo(installed) changes.  The function
# TekiBrowserCallback is called when the user clicks in the bottom
# area, selecting a new package.  The functions TekiDoFileInstall,
# TekiDoFileUninstall, and TekiDoFileExit, are called when the user
# selects File->Install, File->Uninstall, or File->Exit menu items,
# respectively.  DoFileInstall pops up a file selection dialog,
# then verifies and installs the file.

set TekiInfo(currPackage)        tcl[info tclversion]

#
# TekiCreateMenus
#    Create the menu bar across the top of the window
#
# Arguments:
#    None
#
proc TekiCreateMenus {} {
    global tclPkgInfo TekiInfo
    Debug_Enter TekiCreateMenus
    frame .menu -relief raised -bd 2
    pack .menu -side top -fill x

    # File Menu
    set m .menu.file.m
    menubutton .menu.file -text File -menu $m -underline 0
    pack .menu.file -side left
    menu $m
    $m add command -label "Install" -underline 0 -command TekiDoFileInstall
    $m add command -label "Uninstall" -underline 1 -command TekiDoFileUninstall
    $m add separator
    $m add command -label "Exit" -underline 1 -command TekiDoFileExit

    # WWW Menu
    set m .menu.www.m
    menubutton .menu.www -text WWW -menu $m -underline 0
    pack .menu.www -side left
    menu $m
    $m add command -label "Update" -underline 0 -command TekiDoWWWUpdate
    $m add command -label "Browse" -underline 1 -command TekiDoWWWBrowse

    if {$TekiInfo(http) == 0} {
        .menu.www.m entryconfigure Browse -state disabled
        .menu.www.m entryconfigure Update -state disabled
    }

    Debug_Leave
}

#
# TekiCreateWindow
#    Create the main window -- this window lists the installed packages, and has a
#    README section.
#
# Arguments:
#    none
#
proc TekiCreateWindow {} {
    global tclPkgInfo TekiInfo
    Debug_Enter TekiCreateWindow

    set w .browser
    frame $w
    pack $w -side bottom -fill x -expand no
    scrollbar $w.scroll -command "$w.list yview"
    listbox $w.list -font $TekiInfo(fixedfont) -relief sunken -width 100 \
                 -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 -height 12 \
                 -selectmode extended
    pack $w.scroll -side right -fill y
    pack $w.list -expand no -fill both
    set TekiInfo(Browser) $w.list
    TekiUpdateBrowser

    # Create the README section of the frame
    set w .readme
    frame $w
    pack $w -side top -fill both -expand yes
    scrollbar $w.scroll -command "$w.text yview"
    text $w.text -font $TekiInfo(fixedfont) -relief sunken -width 100 \
                 -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 -height 10
    set TekiInfo(Readme) $w.text
    pack $w.scroll -side right -fill y
    pack $w.text -expand yes -fill both
    TekiUpdateReadme

    update
    bind $TekiInfo(Browser) <Button-1> TekiBrowserCallback
    bindtags $TekiInfo(Browser) [list Listbox all $TekiInfo(Browser)]

    Debug_Leave
}

#
# TekiUpdateReadme -
#   Updates the readme window of the Info window.
#   Called whenever the current package changes.
#   The associated widget is a text widget.
#
proc TekiUpdateReadme {} {
    global tclPkgInfo TekiInfo
    Debug_Enter TekiUpdateReadme
    set w $TekiInfo(Readme)
    set currPkg [lindex $TekiInfo(currPackage) 0]
    if {[string length $currPkg] == 0} {
        return
    }
    set filename $tclPkgInfo($currPkg,infoFile)
    set name $tclPkgInfo($currPkg,name)

    $w delete 1.0 end
    $w insert end "Information on the $currPkg package\n\n"

    set m1 .menu.file.m
    set m2 .menu.www.m

    if {($name == "Tcl") || ($name == "Tk")} {
        $m1 entryconfigure Uninstall -state disabled
        $m2 entryconfigure Update -state disabled
    } else {
        $m1 entryconfigure Uninstall -state normal
        if $TekiInfo(http) {
            $m2 entryconfigure Update -state normal
        }
    }

    if {[string length $filename] &&
       [file exists $filename] &&
       [file readable $filename]} {
        set f [open $filename r]
        $w insert end [read $f]
        close $f
    } else {
        $w insert end "No information available"
    }        

    wm title . "TEKI -- $currPkg"
    Debug_Leave
}

#
# TekiUpdateBrowser -
#   Updates the browser window.
#   Called whenever the list of installed packages changes.
#
proc TekiUpdateBrowser {} {
    global tclPkgInfo TekiInfo
    Debug_Enter TekiUpdateBrowser
    set w $TekiInfo(Browser)
    $w delete 0 end
    $w insert end "Packages installed:"
    $w insert end [format "%-11s%-8s     %-15s%-28s" "package" "version" "requires" "description"]
    if {[winfo depth $w] > 1} {
        set hot "-background #808080 -relief raised -borderwidth 1"
        set normal "-background {} -relief flat"
    } else {
        set hot "-foreground white -background black"
        set normal "-foreground {} -background {}"
    }

    set tclPkgInfo(installed) [lsort $tclPkgInfo(installed)]
    foreach pkg $tclPkgInfo(installed) {
        set des $tclPkgInfo($pkg,description)
        set ver $tclPkgInfo($pkg,version)
        set req $tclPkgInfo($pkg,requires)

        # The following code does one of two things, depending
        # on whether the package is part of another package.
        set split [file split $pkg]
        set lsplit [llength $split]

        $w insert end [format "%-15s%-8s%-16s%-28s" $pkg $ver $req $des]
    }
    Debug_Leave
}

#
# TekiBrowserCallback --
#    This procedure is called when the user clicks on a package in the browser window.
#    It is responsible for updating the UI to show details of the selected package
#
# Arguments:
#    index        The index of the character that the user clicked on.
#
proc TekiBrowserCallback {} {
    global tclPkgInfo TekiInfo
    Debug_Enter "TekiBrowserCallback"
    set w $TekiInfo(Browser)
    set packages {}
    foreach i [$w curselection] {
        if {$i < 2} {
            # The first two elements are the labels, so don't allow the
            # user to select these
            $w selection clear $i
        } else {
            set info [$w get $i]
            set pkg [lindex $info 0]
            lappend packages $pkg
        }
    }
    set TekiInfo(currPackage) $packages
    TekiUpdateReadme
    Debug_Leave
}

#
# TekiCreateUI
#    Create the TEKI User Interface in the main window (".")
#        1. Create the menus
#        2. Create & show the browse windows
#
proc TekiCreateUI {} {
    global tclPkgInfo TekiInfo
    Debug_Enter TekiCreateUI
    TekiCreateMenus
    TekiCreateWindow
    set currPkg $TekiInfo(currPackage)
    wm title . "TEKI -- $currPkg"
    wm iconname . "TEKI"
    Debug_Leave
}

#-----------------------------------------------------------------------

# WISE user interface support

# The following procedures control the WISE user interface (defined in the
# Wise package).  The wizards are called by the Teki*Wizard procedures.
#
# The function TekiInteractiveInstall coordinates everything -- it
# reads/verifies the Teki file, calls the wizards to select various
# parameters, downloads any files that are needed, and calls TekiInstall
#
# The functions TekiNormalizeDirName 

# Bring the name of a directory into "canonical" form.  What a pain!

proc TekiNormalizeDirName {d} {
    Debug_Enter TekiNormalizeDirName
    set cwd [pwd]
    switch [file pathtype $d] {
	absolute  -
	volumerelative {
	    set path {}
	    set len 0
	}

	relative {
	    set path [file split $cwd]
	    set len [llength $path]
	}
    }
    foreach c [file split $d] {
	switch $c {
	    {.} {}

	    {..} {
		incr len -1;
		set path [lrange $path 0 [expr $len-1]]
	    }

	    default {
		lappend path $c
		incr len
	    }
	}
    }
    Debug_Leave
    return [eval file join $path]
}

# Try to make the directory writable

proc TekiMakeWritable {dir} {
    global tcl_platform tcl_version
    set majorversion [lindex [split $tcl_version .] 0]
    switch $tcl_platform(platform) {
      unix {
        if {$majorversion >= 8} {
            file attributes $dir -permissions 755
        } else {
            exec chmod a+wx $dir
        }
      }

      mac* -
      windows {
        if {$majorversion >= 8} {
            file attributes $dir -readonly 0
        } else {
            error "Permission denied"
        }
      }
    }
}

# Make sure the directory exists, is writable, and is a directory.
#   If $dir exists and is a file, flag an error
#   If $dir doesn't exist, ask the user if they want to create it
#       if they do, then try to create it, otherwise flag an error
# If the return value is 0, then the directory can't be used
# for installation.  If the return value is 1, then we can proceed

proc TekiVerifyDir {dir} {
    #
    # Make the directory if needed
    #
    if {[file exists $dir]} {
        if {![file isdirectory $dir]} {
            TekiError "Error: $dir exists and is not a directory"
            return 0
        }
    } else {
        # Doesn't exist. Make it
        set rv [TekiWarning "Directory $dir does not exist, create?" 0 {Ok Cancel}]
        if {$rv == 0} {
            if [catch {file mkdir $dir} err] {
                TekiError "Error creating $dir\n  $err"
                return 0
            }
        } else {
            # Cancelled by user
            return 0
        }
    }

    # If we get to here, $dir exists and is a directory
    # Try to make it writable if it's not
    if {![file writable $dir]} {
        if [catch {TekiMakeWritable $dir} err] {
            TekiError "Error: $dir is not writable\n$err"
            return 0
        }
    }

    return 1
}

# Utility to delete an item from a list

proc TekiListDelete {list item} {
    set index [lsearch $list $item]
    if {$index != -1} {
        set list [concat [lrange $list 0 [expr $index-1]] \
                       [lrange $list [expr $index+1] end]]
    }
    return $list
}


# The (Teki*Wizard) procedures encode the logic of the wizards.
# Each procedure corresponds to one wizard.  The information gathered
# through the wizards is used to set elements in the global array TekiInfo()
#
# The entry point to the machine is the TekiTypeWizard (abbreviated
# "type").  At any time, pressing the cancel button aborts the wizards,
# pressing "finish" goes directly to "verify", pressing "back" goes back
# to the previous state, and, generally, pressing "next" goes on to
# the next state.  The only exception is in the initial wizard where
# the user selects between "custom" and "typical" installation.  If
# the user selects "typical" and selects "next", the installation
# parameters are reset to their defaults and the wizard goes directly
# to the verify state.
#
# To encode this logic, a sequence of procedure calls are executed, one
# for each wizard.  Each wizard calls the next wizard directly.  To
# implement the "back" button, the procedure just returns.  To implement
# the "cancel" and "finish" buttons, unusual return codes
# ($TekiInfo(cancelCode) for cancel, $TekiInfo(finishCode) for finish)
# are returned by the wizard procedures and caught at the entry point
# of the first wizard.
#
# The wizards are:
#    type - get installation type (custom or typical)
#    packages - let the user select which packages to install (only used
#               if there's more than one package available)
#    archList - get the list of architectures to install for
#    extras - ask whether to install examples, docs, and data
#    codeDir - get target directory for code files
#    docDir - get target directory for documentation (only if installing
#             documentation)
#    verify - verify all paramters

set TekiInfo(cancelCode)  5
set TekiInfo(finishCode)  6

# Reset the TekiInfo variables that corespond to the wizard parameters
# to their default values.

proc TekiWizardDefaults {} {
    global TekiInfo newPackage

    # reset to defaults
    set TekiInfo(packages) $newPackage(defaultPackages)
    set TekiInfo(archList) $newPackage(defaultArch)
    if {$TekiInfo(archList) == "all"} {
        set TekiInfo(archList) {}
        foreach sys $TekiInfo(systemNames) {
            lappend TekiInfo(archList) [lindex $sys 0]
        }
    }
    set TekiInfo(extras) {}
    if $newPackage(defaultInstallDoc) {
        lappend TekiInfo(extras) doc
    }
    if $newPackage(defaultInstallData) {
        lappend TekiInfo(extras) data
    }
    if $newPackage(defaultInstallExamples) {
        lappend TekiInfo(extras) examples
    }
    set TekiInfo(codeDir) [info library]
    set x [file dirname [file dirname $TekiInfo(codeDir)]]
    set TekiInfo(docDir) [file join $x doc]
}

proc TekiTypeWizard {} {
    global TekiInfo
    # Ask if typical or custom install
    while (1) {
        set rv [Wise_Radiolist "Select installation type" \
                         {{typical typical 1} {custom custom 0}} 1]
        switch $rv {
            {next typical} -
            {finish typical} {
                TekiWizardDefaults 
                TekiVerifyWizard
            }
            {next custom} {
                TekiPackagesWizard
            }
            {finish custom} {
                TekiVerifyWizard
            }
            cancel {
                return -code $TekiInfo(cancelCode)
            }
            default {
                TekiError "Internal error:\n  $rv\ndoesn't match case in switch"
            }
        }
    }
}

proc TekiPackagesWizard {} {
    global TekiInfo newPackage
    set packages $newPackage(available)

    #
    # If there's only one package, just pretend they hit "next"
    #
    if {[llength $packages] != 1} {
        while (1) {
            set choices {}
            foreach pkg $packages {
                if {[lsearch $TekiInfo(packages) $pkg] == -1} {
                    lappend choices [list $newPackage($pkg,name) $pkg 0]
                } else {
                    lappend choices [list $newPackage($pkg,name) $pkg 1]
                }
            }
            set rv [Wise_Checklist "Select packages to install" $choices]
            switch [lindex $rv 0] {
                next {
                    set TekiInfo(packages) [lrange $rv 1 end]
                    TekiArchListWizard
                }
                back {
                    return
                }
                finish {
                    set TekiInfo(packages) [lrange $rv 1 end]
                    TekiVerifyWizard
                }
                cancel {
                    return -code $TekiInfo(cancelCode)
                }
            }
        }
    } else {
        set TekiInfo(packages) $packages
        TekiArchListWizard
    }
}

proc TekiArchListWizard {} {
    global TekiInfo newPackage

    set objFileCount 0
    foreach pkg $TekiInfo(packages) {
        incr objFileCount [llength $newPackage($pkg,objFiles)]
    }
    if {$objFileCount == 0} {
        TekiExtrasWizard
        return
    }

    while (1) {
        #
        # We need to rebuild the choices list each time through the
        # loop so we can retain the users setting when they go on
        # to the next wizard and then hit the "back" button.  If
        # we don't rebuild it, then the wizard contents might
        # be out of sync with TekiInfo(archList), since this is
        # changed on next/finish
        #
        set choices {}
        foreach pkg $TekiInfo(packages) {
            foreach pair $newPackage($pkg,objFiles) {
                set name [lindex $pair 0]
                if {[lsearch $choices [list $name]*] == -1} {
                    if {[lsearch $TekiInfo(archList) $name] == -1} {
                        lappend choices [list $name $name 0]
                    } else {
                        lappend choices [list $name $name 1]
                    }
                }
            }
        }

        set rv [Wise_Checklist "Select architectures to install" $choices]
        switch [lindex $rv 0] {
            next {
                set TekiInfo(archList) [lrange $rv 1 end]
                TekiExtrasWizard
            }
            back {
                return
            }
            finish {
                set TekiInfo(archList) [lrange $rv 1 end]
                TekiVerifyWizard
            }
            cancel {
                return -code $TekiInfo(cancelCode)
            }
        }
    }
}

proc TekiExtrasWizard {} {
    global TekiInfo newPackage

    #
    # Figure out if there are any extras to install!  If not, skip
    # this step.
    #
    set docFileCount 0
    set dataFileCount 0
    set exampleFileCount 0
    foreach pkg $TekiInfo(packages) {
        incr docFileCount [llength $newPackage($pkg,docFiles)]
        incr dataFileCount [llength $newPackage($pkg,dataFiles)]
        incr exampleFileCount [llength $newPackage($pkg,exampleFiles)]
    }
    if {$docFileCount == 0} {
        set TekiInfo(extras) [TekiListDelete $TekiInfo(extras) doc]
    }
    if {$dataFileCount == 0} {
        set TekiInfo(extras) [TekiListDelete $TekiInfo(extras) data]
    }
    if {$exampleFileCount == 0} {
        set TekiInfo(extras) [TekiListDelete $TekiInfo(extras) example]
    }
    if {($docFileCount + $dataFileCount + $exampleFileCount) == 0} {
        TekiCodeDirWizard
        return
    }

    while (1) {
        set choices {}
        if $docFileCount {
            lappend choices [list "Install documentation" doc \
                                [expr [lsearch $TekiInfo(extras) doc] != -1]]
        }
        if $dataFileCount {
            lappend choices [list "Install data files" data \
                                [expr [lsearch $TekiInfo(extras) data] != -1]]
        }
        if $exampleFileCount {
            lappend choices [list "Install examples" examples \
                                [expr [lsearch $TekiInfo(extras) examples] != -1]]
        }
        set rv [Wise_Checklist "Select Extras to install" $choices]
        switch [lindex $rv 0] {
            next {
                set TekiInfo(extras) [lrange $rv 1 end]
                TekiCodeDirWizard
            }
            back {
                return
            }
            finish {
                set TekiInfo(extras) [lrange $rv 1 end]
                TekiVerifyWizard
            }
            cancel {
                return -code $TekiInfo(cancelCode)
            }
        }
    }
}

proc TekiCodeDirWizard {} {
    global TekiInfo auto_path env tcl_pkgPath
    while (1) {
        # Give the user several standard options of where to install
        # the code:
        #   option #1: the current value of the codeDir
        #   option #2: [info library]
        #   option #3: the TCLLIBPATH environment variable
        #   option #4: the parent of [info library]
        #   option #5: all the elements of tclPkgPath
        #   option #6: all the elements of auto_path
        #   option #7: "other"
        # The logic makes sure each choice only appears once.
        set choices {}
        set dir [TekiNormalizeDirName $TekiInfo(codeDir)]
        lappend choices [list $dir $dir 1]
        set dir [TekiNormalizeDirName [info library]]
        if {[lsearch $choices [list $dir $dir ?]] == -1} {
            lappend choices [list $dir $dir 0]
        }
        if [info exists env(TCLLIBPATH)] {
            set dir [TekiNormalizeDirName $env(TCLLIBPATH)]
            if {[lsearch $choices [list $dir $dir ?]] == -1} {
                lappend choices [list $dir $dir 0]
            }
        }
        set dir [TekiNormalizeDirName [info library]/..]
        if {[lsearch $choices [list $dir $dir ?]] == -1} {
            lappend choices [list $dir $dir 0]
        }
        foreach dir $tcl_pkgPath {
            set dir [TekiNormalizeDirName $dir]
            if {[lsearch $choices [list $dir $dir ?]] == -1} {
                lappend choices [list $dir $dir 0]
            }
        }
        foreach dir $auto_path {
            set dir [TekiNormalizeDirName $dir]
            if {[lsearch $choices [list $dir $dir ?]] == -1} {
                lappend choices [list $dir $dir 0]
            }
        }
        lappend choices [list other other 0]

        set rv [Wise_Radiolist "Select root directory for code files" $choices]

        #
        # If they choose other, let them chose a directory.
        # After we have the candidate directory, make sure it
        # exists and is writable.
        #
        set option [lindex $rv 0]
        set rv [lrange $rv 1 end]
        switch $option {
            next -
            finish {
                if {$rv == "other"} {
                    set dir [Wise_GetDirName $dir]
                    if {$dir == ""} {
                        continue;   # try again....
                    }
                } else {
                    set dir $rv
                }

                #
                # Warn them if they're installing in a non-standard place
                #
                set found 0
		foreach d $auto_path {
		    set nd [TekiNormalizeDirName $d]
		    if [string match $nd $dir] {
			set found 1
			break
		    }
		}
		if {!$found} {
		    foreach d $tcl_pkgPath {
			set nd [TekiNormalizeDirName $d]
			if [string match $nd $dir] {
			    set found 1
			    break
			}
		    }
		}
		if {!$found} {
                    TekiWarning "Warning: you are installing in a non-standard location
Be sure to add $dir to your TCLLIBPATH environment variable" 0 Ok
                }

                if {![TekiVerifyDir $dir]} {
                    continue
                }

                set TekiInfo(codeDir) $dir
                if {$option == "next"} {
                    TekiDocDirWizard
                } else {
                    TekiVerifyWizard
                }
            }

            back {
                return
            }

            cancel {
                return -code $TekiInfo(cancelCode)
            }
        }
    }
}

proc TekiDocDirWizard {} {
    global TekiInfo
    if {[lsearch $TekiInfo(extras) doc] == -1} {
        TekiVerifyWizard
        return
    }
    while (1) {
        # Give the user several standard options of where to install
        # the documentation:
        #   option #1: the current value of the docDir
        #   option #2: [info library]/../../doc
        #   option #3: $codeDir/doc
        #   option #4: "other"
        # The logic makes sure each choice only appears once.

        set choices {}
        set dir [TekiNormalizeDirName $TekiInfo(docDir)]
        lappend choices [list $dir $dir 1]
        set dir [TekiNormalizeDirName [info library]/../../doc]
        if {[lsearch $choices [list $dir $dir ?]] == -1} {
            lappend choices [list $dir $dir 0]
        }
        set dir [TekiNormalizeDirName $TekiInfo(codeDir)/doc]
        if {[lsearch $choices [list $dir $dir ?]] == -1} {
            lappend choices [list $dir $dir 0]
        }
        lappend choices [list other other 0]

        set rv [Wise_Radiolist "Select root directory for documentation files" $choices]

        set option [lindex $rv 0]
        set rv [lrange $rv 1 end]
        switch $option {
            next -
            finish {
                if {$rv == "other"} {
                    set dir [Wise_GetDirName $dir]
                    if {$dir == ""} {
                        continue;   # try again....
                    }
                } else {
                    set dir $rv
                }

                if {![TekiVerifyDir $dir]} {
                    continue
                }
                set TekiInfo(docDir) $dir
                TekiVerifyWizard
            }

            back {
                return
            }

            cancel {
                return -code $TekiInfo(cancelCode)
            }
        }
    }
}

proc TekiVerifyWizard {} {
    global TekiInfo newPackage
    set installDoc [expr [lsearch $TekiInfo(extras) doc] != -1]
    set installData [expr [lsearch $TekiInfo(extras) data] != -1]
    set installExamples [expr [lsearch $TekiInfo(extras) examples] != -1]
    set msg "Install these packages:\n"
    foreach pkg $TekiInfo(packages) {
        set msg [format "%s    %s %s\n" $msg \
                     $newPackage($pkg,name) \
                     $newPackage($pkg,version)]
    }
    set msg [format "%s\n...for these architectures:\n" $msg]
    foreach arch $TekiInfo(archList) {
        set msg [format "%s    %s\n" $msg $arch]
    }
    set msg [format "%s\nInstall code in \n    %s\n" $msg $TekiInfo(codeDir)]
    if {$installDoc} {
        set msg [format "%s\nInstall documentation in \n    %s\n" \
                     $msg $TekiInfo(docDir)]
    }
    if {$installExamples} {
        set msg [format "%s\nInstall examples in \n    %s\n" \
                     $msg $TekiInfo(codeDir)]
    }
    if {$installData} {
        set msg [format "%s\nInstall data files in \n    %s\n" \
                     $msg $TekiInfo(codeDir)]
    }
    set rv [TekiWarning $msg 0 {Finish {< Back} Cancel}]
    if {$rv == 0} {
        return -code $TekiInfo(finishCode)
    }
    if {$rv == 2} {
        return -code $TekiInfo(cancelCode)
    }
}

#
# Display copyrights for all selected packages.
# Returns a list of packages for which the user accepted the copyright
#
proc TekiDisplayCopyrights {pkgList} {
    global tclPkgInfo TekiInfo newPackage auto_path env

    Debug_Enter TekiDisplayCopyrights
    set packages {}
    set accept 0
    set dontaccept 1
    set acceptrest 2
    set abort 3
    set code 0
    foreach {pkg fn} $pkgList {
        if {($code != $acceptrest) &&
            [file exists $fn]} {
            set f [open $fn r]
            set msg [read $f]
            close $f
            set name $newPackage($pkg,name)
            set code [Wise_Message "Copyright for $name" \
                            $msg {Accept {Do not Accept} {Accept Rest} Abort}]
            if {$code == $accept} {
                lappend packages $pkg
            }
            if {$code == $acceptrest} {
                lappend packages $pkg
            }
            if {$code == $dontaccept} {
                TekiWarning "Skipping installation of $name" 0 {Ok}
            }
            if {$code == $abort} {
                TekiWarning "Aborting installation" 0 {Ok}
                return {}
            }
        } else {
            lappend packages $pkg
        }
    }
    Debug_Leave
    return $packages
}

# The following procedure is called by DoFileInstall and
# DoWWWBrowse to
#  1. Read/verify the teki file
#  2. Gather the installation parameters
#  3. Fetch & display copyright notices
#  4. Install the extension
#
# It does a web based install if $web is true, a file system
# based install if $web if false

proc TekiInteractiveInstall {tekiFile web} {
    global tclPkgInfo TekiInfo newPackage auto_path env
    Debug_Enter TekiInteractiveInstall

    # 1. Read and verify it

    catch {unset newPackage}
    set code [catch {TekiReadFile $tekiFile} err] 
    if $code {
        TekiError "Error reading $tekiFile\n  $err\nerrorCode = $code"
        catch {unset newPackage}
        return
    }
    set code [catch {TekiVerifyFile} err] 
    if $code {
        TekiError "Invalid Teki file $tekiFile:\n$err"
        catch {unset newPackage}
        return
    }

    # 2. Collect all the information from the user.

    TekiWizardDefaults
    set code [catch TekiTypeWizard err]
    if {$code == $TekiInfo(cancelCode)} {
        return
    }
    if {$code != $TekiInfo(finishCode)} {
        TekiError $err
        return
    }

    # 3. Fetch/display all the copyright notices.  If web based install,
    # download the copyright files.  The wwwCleanup variable is a list
    # of all the files in tmpdir that we have to delete when we're done.

    set fileList {}
    set nocopyright {}
    set tmpdir $TekiInfo(tmpDir)
    set index 0
    if $web {
        foreach pkg $TekiInfo(packages) {
            set inFile $newPackage($pkg,copyright)
            set srcURL $newPackage($pkg,srcURL)
            set outFile [file join $tmpdir copyright$index]
            if [string length $inFile] {
                if [catch {TekiDownloadFile $srcURL/$inFile $outFile} err] {
                    TekiWarning "Couldn't find copyright file\n$srcURL/$inFile\n$err\n\nskipping package" 0 {Ok}
                } else {
                    lappend fileList $pkg $outFile
                }
            } else {
                lappend nocopyright $pkg
            }
        }
    } else {
        foreach pkg $TekiInfo(packages) {
            set srcDir $newPackage($pkg,srcDir)
            set copyright $newPackage($pkg,copyright)
            set inFile [file join [file dirname $tekiFile] $srcDir $copyright]
            if [string length $copyright] {
                if {![file exists $inFile]} {
                    TekiWarning "Couldn't find copyright file\n$inFile\n\nskipping package" 0 {Ok}
                } else {
                    lappend fileList $pkg $inFile
                }
            } else {
                lappend nocopyright $pkg
            }
        }
    }

    set TekiInfo(packages) [concat $nocopyright [TekiDisplayCopyrights $fileList]]
    if $web {
        foreach file $fileList {
            catch {file delete -force $file}
        }
    }
    if {$TekiInfo(packages) == ""} {
        Debug_Leave
        return;
    }

    # 4. Install it!

    set installDoc [expr [lsearch $TekiInfo(extras) doc] != -1]
    set installData [expr [lsearch $TekiInfo(extras) data] != -1]
    set installExamples [expr [lsearch $TekiInfo(extras) examples] != -1]

    TekiInstall [file dirname $tekiFile] $web \
                $TekiInfo(codeDir) $TekiInfo(docDir) \
                $TekiInfo(packages) $TekiInfo(archList) \
                $installData $installDoc $installExamples 

    TekiGetAllPkgInfo
    TekiUpdateBrowser
    catch {unset newPackage}
    Debug_Leave
}

#-----------------------------------------------------------------------
#
# File menu callbacks -- 
#
# TekiDoFileInstall is called when the user select the Install item in the
#    File menu
# TekiDoFileUninstall is called when the user select the Uninstall item in the
#    File menu
# TekiDoFileExit is called when the user select the Exit item in the File menu

#
# TekiDoFileInstall -- called from the "File->Install" menu item.
#


proc TekiDoFileInstall {} {
    global tclPkgInfo TekiInfo newPackage auto_path env
    Debug_Enter TekiDoFileInstall

    catch {unset newPackage}
    # Get the teki install file
    set file [tk_getOpenFile -title "Open TEKI file" -filetypes {{{Tek Files} .tek} {{All Files} *}}]
    if {$file == ""} {
        return;
    }
    TekiInteractiveInstall $file 0
    Debug_Leave
}

#
# TekiDoFileUninstall {} {
#
#   Uninstall the current package, update UI
#
proc TekiDoFileUninstall {} {
    global tclPkgInfo tcl_library TekiInfo
    Debug_Enter TekiDoFileUninstall

    set packages {}
    foreach pkg $TekiInfo(currPackage) {
        set name $tclPkgInfo($pkg,name)
        if {($name == "Tcl") || ($name == "Tk")} {
            tk_dialog .error "Error" "Can't uninstall $pkg" {} 0 Ok
            continue
        }
        lappend packages $pkg
    }
    TekiUninstall $packages
    TekiGetAllPkgInfo
    TekiUpdateBrowser
    set w $TekiInfo(Browser)
    $w selection set end
    set info [$w get end]
    set TekiInfo(currPackage) [lindex $info 0]
    TekiUpdateReadme
        
    Debug_Leave
}

proc TekiDoFileExit {} {
   Debug_Enter TekiDoFileExit
   exit
}

#-----------------------------------------------------------------------
#
# WWW menu callbacks -- 
#

#
# Update the currently selected package.
#    1. Fetching the .tek file using the package's the URL field
#    2. Report the current version number and the new version number.
#       Ask the user if they want to proceed.
#    3. If so, copy all the package files into a temporary directory
#       and install from there
#
proc TekiDoWWWUpdate {} {
    global tclPkgInfo TekiInfo

    Debug_Enter TekiDoWWWUpdate
    Debug_Leave
}

proc TekiWWWBrowseInstall {} {
    global TekiInfo
    set tmpDir $TekiInfo(tmpDir)

    # Gather files for a batch install, and generate/use a bundle file
    set filelist {}
    set pkgList {}
    set index 0
    foreach i [.toc.list curselection] {
        if {$i == 0} {
            # skip labels :-)
            continue
        }

        # The first element of the selection is the package number, 
        # which is the index in TekiInfo(contents).  Retrieve it so
        # we know which package the user selected.
        set info [.toc.list get $i]
        set index [lindex $info 0]
        incr index -1
        set tuple [lindex $TekiInfo(contents) $index]
        set name [lindex $tuple 0]
        set inFile [lindex $tuple 5]
        set pkg [lindex $tuple 6]
        set tmpDir $TekiInfo(tmpDir)
        set outFile [file join $tmpDir tekiTmp$index]
        if [catch {TekiDownloadFile $inFile $outFile} err] {
            set rv [TekiWarning "Couldn't install package $name\nError occured while downloading\n$inFile\n$err" 0 {Ok Cancel}]
            if {$rv == 0} {
                foreach f $filelist {
                    file delete -force $f
                }
                return
            }
        } else {
            lappend filelist $outFile
            lappend pkgList $pkg
            incr index
        }
    }
    if {[llength $filelist] == 0} {
        TekiWarning "No valid packages found to install" 0 {Ok}
        return
    }
    set bundleFile [file join $tmpDir tekiBundle.tek]
    set f [open $bundleFile w]
    puts $f {# TekiFile 1.0
# Automatically generated TEKI bundle file
}
    foreach file $filelist {
        puts $f "TekiReadFile $file"
    }
    puts $f "set newPackage(defaultPackages) [list $pkgList]"
    close $f
    TekiInteractiveInstall $bundleFile 1
    file delete -force $bundleFile
    foreach f $filelist {
        file delete -force $f
    }
}

proc TekiWWWBrowseReadme {} {
    global TekiInfo
    set packages {}
    set tmpDir $TekiInfo(tmpDir)
    foreach i [.toc.list curselection] {
        if {$i == 0} {
            # skip labels :-)
            continue
        }

        # The first element of the selection is the package number, 
        # which is the index in TekiInfo(contents).  Retrieve it so
        # we know which package the user selected.
        set info [.toc.list get $i]
        set index [lindex $info 0]
        incr index -1
        set tuple [lindex $TekiInfo(contents) $index]
        set name [lindex $tuple 0]
        set ver [lindex $tuple 1]
        set url [lindex $tuple 4]
        if {[string length $url] == 0} {
            set rv [TekiWarning "No information available on $name $ver" 0 {Ok Cancel}]
            if {$rv == 1} {
                return
            }
            continue
        }

        set outFile [file join $tmpDir readme]
        if [catch {TekiDownloadFile $url $outFile} err] {
            set rv [TekiWarning "Coulnd't find readme for $name $ver:\n  $err" 0 {Ok Cancel}]
            if {$rv == 1} {
                return
            }
            continue
        }

        set f [open $outFile r]
        set msg [read $f]
        close $f
        file delete -force $outFile
        set code [Wise_Message "Information for $name" $msg {Ok Cancel}]
        if {$code == 1} {
            return
        }
    }
}


proc TekiWWWBrowseAll {} {
    global TekiInfo
    .toc.list delete 0 end
    set str [format "%-4s%-11s%-8s     %-15s%-28s" "#" "package" "version" "requires" "description"]
    .toc.list insert end $str
    set i 1
    foreach tuple $TekiInfo(contents) {
        set pkg [lindex $tuple 0]
        set ver [lindex $tuple 1]
        set req [lindex $tuple 2]
        set des [lindex $tuple 3]
        .toc.list insert end [format "%-4d%-15s%-8s%-16s%-28s" $i $pkg $ver $req $des]
        incr i
    }
}

proc TekiWWWBrowseCompat {} {
    global tcl_version tk_version TekiInfo
    .toc.list delete 0 end
    set str [format "%-4s%-11s%-8s     %-15s%-28s" "#" "package" "version" "requires" "description"]
    .toc.list insert end $str
    set i 1
    foreach tuple $TekiInfo(contents) {
        set sat 1
        foreach pair [lindex $tuple 2] {
            set pkg [lindex $pair 0]
            set ver [lindex $pair 1]
            Debug_Print $pkg $ver
            if {($pkg == "Tcl") && ![package vsatisfies $tcl_version $ver]} {
                set sat 0
            }
            if {($pkg == "Tk") && ![package vsatisfies $tk_version $ver]} {
                set sat 0
            }
        }
        if $sat {
            set pkg [lindex $tuple 0]
            set ver [lindex $tuple 1]
            set req [lindex $tuple 2]
            set des [lindex $tuple 3]
            .toc.list insert end [format "%-4d%-15s%-8s%-16s%-28s" $i $pkg $ver $req $des]
        }
        incr i
    }
}

proc TekiDoWWWBrowse {} {
    global TekiInfo
    set url $TekiInfo(browseURL)
    set tmpDir $TekiInfo(tmpDir)
    set outFile [file join $tmpDir contents.tkr]
    if [catch {TekiDownloadFile $url $outFile} err] {
        TekiWarning "Couldn't find browse information file\n$err" 0 {Ok}
        return
    }
    TekiReadTOCFile $outFile
    file delete -force $outFile


    # Ok, TekiInfo(contents) should contain a list of
    #   name  version  requires descript  readme-url  tek-file-url

    if {[info commands .toc] == ""} {
        toplevel .toc
        set w .toc
        set numButtons 5
        button $w.install -text Install -command TekiWWWBrowseInstall
        button $w.readme -text "View Readme" -command TekiWWWBrowseReadme
        button $w.showall -text "Show All Packages" -command TekiWWWBrowseAll
        button $w.showcompat -text "Show Compatible Packages" -command TekiWWWBrowseCompat
        button $w.cancel -text "Close" -command "wm withdraw .toc"
        scrollbar $w.scroll -command "$w.list yview"
        listbox $w.list -font $TekiInfo(fixedfont) -relief sunken -width 100 \
                     -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 -height 12 \
                     -selectmode extended
        grid $w.scroll -column $numButtons -row 0 -sticky ns
        grid $w.list -column 0 -columnspan $numButtons -row 0 -sticky nsew
        grid $w.install -column 0 -row 1
        grid $w.readme -column 1 -row 1
        grid $w.showall -column 2 -row 1
        grid $w.showcompat -column 3 -row 1
        grid $w.cancel -column 4 -row 1 -columnspan 2
    }
    Wise_CenterWindow .toc
    wm transient .toc .
    TekiWWWBrowseAll
}

#-----------------------------------------------------------------------
#
# WWW support -- 
#
# This section contains code to download files and directories from
# a URL into a temp file.

#
# Get a decent value for the temporary directory
#
switch $tcl_platform(platform) {
    windows    {set TekiInfo(tmpDir) C:/TEMP}
    unix       {set TekiInfo(tmpDir) /tmp}
}
if {[info exists env(TMP)] && [file isdirectory $env(TMP)]} {
    set TekiInfo(tmpDir) $env(TMP)
}
if {[info exists env(TMPDIR)] && [file isdirectory $env(TMPDIR)]} {
    set TekiInfo(tmpDir) $env(TMPDIR)
}
if {[info exists env(TEMP)] && [file isdirectory $env(TEMP)]} {
    set TekiInfo(tmpDir) $env(TEMP)
}
if {[info exists env(TEMPDIR)] && [file isdirectory $env(TEMPDIR)]} {
    set TekiInfo(tmpDir) $env(TEMPDIR)
}
set TekiInfo(browseURL)   http://www2.cs.cornell.edu/zeno/bsmith/contents.tkc

# -----------------------------------------------------------------------
#
# Routines to read and verify .tek files
#

# Todo:
#    Bullet-proof this section using a safe interpreter
#

proc TekiReadTOC1.0 {filename} {
    global TekiInfo
    if [catch {source $filename} err] {
        global errorCode errorInfo
        error "Error reading version 1.0 TEKI TOC file $filename.
Execute \"source $filename\" in a Tcl shell to find error" \
$errorInfo $errorCode
    }
}

proc TekiReadTOCFile {filename} {
    Debug_Enter TekiReadTOCFile 
    set f [open $filename r]
    set x [split [gets $f]]
    close $f
    if {([llength $x] != 3) ||
        [string compare [lindex $x 0] #] ||
        [string compare [lindex $x 1] TekiTOC] } {
        error "Invalid Teki Table-of-contents file"
    }
    set tekiFileVersion [lindex $x 2]
    if [catch {TekiReadTOC$tekiFileVersion $filename} err] {
        global errorCode errorInfo
        error $err $errorInfo $errorCode
    }
    Debug_Leave
}

proc TekiReadVersion1.0 {filename} {
    global newPackage
    if [catch {source $filename} err] {
        global errorCode errorInfo
        error "Error reading version 1.0 TEKI file $filename.
Execute \"source $filename\" in a Tcl shell to find error" \
$errorInfo $errorCode
    }
}

proc TekiReadFile {filename} {
    Debug_Enter ReadTekiFile 
    set cwd [pwd]
    cd [file dirname $filename]
    set filename [file tail $filename]
    set f [open $filename r]
    set x [split [gets $f]]
    close $f
    if {([llength $x] != 3) ||
        [string compare [lindex $x 0] #] ||
        [string compare [lindex $x 1] TekiFile] } {
        cd $cwd
        error "Invalid Teki file"
    }
    set tekiFileVersion [lindex $x 2]
    if [catch {TekiReadVersion$tekiFileVersion $filename} err] {
        global errorCode errorInfo
        cd $cwd
        error $err $errorInfo $errorCode
    }
    cd $cwd
    Debug_Leave
}

proc TekiVerifyFile {} {
    global newPackage
    foreach attr {available defaultPackages defaultArch
              defaultInstallDoc defaultInstallExamples defaultInstallData} {
        if ![info exists newPackage($attr)] {
            error "Teki file does not define attribute '$attr'"
        }
    }
    foreach pkg $newPackage(available) {
        foreach attr {name version description requires updateURL srcURL
                      registerURL srcDir destDir infoFile tclFiles dataFiles
                      docDir docFiles exampleFiles objFiles copyright} {
            if ![info exists newPackage($pkg,$attr)] {
                error "Package $pkg does not define attribute '$attr'"
            }
        }
    }
    foreach pkg $newPackage(defaultPackages) {
        if ![info exists newPackage($pkg,name)] {
            error "Teki file defines invalid package $pkg in as part of defaultPackages"
        }
    }
}

# ---------------------------------------------------------------------- -
#
# TekiInstall
#
# Install a package.
# The file has been read and verified, and the packages variable refers
# to good packages (they exist in newPackage, haven't already been
# installed, etc).  The errors we have to worry about are errors copying
# files.

#
# TekiDownloadFile --
#
#   Copy $url into $tmpDir/$file, making directories as needed
#
# Throws an error if user presses cancel button during download
# or another error occurs.
# The caller must delete the file when done.

proc TekiCancelDownload {} {
    global TekiInfo
    wm withdraw .dl
    http_reset $TekiInfo(token)
}

proc TekiDownloadProgressEnd {} {
    wm withdraw .dl
}

proc TekiDownloadProgressStart {url} {
    global TekiInfo
    if {[info commands .dl] == ""} {
        toplevel .dl
        label .dl.l -font $TekiInfo(fixedfont)
        scale .dl.s -orient horizontal -sliderrelief flat \
                    -sliderlength 0 -showvalue 0
        button .dl.cancel -text Cancel -command TekiCancelDownload
        grid .dl.l -row 0 -column 0 -sticky ew
        grid .dl.s -row 1 -column 0 -sticky ew
        grid .dl.cancel -row 2 -column 0
    } else {
        .dl.s configure -sliderlength 0
    }
    wm title .dl "Downloading $url"
    .dl.l configure -text $url
    Wise_CenterWindow .dl
}

proc TekiDownloadProgress {token max curr} {
    global TekiInfo
    set TekiInfo(token) $token
    if {$max > 0} {
        set width [winfo width  .dl.s]
        set pixels [expr int($curr*$width/$max)]
        .dl.s configure -sliderlength $pixels
        update idletasks
    }
}

proc TekiDownloadFile {url dest} {
    global errorInfo errorCode
    file mkdir [file dirname $dest]
    set f [open $dest w]
    fconfigure $f -translation binary
    TekiDownloadProgressStart $url
    set code [catch {http_get $url -channel $f -progress TekiDownloadProgress} token]
    TekiDownloadProgressEnd
    close $f
    if {$code} {
        catch {file delete -force $dest}
        error "HTTP error:\n  $token\n\nwhile fetching\n  $url" \
              $errorInfo $errorCode
    }
    upvar #0 $token state

    # The variable state(http) contains the server response
    # code.  If the code is [45]xx, there's a problem with the
    # URL.
    if {[string match {[45]*} [lindex $state(http) 1]]} {
        catch {file delete -force $dest}
        set err [lrange $state(http) 2 end]
        error "HTTP error:\n  $err\n\nwhile fetching\n  $url" \
    }

    # Handle URL redirects
    if {$state(status) == "reset"} {
        file delete -force $dest
        uplevel #0 unset $token
        error "Connection reset by user"
    }
    foreach {name value} $state(meta) {
        if {[regexp -nocase ^location$ $name]} {
            file delete -force $dest
            TekiDownloadFile [string trim $value] $dest
        }
    }
    uplevel #0 unset $token
}

#
# Copy from $src to $dest
# Make directories as needed
# Download file is source is a URL
# Example:
#   src = http://www2.cs.cornell.edu/bsmith/tmp/tcl-files/foo.tcl
#   dest = /usr/local/lib/tcl/dp4.0/tcl-files/foo.tcl
# 
proc TekiCopy {src dest} {
    file mkdir [file dirname $dest]
    if [string match http://* $src] {
        TekiDownloadFile $src $dest
    } else {
        file copy $src $dest
    }
}

#
# TekiInstall --
#
# Install the packages passed in.  Can be called
# with through the command line or the Teki GUI.
#
# Parameters:
#
#     dirBase -- directory where teki file is located.  Other
#                file (code, etc) are given by the srcDir relative
#                to this directory
#     web -- if true if we're doing a Web-based install and the
#            $srcURL for each package is used to locate files to copy.
#            If false, $dirBase/$srcDir for each package gives the
#            place where the source files are located.
#     codePrefix -- prefix for installing code, data, and examples.  For
#                   example, /usr/local/lib/tcl
#     docPrefix -- prefix for installing documentation.  (e.g., /usr/man)
#     packages -- list of packages to install (members of newPackage(installed))
#     archList -- list of archtectures, (members of TekiInfo(systemNames))
#     installData -- Boolean indicating whether to install data files
#     installDoc -- Boolean indicating whether to install documentation
#     installExamples -- Boolean indicating whether to install examples
#
# Notes
#     Installs documentation in $docPrefix/$newPackage(destDir)
#     Installs tcl files, object files, data, and examples in
#          $codePrefix/$newPackage(destDir)
#   
#
proc TekiInstall {dirBase web codePrefix docPrefix packages archList
                {installData 1} {installDoc 1} {installExamples 1}} {
    global newPackage tcl_platform TekiInfo errorCode errorInfo

    Debug_Enter TekiInstall

    if {![file isdirectory $codePrefix]} {
        TekiError "Error: Destination directory $codePrefix doesn't exist"
        return
    }

    foreach pkg $packages {

        if $web {
            set srcDir $newPackage($pkg,srcURL)
        } else {
            set srcDir [file join $dirBase $newPackage($pkg,srcDir)]
        }

        set steps {
            "Making directory"
            "Creating pkgIndex.tcl"
            "Information file"
            "Tcl files"
        }
        if {$installData && [string length $newPackage($pkg,dataFiles)]} {
            lappend steps "Data files"
        }
        if {$installExamples && [string length $newPackage($pkg,exampleFiles)]} {
            lappend steps "Examples"
        }
        if {$installDoc && [string length $newPackage($pkg,docFiles)]} {
            lappend steps "Documentation"
        }
        foreach pair $newPackage($pkg,objFiles) {
            set arch [lindex $pair 0]
            if {[string match "all" $archList] ||
                ([lsearch -exact $archList $arch] != -1)} {
                lappend steps "Files for $arch"
            }
        }
        Progress_StepInit "Installing $pkg" $steps
        Undo_Add $pkg Progress_StepEnd



        # Make the destination directory.  If it exists, verify that
        # we should replace it

        set destDir [file join $codePrefix $newPackage($pkg,destDir)]
        if [file isdirectory $destDir] {
            set rval [TekiWarning \
                "Warning: Directory $destDir already exists.
Delete will replace it
Cancel will abort the installation of this package
Abort will abort the installation of this and all remaining packages" \
                1 {Delete Cancel Abort}]
            if {$rval == 2} {
                Undo_All $pkg
                break
            }
            if {$rval == 1} {
                Undo_All $pkg
                continue
            }
            if [catch {file delete -force $destDir} err] {
            set rval [TekiWarning \
                "Warning: Couldn't delete $destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages" \
                0 {Cancel Abort}]
                Undo_All $pkg
                if {$rval == 0} {
                    continue
                } else {
                    break
                }
            }
        }
        Progress_StepPrint



        # Create $destDir, open $destDir/pkgIndex.tcl, and start writing it...

        set fn [file join $destDir pkgIndex.tcl]
        if [catch {file mkdir [file dirname $fn]} err] {
            set rval [TekiWarning \
                "Couldn't create target directory $destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages" \
                0 {Cancel Abort}]
            Undo_All $pkg
            if {$rval == 0} {
                continue
            } else {
                break
            }
        }
        Undo_Add $pkg "file delete -force \"$destDir\""

        if [catch {set pkgIndex [open $fn w]} err] {
            set rval [TekiWarning \
                "Couldn't create pkgIndex.tcl in $destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages" \
                0 {Cancel Abort}]
            Undo_All $pkg
            if {$rval == 0} {
                continue
            } else {
                break
            }
        }
        Undo_Add $pkg "close $pkgIndex"

        puts $pkgIndex "
# This file was automatically generated by TEKI
global tclPkgInfo
if {!\[info exists tclPkgInfo(installed)\] ||
    \[lsearch \$tclPkgInfo(installed) $pkg\] == -1} {
    lappend tclPkgInfo(installed) $pkg

    set tclPkgInfo($pkg,codePrefix)      [list $codePrefix]
    set tclPkgInfo($pkg,docPrefix)       [list $docPrefix]
    set tclPkgInfo($pkg,installData)     $installData
    set tclPkgInfo($pkg,installDoc)      $installDoc
    set tclPkgInfo($pkg,installExamples) $installExamples

    set tclPkgInfo($pkg,name)            [list $newPackage($pkg,name)]
    set tclPkgInfo($pkg,version)         [list $newPackage($pkg,version)]
    set tclPkgInfo($pkg,description)     [list $newPackage($pkg,description)]
    set tclPkgInfo($pkg,requires)        [list $newPackage($pkg,requires)]
    set tclPkgInfo($pkg,tekiFile)        [list $newPackage($pkg,tekiFile)]
    set tclPkgInfo($pkg,updateURL)       [list $newPackage($pkg,updateURL)]
    set tclPkgInfo($pkg,registerURL)     [list $newPackage($pkg,registerURL)]
    set tclPkgInfo($pkg,destDir)         [list $newPackage($pkg,destDir)]
    set tclPkgInfo($pkg,tclFiles)        [list $newPackage($pkg,tclFiles)]
    set tclPkgInfo($pkg,systemNames)     [list $TekiInfo(systemNames)]"

        Progress_StepPrint




        # Copy in all the platform independent files to $destDir
        # Preserve the package directory hierarchy

        set infoFile $newPackage($pkg,infoFile)
        if [string length $infoFile] {
            if [catch {TekiCopy $srcDir/$infoFile $destDir/$infoFile} err] {
                set rval [TekiWarning \
                    "Couldn't copying\n$infoFile\nto\n$destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                    0 {Cancel Abort Ignore}]
                if {$rval == 0} {
                    Undo_All $pkg
                    continue
                }
                if {$rval == 1} {
                    Undo_All $pkg
                    break
                }
                set f {}
            } else {
                set f [file join $destDir $newPackage($pkg,infoFile)]
            }
        } else {
            set f {}
        }
        puts $pkgIndex "    set tclPkgInfo($pkg,infoFile)        [list $f]"
        Progress_StepPrint

        set code 2
        foreach file $newPackage($pkg,tclFiles) {
            if [catch {TekiCopy $srcDir/$file $destDir/$file} err] {
                set code [TekiWarning \
                    "Error copying\n$file\nto\n$destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages" \
                    0 {Cancel Abort}]
                break;
            }
        }
        if {$code == 0} {
            Undo_All $pkg
            continue
        }
        if {$code == 1} {
            Undo_All $pkg
            break
        }
        Progress_StepPrint

        set dataFiles {}
        if $installData {
            set dataFiles $newPackage($pkg,dataFiles)
            foreach file $dataFiles {
                if [catch {TekiCopy $srcDir/$file $destDir/$file} err] {
                    set code [TekiWarning \
                        "Error copying data file\n$file\nto\n$destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                        0 {Cancel Abort Ignore}]
                    if {$code != 2} {
                        break
                    }
                }
            }
            if {$code == 0} {
                Undo_All $pkg
                continue
            }
            if {$code == 1} {
                Undo_All $pkg
                break
            }
            Progress_StepPrint
        }
        puts $pkgIndex "    set tclPkgInfo($pkg,dataFiles) [list $dataFiles]"

        set exampleFiles {}
        if $installExamples {
            set exampleFiles $newPackage($pkg,exampleFiles)
            foreach file $exampleFiles {
                if [catch {TekiCopy $srcDir/$file $destDir/$file} err] {
                    set code [TekiWarning \
                        "Error copying\n$file\nto\n$destDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                        0 {Cancel Abort Ignore}]
                    if {$code != 2} {
                        break
                    }
                }
            }
            if {$code == 0} {
                Undo_All $pkg
                continue
            }
            if {$code == 1} {
                Undo_All $pkg
                break
            }
            Progress_StepPrint
        }
        puts $pkgIndex "    set tclPkgInfo($pkg,exampleFiles) [list $exampleFiles]"

        set docFiles {}
        set docSrcDir $srcDir/$newPackage($pkg,docDir)
        set docDestDir [file join $docPrefix $newPackage($pkg,destDir)]
        if $installDoc {
            #
            # Make the destination directory.  If it exists, verify that
            # we should replace it
            #
            if [file isdirectory $docDestDir] {
                set rval [TekiWarning \
                    "Warning: Directory $docDestDir already exists.
Delete will replace it
Cancel will abort the installation of this package
Abort will abort the installation of all packages" \
                    1 {Delete Cancel Abort}]
                if {$rval == 1} {
                    Undo_All $pkg
                    continue
                }
                if {$rval == 2} {
                    Undo_All $pkg
                    break
                }
                if [catch {file delete -force $docDestDir} err] {
                    set code [TekiWarning \
                        "Error: Couldn't delete $docDestDir:\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                        0 {Cancel Abort Ignore}]
                    if {$code == 0} {
                        Undo_All $pkg
                        continue
                    }
                    if {$code == 1} {
                        Undo_All $pkg
                        break
                    }
                }
            }



            # Create $docDestDir

            if [catch {file mkdir $docDestDir} err] {
                set code [TekiWarning \
                    "Error creating documentation target directory $docDestDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                        0 {Cancel Abort Ignore}]
                if {$code == 0} {
                    Undo_All $pkg
                    continue
                }
                if {$code == 1} {
                    Undo_All $pkg
                    break
                }
            } else {
                Undo_Add $pkg "file delete -force \"$docDestDir\""
            }


            # Copy all the documentation files
            
            foreach file $newPackage($pkg,docFiles) {
                if [catch {TekiCopy $docSrcDir/$file $docDestDir/$file} err] {
                    set code [TekiWarning \
                        "Error copying\n$file\nto\n$docDestDir\n$err
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                        0 {Cancel Abort Ignore}]
                    break
                }
            }
            if {$code == 0} {
                Undo_All $pkg
                continue
            }
            if {$code == 1} {
                Undo_All $pkg
                break
            }
            Progress_StepPrint
        }




        # Copy in all the platform dependent files
        # If we get an error and have to abort in the middle,
        # we'll throw an error to break out of the nested
        # loops.

        set installedArchs {}
        set code  [catch {
          foreach pair $newPackage($pkg,objFiles) {
              set system [lindex $pair 0]
              #
              # system is a name for the system, such as Solaris
              # one Windows.   $archList is either the
              # string "all" or a list of these names
              #
              if {[string match "all" $archList] ||
                  ([lsearch -exact $archList $system] != -1)} {
                  set fileList {}
                  lappend installedArchs $system
                  foreach file [lindex $pair 1] {
                      if [catch {TekiCopy $srcDir/$file $destDir/$file} err] {
                          set rval [TekiWarning \
                              "Error copying\n$file\nto\n$destDir\n$err\n
Cancel will abort the installation of this package
Abort will abort the installation of all packages
Ignore will ignore this error and continue installation" \
                          0 {Cancel Abort Ignore}]
                          switch $rval {
                            0 {
                              Undo_All $pkg
                              error {} 5;  # continue
                            }

                            1 {
                              Undo_All $pkg
                              error {} 6;  # break
                            }

                            2 {}
                          }
                      }
                      lappend fileList $file
                  }
                  Progress_StepPrint
                  puts $pkgIndex "    set tclPkgInfo($pkg,objFiles,$system) [list $fileList]"
              }
          }
        } err]
        switch $code {
            0 {}
            5 continue
            6 break
            default {
                error $err $errorInfo $errorCode 
            }
        }
        puts $pkgIndex "    set tclPkgInfo($pkg,archList) [list $installedArchs]"

        # Finish up!

#        puts $pkgIndex "    TekiPackageInit $pkg"

        puts $pkgIndex "}"
	  set tclfilesdir "$codePrefix/$pkg"
	  set outstr [concat package ifneeded dp 4.0 \[list LoadLib $tclfilesdir\]]
	  puts $pkgIndex $outstr
	  puts $pkgIndex "proc LoadLib dir {"
	  set outstr [concat foreach file \[glob \$dir/library/*.tcl\]]
	  puts -nonewline $pkgIndex "    $outstr"
	  puts $pkgIndex " {"
	  set outstr [concat uplevel #0 source \[list \$file\]]
	  puts $pkgIndex "		$outstr"
	  puts $pkgIndex "	}"

	  set outstr [concat uplevel #0 load \[list \$dir/$file\]]
	  puts $pkgIndex "	$outstr"
	  puts $pkgIndex "}"
        close $pkgIndex
        Undo_Clear $pkg
        Progress_StepEnd
    }
    TekiGetAllPkgInfo
    Debug_Leave
}

#
# TekiUninstall --
#
# Uninstall all the packages passed in.  Can be called with through the
# command line or the Teki GUI.
#
proc TekiUninstall {pkgList} {
    global tclPkgInfo
    set noWarn 0
    foreach pkg $pkgList {
        if {!$noWarn} {
            set rval [TekiWarning "Uninstall package $pkg ?" \
                0 {Yes {Yes All} Cancel}]
            if {$rval == 2} {
                return
            }
            if {$rval == 1} {
                set noWarn 1
            }
        }

        # Delete all the code/data/example files.
        # These are stored under the $codePrefix directory
        set codePrefix $tclPkgInfo($pkg,codePrefix)
        set destDir [file join $codePrefix $tclPkgInfo($pkg,destDir)]
        if [catch {file delete -force $destDir} err] {
            TekiError "Error: Couldn't delete $destDir:\n$err\nAborting uninstallation"
            break
        }

        #
        # delete doc files
        #
        if {$tclPkgInfo($pkg,installDoc)} {
            set docPrefix $tclPkgInfo($pkg,docPrefix)
            set dir [file join $docPrefix $tclPkgInfo($pkg,destDir)]
            if [catch {file delete -force $dir} err] {
                TekiError "Error: Couldn't delete $dir:\n$err\nAborting uninstallation"
                break
            }
        }
    }
}

# ---------------------------------------------------------------------
#
# Support procedures for all extensions.  The following two procedures
# are used at runtime to source/load the right files (including architecture
# dependent files).  TekiPackageInit is called by the pkgIndex.tcl file
# with the package name, after the tclPkgInfo variables have been set up.
# It determines if the OS is supported, and if so, makes the right calls
# to package ifneeded.  TekiPackageSetup is called when package require
# is called.  It loads all the files (including architecture dependent
# files
#

#
# Predefined system names
#
set TekiInfo(systemNames)   {
        {Solaris SunOS 5*}
        {SunOS SunOS 4*}
        {HPUX HP* 9*}
        {Linux Linux* 2*}
        {FreeBSD FreeBSD* 2*}
        {Win95/NT Win* *}
}

proc TekiPackageInit {pkg} {
    global tclPkgInfo tcl_platform

    set os $tcl_platform(os)
    set ver $tcl_platform(osVersion)

    set system {}
    foreach tuple $tclPkgInfo($pkg,systemNames) {
        set osPattern [lindex $tuple 1]
        set verPattern [lindex $tuple 2]
        if {[string match $osPattern $os] &&
            [string match $verPattern $ver]} {
            set system [lindex $tuple 0]
            break;
        }
    }
    if [string length $system] {
        set name $tclPkgInfo($pkg,name)
        set version $tclPkgInfo($pkg,version) 
        package ifneeded $name $version "TekiPackageSetup $pkg $system"
    }
}

proc TekiPackageSetup {pkg system} {
    global tclPkgInfo
    set currDir [pwd]
    set prefix $tclPkgInfo($pkg,codePrefix)
    set destDir [file join $prefix $tclPkgInfo($pkg,destDir)]
    cd $destDir
    set tclFiles $tclPkgInfo($pkg,tclFiles)
    if [info exists tclPkgInfo($pkg,objFiles,$system)] {
        set objFiles $tclPkgInfo($pkg,objFiles,$system)
    } else {
        set objFiles {}
    }
    foreach f $tclFiles {
        catch {uplevel #0 "source $f"}
    }
    foreach f $objFiles {
        if [string match *.tcl $f] {
            catch {uplevel #0 "source $f"}
        } else {
            catch {uplevel #0 "load $f"}
        }
    }
    cd $currDir
}

proc TekiGetAllPkgInfo {} {
    global tcl_pkgPath auto_path tclPkgInfo tcl_version tk_version
    catch {unset tclPkgInfo}
    set tclver tcl$tcl_version
    set tclPkgInfo(installed) $tclver
    set tclPkgInfo($tclver,name)           Tcl
    set tclPkgInfo($tclver,requires)       {}
    set tclPkgInfo($tclver,version)        $tcl_version
    set tclPkgInfo($tclver,description)    "Tcl core"
    set tclPkgInfo($tclver,infoFile)       {}

    if [info exists tk_version] {
        set tkver tk$tk_version
        lappend tclPkgInfo(installed)         $tkver
        set tclPkgInfo($tkver,name)           Tk
        set tclPkgInfo($tkver,requires)       [list [list Tcl $tcl_version]]
        set tclPkgInfo($tkver,version)        $tk_version
        set tclPkgInfo($tkver,description)    "Tk core"
        set tclPkgInfo($tkver,infoFile)       {}
    }

    #
    # Get list of all pkgIndex.tcl files
    #
    set fileList {}
    foreach dir [concat $auto_path [list $tcl_pkgPath]]  {
        if {![catch {glob [file join $dir pkgIndex.tcl] [file join $dir * pkgIndex.tcl]} files]} {
            set fileList [concat $files $fileList]
        }
    }
    set code 0
    foreach file $fileList {
        if [catch {source $file} err] {
            if {$code != 1} {
                set code [TekiWarning \
                    "Error sourcing $file:\n  $err?" 0 {Ignore {Ignore All} Abort}]
            }
            if {$code == 2} {
                exit
            }
        }
    }
}

# ---------------------------------------------------------------------
#
# Initialization code
#

TekiGetAllPkgInfo
if $TekiInfo(gui) {
    TekiCreateUI
    wm deiconify .
}

if {$tcl_version < 8.0} {
    proc fcopy args {
        eval unsupported0 $args
    }
}