insttk.tcl

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

        frame .buts -width 500 -height 50
        place .buts -in . -y 325

        frame .buts.sep -bd 1 -relief sunken -width 460 -height 2
        place .buts.sep -in .buts -x 20

        # Create the "Back" button

        button .buts.back -text "Back" -command "backCallback" \
              -font $ctrlVals(bldFont) -padx 16 -pady 2
        place .buts.back -in .buts -y 14 -x 245

        # Create the "Next" button

        button .buts.next -text "Next" -command "nextCallback" \
              -font $ctrlVals(bldFont) -padx 16 -pady 2

        place .buts.next -in .buts -y 14 -x 314
        bind . <Return> ".buts.next flash; nextCallback"
    
        # Create the "Cancel" button

        button .buts.cancel -text "Cancel" -command "quitCallback" \
                -font $ctrlVals(bldFont) -padx 14 -pady 2
        place .buts.cancel -in .buts -y 14 -x 400
    }

    wm title . "Setup -- $title"

    update

    set w $ctrlVals(volatileFrm)
    frame $w -width 340 -height 295 
    place $w -in . -x 160 -y 20
    labelCreate $w.msg ""
    place $w.msg -in $w -x 0 -y 0  

    return $w
}

proc findFont {w {weight medium} {sizes {14 12 10}} {slant r}} {
    foreach vendor {adobe xerox linotype} {
        foreach family {times helvetica} {
            foreach size $sizes {
                set testFont -$vendor-$family-$weight-$slant-*-*-$size-*
                if {[catch {$w config -font $testFont}] == 0} {
                    return $testFont
                }
            }
        }
    }

    $w config -font fixed
    return fixed
}

proc nextCallback {} {
    global ctrlVals

    if {[pageProcess($ctrlVals(currPage)) $ctrlVals(volatileFrm)] == "0"} {
        return 0
    } {
        set currPageIndex [lsearch $ctrlVals(pageList) $ctrlVals(currPage)]

        if {"$currPageIndex" == "-1"} {
            puts "error: page $ctrlVals(currPage) not found!"
            return 0
        } {
            set nextPageIndex [expr $currPageIndex + 1]
            set nextPage [lindex $ctrlVals(pageList) $nextPageIndex]

            if {"$nextPage" == ""} {
                destroy .
                exit 0
            } {
                set ctrlVals(currPage) $nextPage
                catch {destroy $ctrlVals(volatileFrm)}
                pageCreate($nextPage)
            }
        }

    }
}

proc backCallback {} {
    global ctrlVals

    # decrement the dialog index and re-create previous page

    set currPageIndex [lsearch $ctrlVals(pageList) $ctrlVals(currPage)]
    set prevPageIndex [expr $currPageIndex - 1]

    if {"$prevPageIndex" >= "0"} {
        set ctrlVals(currPage) [lindex $ctrlVals(pageList) $prevPageIndex]
        catch {destroy $ctrlVals(volatileFrm)}
        pageCreate($ctrlVals(currPage))
    } else {
        messageBox "Can't go back further!"
    }
}

proc quitCallback {} {
    global setupVals

    set i [tk_dialog .quit "Setup" [strTableGet 1360_QUIT_CALLBACK] \
                            info 0 Resume {Exit Setup}]

    if {$i == 1} {
    wm withdraw .
    catch {
         uninstLog setup "\tUser aborted!"
        uninstStop
    }
        exit 0
    }
}

proc setWidth {w width} {
    set x2 [expr ($width * [winfo width $w]) / 100]
    $w coords poly 0 0 0 20 $x2 20 $x2 0 0 0
    $w itemconfigure [$w find withtag percent] -text "$width%"
}

proc labelCreate {wid txt} {
    global ctrlVals

    label $wid -font $ctrlVals(textFont) -wraplength 320 \
           -justify left -text $txt 
}

proc meterDestroy {w} {
    if { [winfo exists $w] != "0"} {
        catch {destroy $w}
        place .bitmap -in . -x 20 -y 20
    }
}

proc meterCreate {w} {
    global ctrlVals

    frame $w.meterFrm -borderwidth 10
    set meter $w.meterFrm.canvas

    canvas $meter -width 301 -height 18 \
        -highlightthickness 0 -borderwidth 2 -relief sunken
    $meter create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly
    $meter create text 150 10 -text "" -width 40 \
        -justify center -tags percent
    pack $meter -side bottom
    label $w.nameTag -font $ctrlVals(textFont) -justify left -text "" 

    if { [llength $ctrlVals(bbrdList)] > 0 } {
        place $w.meterFrm -in $w \
              -x [expr ([winfo width $w]/2) - ([winfo width $w.meterFrm]/2) +2]\
          -y 20
        place $w.nameTag -in $w -x 6 -y [expr 2.5*[winfo height $w.meterFrm]]
    } else {
        place $w.meterFrm -in $w -y 150
        place $w.nameTag -in $w -x 6 -y 130
    }

    set ctrlVals(meterWg) $meter
    set ctrlVals(meterTagWg) $w.nameTag
}

proc bbrdUpdate {percent} {
    global ctrlVals

    # Display the bitmap

    if {($ctrlVals(numBbrd) > 0) && ($percent > $ctrlVals(bbrdElapse))} {
        set w $ctrlVals(volatileFrm)
        incr ctrlVals(bbrdElapse) $ctrlVals(displayInt)

        if { ![winfo exists $w.bbrd] } {
            label $w.bbrd -image [ image create photo -palette 3/8/5 \
                                 -file [ lrange $ctrlVals(bbrdList) 0 0 ]]
            pack $w.bbrd -fill both -expand true
        } else {
            $w.bbrd configure -image [ image create photo -palette 3/8/5 \
                            -file [ lrange $ctrlVals(bbrdList) 0 0 ]]
        }

        set ctrlVals(bbrdList) [ lreplace $ctrlVals(bbrdList) 0 0 ]
        set ctrlVals(numBbrd) [llength $ctrlVals(bbrdList)]
    }
}

proc meterUpdate {percent tag} {
    global ctrlVals
  
    setWidth $ctrlVals(meterWg) $percent
    $ctrlVals(meterTagWg) config -text [fileNameAppreviate $tag]
    update
}

proc constructPages {mode} {
    global ctrlVals
    global setupVals

    switch "$mode" {
        license {
            set ctrlVals(pageList) { 
                welcome registration destDir wlmdDetect licenseChoice
                remoteLicenseHost licEmail licCall licenseKey licenseFinish 
            }

            cdromDescSet [strTableGet 1261_LICENSE]           
        }
        default {
            set ctrlVals(pageList) { 
                welcome privilege registration destDir compSelect permission 
                filesCopy libUpdate remoteRegistryHost finish 
            }

            if {[setupId effective userid] != 0} {
                pageRemove "privilege"
            }
        }
    }
    set ctrlVals(currPage) [lindex $ctrlVals(pageList) 0]
    set ctrlVals(pageListBack) $ctrlVals(pageList)
}


proc messageBox {msg} {
    tk_dialog .setup "Setup" $msg info 0 OK
}

# This is a modified version of tk_dialog to make font consistency

proc tk_dialog {w title text bitmap default args} {
    global tkPriv
    global ctrlVals

    # 1. Create the top-level window and divide it into top
    # and bottom parts.

    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $title
    wm iconname $w Setup
    wm protocol $w WM_DELETE_WINDOW { }
    wm transient $w [winfo toplevel [winfo parent $w]]
    frame $w.top -relief raised -bd 1
    pack $w.top -side top -fill both
    frame $w.bot -relief raised -bd 1
    pack $w.bot -side bottom -fill both

    # 2. Fill the top part with bitmap and message.

    labelCreate $w.msg $text
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 13 -pady 9

    if {$bitmap != ""} {
        label $w.bitmap -bitmap $bitmap
        pack $w.bitmap -in $w.top -side left -padx 13 -pady 9
    }

    # 3. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $args {
        button $w.button$i -text $but -font $ctrlVals(bldFont) \
                       -command "set tkPriv(button) $i" 
        if {$i == $default} {
            frame $w.default -relief sunken -bd 1
            raise $w.button$i $w.default
            pack $w.default -in $w.bot -side left -expand 1 -padx 13 -pady 9
            pack $w.button$i -in $w.default -padx 9 -pady 9
            bind $w <Return> "$w.button$i flash; set tkPriv(button) $i"
        } else {
            pack $w.button$i -in $w.bot -side left -expand 1 \
                -padx 13 -pady 9
        }
        incr i
    }

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
        - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
        - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # 5. Set a grab and claim the focus too.

    set oldFocus [focus]
    catch {grab $w}
    tkwait visibility $w
    
    if {$default >= 0} {
        focus $w.button$default
    } else {
        focus $w
    }

    # 6. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.

    tkwait variable tkPriv(button)
    catch {focus $oldFocus}
    catch {grab release $w}
    destroy $w
    return $tkPriv(button)
}

proc dialog {type title msg bitmap default} {
    switch $type {
        ow_owall_ig_igall {
            return [tk_dialog .setup $title $msg $bitmap $default \
                    Overwrite {Overwrite All} Ignore {Ignore All}]
        }
        re_ig_cancel {
            return [tk_dialog .setup $title $msg $bitmap $default \
                Retry Ignore Cancel]
        }
        ok_cancel {
            return [tk_dialog .setup $title $msg $bitmap $default \
                Ok Cancel]
        }
    }
}

proc globalInit {} {
    global setupVals env

    source $env(CD_ROOT)/RESOURCE/TCL/GLOBAL.TCL
    set setupVals(errorCount) 0
    set setupVals(warnCount) 0
    set setupVals(uninstFile) ""
    set setupVals(licenseKeyList) {}
    set setupVals(profile) ""
    set setupVals(windLmHostHome) ""

    if [info exists env(HOME)] {
        set setupVals(profile) $env(HOME)/.wind/installProfile.tcl
        set setupVals(windLmHostHome) $env(HOME)/.wind/license
    }
    
    set setupVals(licAction) remote
    windHostTypeSet $env(WIND_HOST_TYPE)
    
    if [catch {destDirSet $env(WIND_BASE)} error] {
       destDirSet /usr/wind
    }
    
    cdromZipDirSet [cdromRootDirGet]/WIND
}

proc tkInit {} {
    global ctrlVals

    set ctrlVals(screenWidth) [winfo screenwidth .]
    set ctrlVals(screenHeight) [winfo screenheight .]
    set ctrlVals(dlgWidth) 500
    set ctrlVals(dlgHeight) 380
    set ctrlVals(dlgImage) [image create photo -palette 3/8/5 \
        -file [cdromRootDirGet]/RESOURCE/BITMAPS/DIALOG.PPM]
    set ctrlVals(volatileFrm) .volatileFrm
    
    #
    # Find the appropriate font
    #
    button .test -text Test 
    set ctrlVals(bldFont) [findFont .test bold]
    set ctrlVals(textFont) [findFont .test]
    set ctrlVals(smallFont) [findFont .test medium {12}]
    catch {destroy .test}
    
    set ctrlVals(dlgIndex) 1
    set ctrlVals(dlgIndexMax) 10
    set ctrlVals(dlgPos) [format "%sx%s+%s+%s" \
         $ctrlVals(dlgWidth) $ctrlVals(dlgHeight)\
             [expr ($ctrlVals(screenWidth)/2) - ($ctrlVals(dlgWidth)/2)]\
             [expr ($ctrlVals(screenHeight)/2) - ($ctrlVals(dlgHeight)/2)]]
    
    set ctrlVals(mtrPos) [format "%sx%s+%s+%s" 333 66 \
                [expr $ctrlVals(screenWidth) - 353] \
                [expr $ctrlVals(screenHeight) - 86]]
    
    if {[winfo depth .] > 1} {
        set ctrlVals(blinkBg) "#ce5555"
        set ctrlVals(mainBg) "#ccf"
        set ctrlVals(secondBg) "#bbf"
    } else {
        set ctrlVals(blinkBg) "black"
        set ctrlVals(mainBg) gray80
        set ctrlVals(secondBg) gray60
    }
    
    option add *background $ctrlVals(mainBg)
    option add *activeBackground $ctrlVals(secondBg)
    option add *entry*background $ctrlVals(secondBg)
    option add *selectForeground $ctrlVals(mainBg)
    option add *selectBackground black 
}

proc beginWaitCursor {{control .bitmap}} {
    global saveCursor
 
    catch {grab $control}
    set saveCursor [. cget -cursor]
    . config -cursor {watch black white}
}

proc endWaitCursor {{control .bitmap}} {
    global saveCursor

    for {set i 0} {$i < 5} {incr i} {update}
    catch {grab release $control}
    . config -cursor $saveCursor
}

#
# Modifying the Button class to get the selection effect
#
# the leading + in the following body allows to
# append this binding to the list of existing
# one for Button class.
#
# Without this +, all the existing bindings for
# class Button would be lost.
#

bind Button <Button-1> {+
    global selection

    # %W stands for the path of the clicked widget

    if [regexp {^.*pick.canvas.*$} %W] {
        # Ok, the clicked button was in the canvas

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

        %W config -bg $ctrlVals(secondBg)
        set selection %W
    }
}

# Entry point of the Setup program.

globalInit
instTypeSet [lindex $argv 0]

catch {source $setupVals(profile)}
set setupVals(prevInstKey) [instKeyGet]

source [cdromRootDirGet]/RESOURCE/TCL/MESSAGES.TCL
source [cdromRootDirGet]/RESOURCE/TCL/INSTALL.TCL
source [cdromRootDirGet]/RESOURCE/TCL/BROWSE.TCL
source [cdromRootDirGet]/RESOURCE/TCL/FSPACE.TCL
source [cdromRootDirGet]/RESOURCE/TCL/CONFIG.TCL

tkInit

constructPages [instTypeGet]
pageCreate($ctrlVals(currPage))