compslct.tcl

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

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

proc onDupProdSelComp {} {
   global dupRetVal

    set dupRetVal 1
    windowClose duplicate_products_warn
}

#############################################################################
#
# dupProdDlgInit - initialize values for dupProdDlg dialog box
#
# This procedure will initialize values for dupProdDlg dialog box
#
# SYNOPSIS
# .tS
# dupProdDlgInit
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc dupProdDlgInit {} {
    global setupVals

    foreach item $setupVals(duplicateProducts) {
        set lst [format %s\r\n $item]
        append prodList $lst
    }
    controlTextSet duplicate_products_warn.dupProdText $prodList
    controlSelectionSet duplicate_products_warn.dupProdText 0 0
}

#############################################################################
#
# dupProdDlg - display warnings if products are being re-installed
#
# This procedure will display warnings if products are being re-installed
#
# SYNOPSIS
# .tS
# dupProdDlg
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: dupRetVal which is set to 1 by onDupProdSelComp or
#                                    0 by onDupProdContinue
#
# ERRORS: N/A
#

proc dupProdDlg {} {
    global setupVals
    global ctrlVals
    global dupRetVal

    set controls [list \
             [list label -title \
                    "Setup has detected that the following products \
                     were previously installed in [destDirGet] \
                     and you are about to re-install them:" \
                     -name dupProdLabel \
                     -xpos 7 -ypos 9 -width 186 -height 30] \
             [list text -name dupProdText -border \
                    -xpos 7 -ypos 37 -width 185 -height 40 \
                    -readonly -multiline -vscroll] \
             [list label -title [strTableGet 1137_DUP_PRODUCT_WARN] \
                     -name dupProdLabel2 \
                     -xpos 7 -ypos 84 -width 186 -height 40] \
             [list button -title "&Continue" -name continue -default \
                          -xpos 8 -ypos 129 -width 67 -height 14 \
                          -callback onDupProdContinue] \
             [list button -title "&Select Products" -name cancelButt \
                          -xpos 127 -ypos 129 -width 67 -height 14  \
                          -callback onDupProdSelComp ] \
    ]

    dialogCreate \
        -name duplicate_products_warn \
        -title Setup\
        -init dupProdDlgInit \
        -parent $ctrlVals(parentDialog) \
        -helpfile $setupVals(setupHelp) \
        -width 200 -height 150 \
        -controls $controls

    return $dupRetVal
}

#############################################################################
#
# pageProcess(compSelect) - process inputs from compSelect page
#
# This procedure will process inputs from compSelect page
#
# SYNOPSIS
# .tS
# pageProcess(compSelect)
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: 0 if the user needs to re-select the products
#          1 if the user is allowed to continue with installation
#          2 if user decides to quit
#
# ERRORS: N/A
#

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

    set torVer "Tornado 101"
    set retVal 1

    # check to see if installing over a T101 tree and prevent it.

    set t101File "host/resource/tcl/app-config/Tornado/01WindCFG.win32.tcl"
    set t101File [file join [destDirGet] $t101File]
    if {[file exists $t101File]} {

        # don't want the user to overwrite existing t1 tree
        # test automation

        if { $ctrlVals(useInputScript) } {
            autoSetupLog "\tError: Attempt to install over an \
                            existing $torVer tree. \
                            Please choose a new installation path."
            applicationExit
            return 0
        }

        # warn and prevent the user from proceeding with installation

        preventInstallation $torVer

        # pop the user back to the destination path screen

        return [calcPage destDir]
    }


    # check for a core installation and previously installed products

    checkForPreviouslyInstalledProds

    if {$setupVals(dupCoreInstall)} {

        # overwrite existing directory automatically in autoInstall mode
        # test automation

        if { $ctrlVals(useInputScript) } {
            set retVal 1
        } else {
            messageBeep
            catch {dialog base_install_warn "Setup" \
                    [strTableGet 4000_BASE_INSTALL_WARN] \
                    question 0} result

            if {$result == 1 || $result == ""} {
                return [calcPage destDir]
            } else {
                set retVal 1
            }
        }
    }

    set dupProds $setupVals(duplicateProducts)
    if {[lindex $dupProds 0] != ""} {

        # present dialog to request permission to overwrite existing products
        # test automation

        if { $ctrlVals(useInputScript) } {
            autoSetupLog "\tAllowing overwrite of existing products."
        } else {
            messageBeep
            if {[dupProdDlg] == 1} {
                return 0
            }
        }
    }

    set reqSpace [controlValuesGet $ctrlVals(mainWindow).reqSpace]
    set availSpace [controlValuesGet $ctrlVals(mainWindow).availSpace]

    if {[llength [cdInfoGet selectedProdIndexList]] == 0} {
        messageBox [strTableGet 1151_COMP_SELECT_WARN]
        set retVal 0
    }

    # display the warnings file for each selected product

    foreach prodIndex [cdInfoGet selectedProdIndexList] {
        searchAndProcessSection WarningsFile [chooseInfFile $prodIndex]
    }

    if {$reqSpace > $availSpace} {

        # test automation

        if { $ctrlVals(useInputScript) } {
            autoSetupLog "\tWarning: not enough disk space."
            set i 1
        } else {
            messageBeep
            set i [dialog ok_proceed_exit "Setup" \
                  [strTableGet 1150_COMP_SELECT_WARN]]
        }

        switch $i {
            0 { set retVal [calcPage destDir] }
            1 { set retVal 1 }
            2 { quitCallback }
        }
    }

    # this is done now for unix since the folderSelect page is not used
    # for unix

    if {[isUnix]} {
        global tornadoInstalled

        foreach prodIndex [cdInfoGet selectedProdIndexList] {
            set productName [productInfoGet name $prodIndex]
            if {$productName == "tornado"||$productName == "tornado-vxsim"} {
                set tornadoInstalled 1
            }
        }

        if ![info exists tornadoInstalled] {
            pageRemove remoteRegistryHost
            pageRemove compatibility
            pageRemove howTo
        }
    }

    return $retVal
}

#############################################################################
#
# partListDlg - create dialog box for displaying parts within each Tornado
#               product
#
# This procedure will create dialog box for displaying parts within each
# Tornado product
#
# SYNOPSIS
# .tS
# partListDlg
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc partListDlg {} {
    global ctrlVals
    global setupVals

    dialogCreate \
        -name partListDlgHnd \
        -title "Select Parts" \
        -width 263 -height 195 \
        -helpfile $setupVals(setupHelp) \
        -init partListDlgInit \
        -parent $ctrlVals(mainWindow) \
        -exit checkProductDependency \
        -controls { \
                { button -title "Cancel" -name cancelButt \
                        -xpos 206 -ypos 173 -width 50 -height 14  \
                        -callback onPartListDlgCancel \
                }
                { button -title "OK" -name okButt -default \
                        -xpos 150 -ypos 173 -width 50 -height 14  \
                        -callback onPartListDlgOk \
                }
                { checklist -name optionList  \
                        -xpos 7 -ypos 45 -width 249 -height 83  \
                        -callback onClickPartCheckList \
                }
                { label -title "Information" -name Information \
                        -xpos 12 -ypos 130 -w 50 -height 8 \
                }
                { frame -name frm1 \
                        -xpos 7 -ypos 140 -width 249 -height 27 \
                }
                { label -title "Space Required:" -name spaceRequireLabel  \
                        -xpos 16 -ypos 149 -width 170 -height 8  \
                }
                { label -title "In the part list below  click \
                                to select items you want to install or\
                                clear items you don't want to install." \
                        -name label3  \
                        -xpos 7 -ypos 7 -width 249 -height 18  \
                }
                { label -title "Parts:" -name label2  \
                        -xpos 8 -ypos 31 -width 86 -height 8  \
                }
        }
}

#############################################################################
#
# partListDlgInit - initialize partListDlg by calling partGuiUpdate
#
# This procedure will initialize partListDlg by calling partGuiUpdate
#
# SYNOPSIS
# .tS
# partListDlgInit
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc partListDlgInit {} {
    partGuiUpdate 0
}

#############################################################################
#
# currSelProdIndexSet - save the index of a product in a global array ctrlVals
#
# This procedure will  save the index of a product in a global array ctrlVals
#
# SYNOPSIS
# .tS
# currSelProdIndexSet <index>
# .tE
#
# PARAMETERS:
# .IP index
# a indexing number to the product list
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc currSelProdIndexSet {index} {
    global ctrlVals

    set ctrlVals(currSelProdIndex) $index
}

#############################################################################
#
# currSelProdIndexGet - obtain the current selected product's index
#
# This procedure will obtain the current selected product's index
#
# SYNOPSIS
# .tS
# currSelProdIndexGet <info>
# .tE
#
# PARAMETERS:
# .IP info
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc currSelProdIndexGet {{info obj}} {
    global objGuiMap ctrlVals

    if {"$info" != "obj"} {
        set retVal $ctrlVals(currSelProdIndex)
    } else {
        set retVal $objGuiMap(gui2prod,$ctrlVals(currSelProdIndex))
    }

    return $retVal
}

#############################################################################
#
# onClickPartCheckList -  is invoked when a part is selected from the
#                         partListDlg dialog box and it calls helper
#                         procedures to update the GUI and the object
#
# This procedure is a callback when a part is selected from the partListDlg
# dialog box and it calls helper procedures to update the GUI and the object
#
#
# SYNOPSIS
# .tS
# onClickPartCheckList
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc onClickPartCheckList {} {

    partObjUpdate
    partGuiSizeUpdate
}
#############################################################################
#
# partObjUpdate - update the Tornado part object
#
# This procedure will update the Tornado part object
#
# SYNOPSIS
# .tS
# partObjUpdate
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc partObjUpdate {} {
    global ctrlVals objGuiMap

    set i 0
    foreach itemState \
                [controlItemPropertyGet partListDlgHnd.optionList -checkstate] {

        partInfoSet instFlag $objGuiMap(gui2part,$i) $itemState
        incr i
    }