install.tcl

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

# instFlag                a toggle flag that tells if a product is selected
# prevInstFlag            a previous stage of the above flag
# size                    a total size of a product
# totalFile               a total files of a product
# selectedPartIndexList   a list of selected part of a product
# featureId               a feature id of a product
# stateInfo               a selection state of a product
# coreProd                a product is a core product flag
#
# SYNOPSIS
# productInfoGet <attrib> <productId>
#
# PARAMETERS: 
#    <attrib> : one of the above attributes
#    <productId> : a uniq integer that identifies the product.
#
# RETURNS: the requested information.
#
# ERRORS: N/A
#

proc productInfoGet {info prodIndex} {
    global productObj

    switch $info {
        partIndexList { return $productObj($prodIndex,partIndexList) }

        number { return $productObj($prodIndex,number) }

        name { return $productObj($prodIndex,name) }

        desc { return $productObj($prodIndex,desc) }

        instFlag { return $productObj($prodIndex,instFlag) }

        prevInstFlag { return $productObj($prodIndex,prevInstFlag) }

        size { 
            set retVal 0
        
            foreach partIndex [productInfoGet selectedPartIndexList $prodIndex] {
                incr retVal [partInfoGet size $partIndex]
            }

            if {($retVal < 104858) && ($retVal > 0)} { set retVal 104858 }

            return $retVal
        }

        totalFile { 
            set retVal 0

            foreach partIndex [productInfoGet selectedPartIndexList $prodIndex] {
                incr retVal [partInfoGet totalFile $partIndex]
            }

            return $retVal
        }

        selectedPartIndexList { 
            set retVal {}
          
            foreach partIndex $productObj($prodIndex,partIndexList) {

                if {"[partInfoGet instFlag $partIndex]" == "1"} {
                    lappend retVal $partIndex
                }
            }

            return $retVal
        }

        featureId {
            return $productObj($prodIndex,featureId)
        }

        coreProd {
            return $productObj($prodIndex,coreProd)
        }

        stateInfo {
            set totalPrev 0
            set totalCurr 0
            set state "unchanged"

            foreach partIndex $productObj($prodIndex,partIndexList) {

                set prev [partInfoGet prevInstFlag $partIndex]
                set curr [partInfoGet instFlag  $partIndex]

                incr totalPrev $prev
                incr totalCurr $curr

                if {"$prev" != "$curr"} {
                    set state "changed"
                }
            }

            return [stateInfoHelper $state $totalCurr $totalPrev]
        }

        default { puts "productInfoGet: unknown info: $info" }
    }
}

##############################################################################
#
# productInfoSet - changes the product object attributes
#
# see productInfoGet() for available products attributes.
#
# SYNOPSIS
# productInfoSet <attrib> <prodIndex> [value]
#
# PARAMETERS: 
#    <attrib> : a product attribute
#    <prodIndex> : an integer identifies a product
#    [value] : new value of an attribute
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc productInfoSet {info prodIndex {value ""}} {
    global productObj pickList

    switch $info {
        partIndexList { set productObj($prodIndex,partIndexList) $value }

        number { set productObj($prodIndex,number) $value }

        desc { set productObj($prodIndex,desc) $value }

        instFlag { 
            if {"$productObj($prodIndex,instFlag)" == "0" && \
                "$value" == "1"} {
            
                set setAllFlag 1
                set productObj($prodIndex,instFlag) $value
            
                foreach partIndex [productInfoGet partIndexList $prodIndex] {
                    if {"[partInfoGet instFlag $partIndex]" == "1"} {
                        set setAllFlag 0
                        break
                    }        
                }
            
                if {"$setAllFlag" == "1"} {
                    foreach partIndex [productInfoGet partIndexList $prodIndex] {
                        partInfoSet instFlag $partIndex 1
                        set pickList(part,$partIndex) 1
                    }
                }

            } else {
                set productObj($prodIndex,instFlag) $value
            }
        }

        stateCommit {
            set productObj($prodIndex,prevInstFlag) \
            $productObj($prodIndex,instFlag)
            }
    
        stateRestore {
            set productObj($prodIndex,instFlag) \
            $productObj($prodIndex,prevInstFlag)
            }
    
        childStateCommit {
            foreach partIndex $productObj($prodIndex,partIndexList) {
                partInfoSet stateCommit $partIndex  
            }
        }

        childStateRestore {
            foreach partIndex $productObj($prodIndex,partIndexList) {
                partInfoSet stateRestore $partIndex  
            }
        }

        default { puts "productInfoSet: unknown info: $info" }
    }
}

##############################################################################
#
# partInfoGet - returns the requested attribute of a part object.
#
# Attribute      Meaning
# ---------      -------
# instFlag       a toggle flags that indicate a selection state of a part
# prevInstFlag   a previous state of the above flag
# desc           a part description
# parent         an integer that identifies the parent product
# size           a total size of a part
# totalFile      a total number of files of a part
# 
# SYNOPSIS
# partInfoGet <attrib> <partIndex>
#
# PARAMETERS: 
#    <attrib> : a part object's attribute
#    <partIndex> : an integer indentifies a part
#
# RETURNS: requested attribute
#
# ERRORS: N/A
#

proc partInfoGet {info partIndex} {
    global partObj

    switch $info {
        instFlag { return $partObj($partIndex,instFlag) }

        prevInstFlag { return $partObj($partIndex,prevInstFlag) }

        desc { return $partObj($partIndex,desc) }

        parent { return $partObj($partIndex,parent) }

        size { 
            if [isUnix] {
                return $partObj($partIndex,size) 
            } else {

            # this option returns the estimated size of a part takes up
            # on a Windows file system. A file with 10 bytes can take up to
            # 32768 bytes on a FAT system.
            # On average, each file in tornado wastes 78% of one block. 
            # For each file in the part, it adds 78% of the system's 
            # block size to the file size to account for the extra bytes

            return  [format %.f [expr $partObj($partIndex,totalFile) * \
                    [setupClusterSizeGet [rootDirGet [destDirGet]]] * \
                    0.78 + $partObj($partIndex,size)]]
            }
        }

        totalFile { return $partObj($partIndex,totalFile) }

        coreProd { return $partObj($partIndex,coreProd) }

        default { puts "partInfoGet: unknown info: $info" }
    }
}

##############################################################################
#
# rootDirGet - returns the root directory or the drive letter for
#              a specified path on Windows machines.
#
# SYNOPSIS
# partInfoSet <path>
#
# PARAMETERS: 
#    <path> : a directory pathes
#
# RETURNS: root directory
#
# ERRORS: N/A
#

proc rootDirGet {path} {

    regexp {^(.*)\:(.*)$} $path junk root dir
    if { [info exists root] && "$root" != "" } {
        return "$root:\\"
    } else {
        return "c:\\"
    }
}

##############################################################################
#
# partInfoSet - changes an attribute of a part object
#
# see partInfoGet() for available attribute of a part object
#
# SYNOPSIS
# partInfoSet <attrib> <partIndex> [value]
#
# PARAMETERS: 
#    <attrib> : an attribute of a part object
#    <partIndex> : an integer that identifies a part
#    [value] : new attribute value
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc partInfoSet {info partIndex {value ""}} {
    global partObj pickList

    switch $info {
        instFlag { set partObj($partIndex,instFlag) $value }

        desc { set partObj($partIndex,desc) $value }

        parent { set partObj($partIndex,parent) $value }

        stateCommit {
            set partObj($partIndex,prevInstFlag) \
            $partObj($partIndex,instFlag)
            }
    
        stateRestore {
            set partObj($partIndex,instFlag) $partObj($partIndex,prevInstFlag)
            set pickList(part,$partIndex) $partObj($partIndex,prevInstFlag)
        }

        default { puts "partInfoSet: unknown info: $info" }
    }
}

##############################################################################
#
# stateInfoHelper -  determents if a selection state is changing
#
# By comparing the total size of the current and previous selection state, this 
# function helps reduce unnesscessary GUI updating.
#
# SYNOPSIS
# stateInfoHelper <state> <totalCurr> <totalPrev>
#
# PARAMETERS: 
#    <state> : curent state
#    <totalCurr> : total size in current state
#    <totalPrev> : total size in previous state
#
# RETURNS: new state.
#
# ERRORS: N/A
#

proc stateInfoHelper {state totalCurr totalPrev} {
    set retVal $state

    if {"$state" != "unchanged"} {

        if {"$totalCurr" == "0"} {
            set retVal "${state}ToNone"

        } elseif {"$totalCurr" >= "$totalPrev"} {
            set retVal "${state}Incr"

        } elseif {"$totalCurr" < "$totalPrev"} {
             set retVal "${state}Decr"
        }
    }

    return $retVal
}

##############################################################################
#
# objectDump - dumps out to stdout all object information
#
# SYNOPSIS
# objectDump
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc objectDump {} {
    global objGuiMap partObj productObj

    puts ""

    foreach elem [lsort [array names objGuiMap]] {
        puts "objGuiMap($elem) = $objGuiMap($elem)"
    }

    foreach elem [lsort [array names partObj]] {
        puts "partObj($elem) = $partObj($elem)"
    }

    foreach elem [lsort [array names productObj]] {
        puts "productObj($elem) = $productObj($elem)"
    }
}

##############################################################################
#
# cdNameGet - read CD part number from DISK_ID file written to by mfg
#
# SYNOPSIS
# cdNameGet
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc cdNameGet {{mode number}} {
    global setupVals

    set file [cdromRootDirGet]/DISK_ID

    if {[file exists "$file"] && ![catch {open "$file" "r"} f]} {
        gets $f setupVals(CDnumber)
        gets $f setupVals(CDdescription)
        gets $f setupVals(CDManufacturingTime)
        close $f
        switch $mode {
            number { return $setupVals(CDnumber) }
            description { return $setupVals(CDdescription) }
            time { return $setupVals(CDManufacturingTime) }
            default { return "" }
        }
    } else {
        puts "error reading DISK_ID file"
        return ""
    }
}

#
# initialize globals
#

source [cdromRootDirGet]/RESOURCE/TCL/VERSION.TCL
global overwritePolicy
catch {unset overwritePolicy}
set overwritePolicy(ALL) 0
set setupVals(uninstLog) 0

#
# loading setup agent
#
load  [cdromBinDirGet]/SETUPTCL[string toupper [info sharedlibextension]]