global.tcl

这是vxworks 的图形界面开发软件windML2.0和另一个CP2可以构成完整的界面开发。

# global.tcl - global Tcl functions for Setup.
#
# Copyright 1996-1999 Wind River Systems, Inc.
#
# modification history
# --------------------
# 02s,31mar99,wmd  Update the sizes for Setup files in setupSizeGet.
# 02r,29mar99,wmd  Make sure that check for env(SETUP_DEBUG) or env(INF_DEBUG)
#                  are caught.
# 02q,19mar99,wmd  Add proc to write to a file, close the file.
# 02p,03mar99,tcy  Added setupSizeGet() (fix for SPR 25228)
# 02o,24feb99,wmd  Fix so that if exec call returns error, free is still set.
# 02n,02feb99,tcy  modify defGroupSet () to set Tornado2 as default if
#                  folder name selected is a T101 folder
# 02m,28jan99,bjl  added headers and edited for coding conventions.
# 02l,28jan99,wmd  Fix bug in checkPathLen when filename itself is too long.
# 02k,14jan99,wmd  Move procedure debug from INSTALL.TCL to this file.
# 02j,13jan99,wmd  Copy fspace proc from fspace.tcl to this file.
# 02i,18nov98,wmd  added proc checkPathLen
# 02h,16oct98,tcy  added instKeyData[G|S]et()
# 02g,15oct98,tcy  do a unix2dos on filename if win98 host in proc cdFileNameGet
# 02f,13oct98,wmd  do a unix2dos on filename if win95 host in proc cdFileNameGet
# 02e,15sep98,wmd  added cdFileNameGet proc, changed tmpDirGet() to return
#                  /vobs/wpwr/host/<HOST_TYPE>/lib if env var TCL_DEBUG exists.
# 02d,11sep98,tcy  added sysDir[G|S]et ()
# 02c,01sep98,wmd  added destDirDispGet proc.
# 02b,19aug98,wmd  add proc tmpDirGet.
# 02a,22jul98,tcy  moved licenseHomeDirGet/Set () to LICW32.TCL
# 01d,10aug97,pdn  fixed instKeyGet() to trim off white space before return.
# 01c,09feb97,pdn  added exitMsgSet/exitMsgGet functions
# 01b,25nov96,sj   added functions for tempDir, arFlags, currentIndex
# 01a,14nov96,pdn  written
#
# DESCRIPTION
# This file contains the common functions used by the Setup Tcl files.
#
#*/

##############################################################################
#
# userNameGet - returns the name of the user.
# 
# This routine returns the name of the user.  If the user name has not been
# set, an empty string is returned.
#
# SYNOPSIS:
# userNameGet
#
# PARAMETERS: N/A
#
# RETURNS: the user name if it exists, else an empty string.   
# 
# ERRORS: N/A
#

proc userNameGet {} {
    global setupVals

    if {[info exists setupVals(userName)]} {
        return $setupVals(userName)
    } else {
        return ""
    }
}

##############################################################################
#
# userNameSet - sets the name of the user.
# 
# Sets the global variable setupVals(userName) to the name of the user.
#
# SYNOPSIS:
# userNameSet val
#
# PARAMETERS: 
# <val>
# Contains the name of the user. 
#
# RETURNS: N/A
# 
# ERRORS: N/A
#

proc userNameSet {val} {
    global setupVals

    set setupVals(userName) $val
}

##############################################################################
#
# companyNameGet - returns the company name. 
#
# This routine returns the company name.  If the company name has not
# been set, an empty string is returned.
#
# SYNOPSIS:
# companyNameGet
#
# PARAMETERS: N/A
#
# RETURNS: the company name if it exists, else an empty string.
#
# ERRORS: N/A
#

proc companyNameGet {} {
    global setupVals

    if {[info exists setupVals(companyName)]} {
        return $setupVals(companyName)
    } else {
        return ""
    }
}

##############################################################################
#
# companyNameSet - sets the name of the company.
#
# Sets the global variable setupVals(companyName) to the name of the company.
#
# SYNOPSIS:
# companyNameSet val
#
# PARAMETERS:
# <val>
# Contains the name of the company.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc companyNameSet {val} {
    global setupVals

    set setupVals(companyName) $val
}

##############################################################################
#
# instKeyGet - returns the installation key.
#
# This routine returns the installation key.  If the installation key has not
# been set, an empty string is returned.
#
# SYNOPSIS:
# instKeyGet
#
# PARAMETERS: N/A
#
# RETURNS: the installation key if it exists, else an empty string.
#
# ERRORS: N/A
#

proc instKeyGet {} {
    global setupVals

    if {[info exists setupVals(instKey)]} {
        return [string trim $setupVals(instKey)]
    } else {
        return ""
    }
}

##############################################################################
#
# instKeySet - sets the installation key.
#
# Sets the global variable setupVals(instKey) to the installation key.
#
# SYNOPSIS:
# instKeySet val
#
# PARAMETERS:
# <val>
# Contains the installation key.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc instKeySet {val} {
    global setupVals

    set setupVals(instKey) $val
}

##############################################################################
#
# instKeyDataGet - returns the installation key data.
#
# This routine returns the installation key data, which includes 
# the installation key history for a particular CD.  If the installation key 
# data has not been set, an empty string is returned.
#
# SYNOPSIS:
# instKeyDataGet
#
# PARAMETERS: N/A
#
# RETURNS: the installation key data if it exists, else an empty string.
#
# ERRORS: N/A
#

proc instKeyDataGet {} {
    global setupVals

    if {[info exists setupVals(keyList)]} {
        return [string trim $setupVals(keyList)] 
    } else {
        return ""
    }
}

##############################################################################
#
# instKeyDataSet - sets the installation key data.
#
# Sets the global variable setupVals(keyList) to the installation key data.
#
# SYNOPSIS:
# instKeyDataSet val
#
# PARAMETERS:
# <val>
# Contains the installation key data.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc instKeyDataSet {val} {
    global setupVals

    set setupVals(keyList) $val
}

##############################################################################
#
# cdromZipDirGet - returns the directory containing the Setup zip files.
#
# This routine returns the directory containing the Setup zip (WIND) files.  
# If the zip directory has not been set, an empty string is returned.
#
# SYNOPSIS:
# cdromZipDirGet
#
# PARAMETERS: N/A
#
# RETURNS: the zip directory if it exists, else an empty string.
#
# ERRORS: N/A
#

proc cdromZipDirGet {} {
    global setupVals

    if {[info exists setupVals(cdromZipDir)]} {
        return $setupVals(cdromZipDir)
    } else {
        return ""
    }
}

##############################################################################
#
# cdromZipDirSet - sets the zip directory. 
#
# Sets the global variable setupVals(cdromZipDir) to the directory 
# containing the Setup zip (WIND) files.
#
# SYNOPSIS:
# cdromZipDirSet val
#
# PARAMETERS:
# <val>
# Contains the zip directory.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc cdromZipDirSet {val} {
    global setupVals

    set setupVals(cdromZipDir) $val
}

##############################################################################
#
# cdromRootDirGet - returns the root directory of the CD-ROM.
#
# This routine returns the root directory of the CD-ROM, or the root
# of the Setup tree.  If the root directory has not been set, an empty 
# string is returned.
#
# SYNOPSIS:
# cdromRootDirGet
#
# PARAMETERS: N/A
#
# RETURNS: the Setup root directory if it exists, else an empty string.
#
# ERRORS: N/A
#

proc cdromRootDirGet {} {
    global env

    if {[info exists env(CD_ROOT)]} {
        return $env(CD_ROOT)
    } else {
        return ""
    }
}

##############################################################################
#
# cdFileNameGet - returns the root directory of the CD-ROM.
#
# This routine returns the root directory of the CD-ROM, or the root
# of the Setup tree.  If the root directory has not been set, an empty 
# string is returned.
#
# SYNOPSIS:
# cdromRootDirGet
#
# PARAMETERS: N/A
#
# RETURNS: the Setup root directory if it exists, else an empty string.
#
# ERRORS: N/A
#

proc cdFileNameGet {fileName} {
    global ctrlVals
    
    # return only valid all uppercase or all lower case path/fileName

    set fn [string toupper $fileName]
    if {$ctrlVals(version) == "WIN95" || $ctrlVals(version) == "WIN98"} {
        set fn [unixToDos [file join [cdromRootDirGet] $fn]]
    } else {
        set fn [file join [cdromRootDirGet] $fn]
    }
    if {[file exists $fn]} {
        return $fn
    } 

    set fn [string tolower $fileName]
    if {$ctrlVals(version) == "WIN95" || $ctrlVals(version) == "WIN98"} {
        set fn [unixToDos [file join [cdromRootDirGet] $fn]]
    } else {
        set fn [file join [cdromRootDirGet] $fn]
    }
    if {[file exists $fn]} {
        return $fn
    }

    if {$ctrlVals(version) == "WIN95" || $ctrlVals(version) == "WIN98"} {
        set fn [unixToDos [file join [cdromRootDirGet] $fileName]]
    } else {
        set fn [file join [cdromRootDirGet] $fileName]
    }
    return $fn
}

##############################################################################
#
# tmpDirGet - returns the temporary directory.
#
# This routine returns the temporary directory set by the environment
# variable TMP.  For debugging purposes and to use the tcl debugger, setting 
# the environment variable TCL_DEBUG will return the [windHostType]/lib 
# directory in the current view.  If the temp directory has not been set, 
# an empty string is returned.
#
# SYNOPSIS:
# tmpDirGet
#
# PARAMETERS: N/A
#
# RETURNS: /vobs/wpwr/host/[windHostTypeGet] if env(TCL_DEBUG) exists,
#          the value set by the environment variable TMP, or the empty
#          string if neither exists.
#
# ERRORS: N/A
#

proc tmpDirGet {} {
    global env

    if {[info exists env(TCL_DEBUG)]} {
        return /vobs/wpwr/host/[windHostTypeGet]/lib
    }

    if {[info exists env(TMP)]} {
        return $env(TMP)
    } else {
        return ""
    }
}

##############################################################################
#
# uninstHomeDirGet - returns the uninstall home directory.
#
# This routine returns the uninstall home directory set by 
# setupVals(uninstHomeDir).  If the uninstall home directory has not
# been set, an empty string is returned.
#
# SYNOPSIS:
# uninstHomeDirGet
#
# PARAMETERS: N/A
#
# RETURNS: the installation key if it exists, else an empty string.
#
# ERRORS: N/A
#

proc uninstHomeDirGet {} {
    global setupVals

    if {[info exists setupVals(uninstHomeDir)]} {
        return $setupVals(uninstHomeDir)
    } else {
        return ""
    }
}

##############################################################################
#
# uninstHomeDirSet - sets the uninstall home directory.
#
# Sets the global variable setupVals(uninstHomeDir) to the uninstall
# home directory.
#
# SYNOPSIS:
# uninstHomeDirSet val
#
# PARAMETERS:
# <val>
# Contains the uninstall home directory.  
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc uninstHomeDirSet {val} {
    global setupVals

    set setupVals(uninstHomeDir) $val
}

##############################################################################
#
# destDirDispGet - returns the destination directory with slashes displayed
#                  in Unix format.
#
# Returns the destination directory to be displayed to the user.  Slashes 
# are converted to Unix format.
#