compslct.tcl

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

# COMPSELCT.TCL - Setup procedures for implementing component-selection
#                 wizard page
#
# Copyright 1999 Wind River Systems, Inc
#
# modification history
# --------------------
# 01t,21apr99,wmd  Fix spr #26372 - Unselecting "non-native" products should
#                  not display the warning message.
# 01s,12apr99,wmd  Need to make sure that "Tornado Simulator" product installs
#                  the drivers product as well.
# 01r,31mar99,wmd  Add another name to check for arch wise: SIMHPPA.
# 01q,25mar99,wmd  Fix cpu identification for simulator products.
# 01p,24mar99,wmd  Try to fix so that x86-winXX products are recognized as
#                  such.
# 01o,22mar99,bjl  remove compatibility page for Unix if tornado not 
#                  installed, added endWaitCursor.
# 01n,19mar99,wmd  Output to a file any debug messages.
# 01m,18mar99,tcy  added further checking for deselecting non-native products
# 01m,17mar99,wmd  Fix the width of the line to display "Grey box..."
#                  completely.
# 01l,11mar99,wmd  Move the tristate checkbox before the code to uncheck
#                  non-native hosts. Fix prodHostTypeGet.
# 01k,11mar99,wmd  For single part products, indicate 1/1 selected, and add
#                  check to 'foreign' hosts into part select OK proc.
# 01j,10mar99,wmd  Use the tri-state check box for the selected products.
# 01i,08mar99,tcy  fixed bug with code filtering non-native hostnames
# 01h,03mar99,tcy  Show correct size SETUP/ takes based on platform
#                  (fix for SPR 25228)
# 01g,22feb99,wmd  Fix so that unselected products show 0 out of XXX products.
# 01f,17feb99,tcy  Added proc installedProdDescGet() to return a list
#                  of products (fix for SPR 24897) 
#                  fix bug in installedProdGet() when checking dest. directory
# 01e,11feb99,wmd  Remove the apostrophes around the '*' so that it is more
#                  visible.
# 01d,29jan99,wmd  Fix spr #24559, show which products have components.
# 01c,28jan99,wmd  Fix spr # 24523, warn users of non-native installations,
#                  and initially uncheck those products not meant for the host.
# 01b,29jan99,tcy  moved byteToMbyte() and kbyteToMbyte() from INSTALL.TCL
# 01a,26jan99,tcy  extracted from INSTW32.TCL.
#

#############################################################################
#
# pageCreate(compSelect) - display products for users to install
#
# This procedure will display products for users to install
#
# SYNOPSIS
# .tS
# pageCreate(compSelect)
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc pageCreate(compSelect) {} {
    global ctrlVals
    global setupVals

    endWaitCursor

    set ctrlVals(volatileFrm) [list \
            [list label -name msg \
                        -title [strTableGet 1140_COMP_SELECT]\
                        -x 100 -y 9 -w 205 -h 26] \
            [list label -name message2 \
                        -title "&Products (Grey box indicates additional components selectable.)" \
                        -x 100 -y 37 -w 210 -h 8] \
            [list checklist -name optionList \
                            -callback onClickProdCheckList \
                            -x 100 -y 46 -w 207 -h 80] \
            [list label -name reqText \
                        -title "Space Required:" \
                        -x 107 -y 124 -w 55 -h 8] \
            [list label -name reqSpace \
                        -title "Unknown" \
                        -x 257 -y 124 -w 43 -h 8] \
            [list label -name availText \
                        -title "Space Available:" \
                        -x 107 -y 134 -w 55 -h 8] \
            [list label -name availSpace \
                        -title "Unknown" \
                        -x 257 -y 134 -w 43 -h 8] \
            [list frame -name frm1 \
                        -xpos 100 -ypos 148 -width 207 -height 25] \
            [list label -name compSelected \
                        -x 107 -y 153 -w 140 -h 18] \
            [list button -title "&Details..." -name partDetailButt  \
                        -xpos 249 -ypos 153 -width 50 -height 14  \
                        -callback partListDlg] \
    ]

    set w [dlgFrmCreate [strTableGet 1450_TITLE_OPTION]]

    productGuiChkLstCreate
    productGuiSizeUpdate

    # test automation

    if { $ctrlVals(useInputScript) } {
        autoSetupLog "Products Selection page:"
        autoSetupLog "\tInstalled products specified by the key"
        nextCallback
    }
}

#############################################################################
#
# preventInstallation - prevents users from continuing with installation
#
# This procedure will invoke a dialog box to stop users from continuing
# will installation
#
# SYNOPSIS
# .tS
# preventInstallation <ver>
# .tE
#
# PARAMETERS:
# .IP ver
# version of Tornado
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc preventInstallation {ver} {

    set message "You are attempting to install over an existing $ver\n\
                tree.  This is not recommended and will cause \
                incompatibilities\n\
                which will render the product unusable.\n\n\
                Please push \"OK\" to choose a new installation path."\

    dialog stop Setup $message
}
#############################################################################
#
# installedProdDescGet - return a list of installed product descriptions 
#                   that were installed irrespective of the pool Id
#
# This procedure returns a list of installed product descriptions that were 
# installed irrespective of the pool Id
#
# SYNOPSIS
# .tS
# installedProdDescGet <pool>
# .tE
#
# PARAMETERS:
#
# RETURNS: 
# The variable setupVals(instProdDescList) will be set after invoking
# the procedure. The variable will be set to NULL if Setup does not detect any 
# products in the destination directory
#
# ERRORS: N/A
#

proc installedProdDescGet {} {
    global setupVals

    # open the setup.log file and determine if there are any installed products
    # from the specified CD pool

    set logfile [file join [destDirGet] setup.log]
    if [catch {open $logfile r} logfd] {
        return ""
    } else {
        set text [split [read $logfd] \n]
        set nlines [llength $text]
        close $logfd

        for {set ix 0} {$ix < $nlines} {incr ix} {
            # iterate each line and search for the pool ID passed in

            set textLine [split [lindex $text $ix ]]
            # check to see if destination dir is same

            set instDir [lindex $textLine 3]
            # make sure case is not an issue when doing comparison

            if {[string tolower $instDir] == [string tolower [destDirGet]]} {
                incr ix
                # accumulate product numbers that are in this group

                set line [split [lindex $text $ix]]
                while {$ix < $nlines} {
                    if {[string range [lindex $line 1] 0 3] == "100-"} {
                        lappend prodDescList "[lrange $line 2 end]"
                    }
                    incr ix
                    set line [split [lindex $text $ix]]
                    if {[lsearch -regexp $line "TDK-"] == 1} {
                        break
                    }
                }
            }
        }
   }

   set setupVals(instProdDescList) $prodDescList
   dbgputs "Products installed: $setupVals(instProdDescList)"
}

#############################################################################
#
# installedProdGet - return a list of installed products that were installed
#                    from the same pool
#
# This procedure returns a list of installed products that were installed
# from the same pool
#
# SYNOPSIS
# .tS
# installedProdGet <pool>
# .tE
#
# PARAMETERS:
# .IP pool
# pool ID in the form of TDK-XXXXX-XX-XX
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc installedProdGet {pool} {
    global setupVals

    set prodList ""
    set poolID [string range $pool 0 [expr [string first "ZC" $pool] -1]]
    if {$poolID == ""} {
        set poolID $pool
    }

    # open the setup.log file and determine if there are any installed products
    # from the specified CD pool

    set logfile [file join [destDirGet] setup.log]
    if [catch {open $logfile r} logfd] {
        return ""
    } else {
        set text [split [read $logfd] \n]
        set nlines [llength $text]
        close $logfd

        for {set ix 0} {$ix < $nlines} {incr ix} {

            # iterate each line and search for the pool ID passed in

            set textLine [split [lindex $text $ix ]]
            if {[lsearch $textLine $poolID*] != -1} {

                # check to see if destination dir is same

                set instDir [lindex $textLine 3]
 
                # make sure case is not an issue when doing comparison
 
                if {[string tolower $instDir] == \
                    [string tolower [destDirGet]]} {
                    incr ix

                    # accumulate product numbers that are in this group

                    set line [split [lindex $text $ix]]
                    while {$ix < $nlines} {
                        if {[string range [lindex $line 1] 0 3] == "100-"} {
                            lappend prodList [lindex $line 1]
                        }
                        incr ix
                        set line [split [lindex $text $ix]]
                        if {[lsearch -regexp $line "TDK-"] == 1} {
                            break
                        }
                    }
                }

            }
        }
   }

   # make the list unique

   set prodList [lunique $prodList]
   set setupVals(instProdList) $prodList
}

#############################################################################
#
# lunique - return a new list with unique elements of the old list
#
# This procedure will return a new list with unique elements of the old list
#
# SYNOPSIS
# .tS
# lunique
# .tE
#
# PARAMETERS:
# .IP oldList
# a list of elements
#
# RETURNS: a new list with unique elements of the old list
#
# ERRORS: N/A
#

proc lunique {oldList} {

    set newList ""
    catch {unset arr} res
    foreach item $oldList {
        set arr($item) 1
    }
    foreach indx [array name arr] {
        lappend newList $indx
    }
    return $newList
}

#############################################################################
#
# analyzeInstFiles - check if any selected products are already installed
#
# This procedure will check if any selected products are already installed.
#
# SYNOPSIS
# .tS
# analyzeInstFiles
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc analyzeInstFiles {} {
    global ctrlVals
    global setupVals

    windowTimerCallbackSet analyzing_setup_files 0 ""
    set setupVals(instProdList) ""
    set setupVals(dupCoreInstall) 0
    set setupVals(duplicateProducts) ""

    beginWaitCursor

    # check and setup list of installed products if any

    installedProdGet $setupVals(CDnumber)

    foreach prodIndex [cdInfoGet selectedProdIndexList] {
        uiEventProcess

        # if there are installed products in the destDir

        if {$setupVals(instProdList) != ""} {
            set prodNum [productInfoGet number $prodIndex]
            if {[lsearch $setupVals(instProdList) $prodNum] != -1} {

                # check for existence of a core product in the selected list

                set productName [productInfoGet name $prodIndex]
                if {$productName == "tornado"} {
                    set setupVals(dupCoreInstall) 1
                } elseif {[productInfoGet coreProd $prodIndex] == "core"} {
                    set setupVals(dupCoreInstall) 1
                }
                lappend setupVals(duplicateProducts) \
                        [productInfoGet desc $prodIndex]
            }
        }
    }
    endWaitCursor
    windowClose analyzing_setup_files
}

#############################################################################
#
# checkForPreviouslyInstalledProds - create dialog box for checking whether
#                                    any selected products have been
#                                    previously installed
#
# SYNOPSIS
# .tS
# checkForPreviouslyInstalledProds
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc checkForPreviouslyInstalledProds {} {
    global ctrlVals
    global setupVals

    set setupVals(coreInstallation) 0

    dialogCreate \
        -name analyzing_setup_files \
        -notitle \
        -parent $ctrlVals(parentDialog) \
        -helpfile $setupVals(setupHelp) \
        -width 200 -height 32 \
        -init {
            controlPropertySet analyzing_setup_files.analyze_ctrl -bold 1; \
            windowTimerCallbackSet analyzing_setup_files \
                        -milliseconds 200 analyzeInstFiles
        } \
        -controls [list \
                [list label -name "analyze_ctrl" -center \
                -title [strTableGet 4020_ANALYZING_BANNER] \
                -x 15 -y 12 -w 170 -h 10 ]
        ]

}

#############################################################################
#
# onDupProdContinue - set dupRetVal to 0 and close the duplicate product
#                     dialog box
#
# This procedure will set dupRetVal to 0 and close the duplicate product
# dialog box
#
# SYNOPSIS
# .tS
# onDupProdContinue
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc onDupProdContinue {} {
    global dupRetVal

    set dupRetVal 0
    windowClose duplicate_products_warn
}

#############################################################################
#
# onDupProdSelComp - set dupRetVal to 1 and close the duplicate product
#                     dialog box