insttk.tcl

开发VxWorks图形界面所必须的媒体库WindML2.0的补丁windml2-cp2。

        $detailButt config -state disabled        
    } {
        $detailButt config -state normal        
    } 
}

proc currSelProdIndexGet {} {
    global currSelProdIndex

    return $currSelProdIndex
}


proc onClickProdCheckButt {w prodIndex} {
    global objGuiMap pickList
    global selection ctrlVals

    set guiIndex $objGuiMap(prod2gui,$prodIndex)

    productInfoSet instFlag $prodIndex $pickList(prod,$prodIndex)
    productInfoSet stateCommit $prodIndex
    productInfoSet childStateCommit $prodIndex

    productGuiSizeUpdate $w

    set sizeWig $w.pick.canvas.lineItem$guiIndex.size
    set mbSize [byteToMbyte [productInfoGet size $prodIndex]]

    $sizeWig config -text $mbSize

    # change the button description color

    if [info exist selection] {
        $selection config -bg $ctrlVals(mainBg)
    }

    set buttDescWig $w.pick.canvas.lineItem$guiIndex.butDesc
    $buttDescWig config -bg $ctrlVals(secondBg)
    set selection $buttDescWig

    currSelProdIndexSet $w.infoFrm.detail $prodIndex
}

proc onProductDetailButt {} {
    global partListDlg ctrlVals objGuiMap pickList

    set w [toplevel .partListDlg -bd 15 -width 350 -height 290]
    wm title $w "Select Part"
    wm maxsize $w 350 290
    wm minsize $w 350 290
    catch {grab $w}
 
    labelCreate $w.msg "[strTableGet 1140_COMP_SELECT]"
    place $w.msg -in $w

    frame $w.req 
    labelCreate $w.req.text "Space Required:    " 
    labelCreate $w.req.size "  0.0 MB"
    pack $w.req.text $w.req.size -side left -fill x
    place $w.req -in $w -y 190

    frame $w.pick
    place $w.pick -in $w -y 60

    set cv $w.pick.cv
    canvas $cv -width 300 -height 118 -relief sunken -borderwidth 1 \
        -yscrollcommand "$w.pick.vscroll set" -highlightthickness 0

    scrollbar $w.pick.vscroll -command "$cv yview" -highlightthickness 0
    pack $w.pick.vscroll -side right -fill y
    pack $cv -in $w.pick -expand yes -fill both

    frame $w.separator -bd 1 -relief sunken -width 320 -height 2
    place $w.separator -in $w -y 220

    button $w.ok -text "OK" \
                     -command "onPartOkButt" \
                     -font $ctrlVals(bldFont) \
                     -padx 14 -pady 2

    place $w.ok -in $w -y 235 -x 170

    button $w.cancel -text "Cancel" \
                     -command "onPartCancelButt" \
                     -font $ctrlVals(bldFont) \
                     -padx 14 -pady 2

    place $w.cancel -in $w -y 235 -x 240

    update

    set i 0

    foreach partIndex [productInfoGet partIndexList [currSelProdIndexGet]] {

        set objGuiMap(gui2part,$i) $partIndex
        set objGuiMap(part2gui,$partIndex) $i

        if ![info exists pickList(part,$partIndex)] {
            set pickList(part,$partIndex) [partInfoGet instFlag $partIndex] 
        }

        set mbSize [byteToMbyte [partInfoGet size $partIndex]]
       
        if ![winfo exists $cv.lineItem$i] {
            frame $cv.lineItem$i
    
            checkbutton $cv.lineItem$i.cb \
                        -highlightthickness 0 \
                        -relief flat -pady 0 \
                        -variable pickList(part,$partIndex)

            button $cv.lineItem$i.butDesc \
                        -text [partInfoGet desc $partIndex] \
                        -font $ctrlVals(smallFont) \
                        -command {} \
                        -highlightthickness 0 \
                        -relief flat -pady 0
    
            label $cv.lineItem$i.size \
                        -justify right \
                        -font $ctrlVals(smallFont) \
                        -text $mbSize

            pack $cv.lineItem$i.cb $cv.lineItem$i.butDesc -side left
            pack $cv.lineItem$i.size -side right
    
            $cv create window 5 [expr $i * 20 + 2] \
                       -window $cv.lineItem$i \
                       -anchor nw -tags item \
                       -width 290 -height 16
    
            bind $cv.lineItem$i.cb <ButtonRelease-1> \
                "onClickPartCheckButt $w.req.size $partIndex"
        } {
            $cv.lineItem$i.size configure -text $mbSize
        }

        incr i
        update
    }

    $cv config -scrollregion "0 2 0 [expr ($i * 20) - 2]"
    $cv config -yscrollincrement 20
  
    partGuiSizeUpdate $w.req.size

    set partListDlg(done) 0
    tkwait variable partListDlg(done)
    catch {grab release $w}
    destroy $w
}

proc onClickPartCheckButt {w partIndex} {
    global pickList

    partInfoSet instFlag $partIndex $pickList(part,$partIndex)
    partGuiSizeUpdate $w
}

proc partGuiSizeUpdate {w} {
    set prodIndex [currSelProdIndexGet]
    set totalSize [byteToMbyte [productInfoGet size $prodIndex]]
    $w config -text "$totalSize MB"
}

proc onPartOkButt {} {
    global partListDlg objGuiMap ctrlVals pickList

    set partListDlg(done) 1
    set prodIndex [currSelProdIndexGet]

    switch [productInfoGet stateInfo $prodIndex] {
        changedIncr {
            productInfoSet instFlag \
                    [partInfoGet parent $objGuiMap(gui2part,0)] 1
            set pickList(prod,$prodIndex) 1
        }

        changedToNone {
            productInfoSet instFlag \
                    [partInfoGet parent $objGuiMap(gui2part,0)] 0
            set pickList(prod,$prodIndex) 0
        }
    }

    productGuiUpdate $ctrlVals(volatileFrm)
    productInfoSet stateCommit $prodIndex
    productInfoSet childStateCommit $prodIndex
}

proc onPartCancelButt {} {
    global partListDlg ctrlVals

    set partListDlg(done) 1
    productInfoSet childStateRestore [currSelProdIndexGet]
}

proc pageProcess(compSelect) {w} {

    beginWaitCursor

    set retVal 1
    set avail [lindex [$w.infoFrm.avail.size cget -text] 0]
    set require [lindex [$w.infoFrm.req.size cget -text] 0]

    if {$avail < $require} { 
        set i [tk_dialog .setup "Setup" [strTableGet 1150_COMP_SELECT_WARN] \
                                question 0 Yes No]
        if {$i == 0} {
            set retVal 0 
        } {
            set retVal 1
        }
    }

    endWaitCursor
    return $retVal
}

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

    beginWaitCursor

    set w [dlgFrmCreate [strTableGet 1460_TITLE_PERMISSION]]
    $w.msg config -text [strTableGet 1160_PERMISSION]

    if {[catch {setupId effective group} gprName]} {
        set gprName "group"
    }

    if {[catch {setupId effective user} usrName]} {
        set usrName "user"
    }

    if ![info exists setupVals(umask)] umaskGet

    set cf $w.cbFrm
    frame $cf
    place $cf -in $w -y 170

    frame $cf.r
    frame $cf.w
    pack $cf.r $cf.w -side left -anchor nw -pady 2

    checkbutton $cf.r.u -text "$usrName read" -variable setupVals(ur) \
                      -font $ctrlVals(textFont) -highlightthickness 0
    checkbutton $cf.r.g -text "$gprName read" -variable setupVals(gr) \
                      -font $ctrlVals(textFont) -highlightthickness 0
    checkbutton $cf.r.o -text "other read" -variable setupVals(or) \
                      -font $ctrlVals(textFont) -highlightthickness 0
    checkbutton $cf.w.u -text "$usrName write" -variable setupVals(uw) \
                      -font $ctrlVals(textFont) -highlightthickness 0
    checkbutton $cf.w.g -text "$gprName write" -variable setupVals(gw) \
                      -font $ctrlVals(textFont) -highlightthickness 0
    checkbutton $cf.w.o -text "other write" -variable setupVals(ow) \
                      -font $ctrlVals(textFont) -highlightthickness 0

    $cf.r.u config -state disabled
    $cf.w.u config -state disabled

    pack $cf.r.u $cf.r.g $cf.r.o -side top -padx 25 -anchor nw
    pack $cf.w.u $cf.w.g $cf.w.o -side top -padx 25 -anchor nw
    endWaitCursor
}

proc pageProcess(permission) {w} {
    beginWaitCursor
    umaskSet
    endWaitCursor
    return 1
}

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

    beginWaitCursor

    set w [dlgFrmCreate [strTableGet 1470_TITLE_FILECOPY]]

    .buts.back config -state disabled
    .buts.next config -state disabled

    set ctrlVals(bbrdList) [bbrdListGet .PPM]

    if {[llength $ctrlVals(bbrdList)] == 0} {
        set ctrlVals(numBbrd) 0
        set ctrlVals(displayInt) 0
        set ctrlVals(bbrdElapse) 101
        $w.msg config -text [strTableGet 1170_FILE_COPY]
    } {
        set ctrlVals(numBbrd) [llength $ctrlVals(bbrdList)]
        set ctrlVals(displayInt) [expr 100 / $ctrlVals(numBbrd)]
        set ctrlVals(bbrdElapse) -1
        place forget .bitmap
        toplevel .meter
        wm transient .meter .
        wm title .meter "Progress"
        wm geometry .meter $ctrlVals(mtrPos)
        place $w -in . -x 0 -y 0 -width [winfo width .] -height 325
        set w .meter
    } 

    meterCreate $w
    endWaitCursor
    filesCopy
    meterDestroy $w
    .buts.next config -state normal
    nextCallback
}

proc pageProcess(filesCopy) {w} {
    global ctrlVals
    global setupVals
    global objects

    # This global variable is set in the tornado/postInstall.tcl
    global tornadoInstalled

    beginWaitCursor
    if ![info exists tornadoInstalled] {
        pageRemove "remoteRegistryHost"
    } 

    set binDir "[destDirGet]/host/[windHostTypeGet]/bin"

    if {[array names objects] == ""} {
        pageRemove "libUpdate"
    }

    endWaitCursor
    return 1
}

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

    beginWaitCursor

    set w [dlgFrmCreate [strTableGet 1480_TITLE_LIBUPDATE]]
    $w.msg config -text [strTableGet 1180_LIB_UPDATE]

    .buts.back config -state disabled
    .buts.next config -state disabled

    meterCreate $w
    endWaitCursor
    librariesUpdate
    meterDestroy $w
    .buts.next config -state normal
    nextCallback
}

proc pageProcess(libUpdate) {w} {
    return 1
}

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

    beginWaitCursor

    set w [dlgFrmCreate [strTableGet 1490_TITLE_REGISTRY_HOST]]
    $w.msg config -text [strTableGet 1190_REGISTRY_HOST]

    labelCreate $w.regLabel "Host name:"
    place $w.regLabel -in $w -y 190
    entry $w.regText -relief sunken -width 30 -font $ctrlVals(textFont) \
                     -textvariable setupVals(regHost) 
    place $w.regText -in $w -x 90 -y 190
    focus $w.regText
    endWaitCursor
}

proc pageProcess(remoteRegistryHost) {w} {
    return 1
}

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

    beginWaitCursor

    set w [dlgFrmCreate [strTableGet 1561_TITLE_LICENSE_REMOTE]]
    $w.msg config -text [strTableGet 1353_LICENSE_REMOTE]

    if ![catch {open $setupVals(windLmHostHome)/WIND_LMHOST "r"} fLmHost] {
        set setupVals(licenseHost) [lindex [split [read $fLmHost] "\n"] 0]
        close $fLmHost
    }

    labelCreate $w.licLabel "Host name:"
    place $w.licLabel -in $w -y 190
    entry $w.licText -relief sunken -width 30 -font $ctrlVals(textFont) \
                     -textvariable setupVals(licenseHost)
    place $w.licText -in $w -x 90 -y 190
    focus $w.licText
    endWaitCursor
}

proc pageProcess(remoteLicenseHost) {w} {
    global ctrlVals
    global setupVals

    beginWaitCursor
    set retVal 1

    if {![file isdir $setupVals(windLmHostHome)] &&
         [catch {file mkdir $setupVals(windLmHostHome)} error]} {

        messageBox "$error"
        endWaitCursor
        return 0
    } 
    
    if {![regexp {^[ ]*$} "$setupVals(licenseHost)"]} {
        if ![catch {open $setupVals(windLmHostHome)/WIND_LMHOST "w"} fLmHost] {
            puts $fLmHost $setupVals(licenseHost)
            close $fLmHost
            exitMsgSet [strTableGet 1354_LICENSE_REMOTE]
        }
    } {
        messageBox [strTableGet 1072_WARN_1]
        set retVal 0
    }

    endWaitCursor
    return $retVal
}


proc pageCreate(finish) {} {

    beginWaitCursor

    set w [dlgFrmCreate [strTableGet 1500_TITLE_FINISH]]

    # Normal exit message

    exitMsgSet [strTableGet 1210_FINISH]

    # Remind the user that they may need to install license

    if {[llength [cdInfoGet installedFeatureIdList]] > 0} {
        exitMsgSet "[exitMsgGet]  [strTableGet 1205_FINISH]"
    }

    # Warn the user in case of error during the setup

    if {[errorCountGet] > 0} {
        exitMsgSet "[exitMsgGet]  [strTableGet 1200_FINISH_WARN]"
    }

    $w.msg config -text [exitMsgGet]

    .buts.next config -text "Finish"
    .buts.cancel config -state disabled
    .buts.back config -state disabled
    endWaitCursor
}

proc pageProcess(finish) {w} {
    global setupVals
    global tornadoInstalled

    beginWaitCursor