wizard.tcl

Linux下的MSN聊天程序源码

		return $stepWidgets($step,$node)
	    }

	    ## See if a widget exists on the global level.
	    if {![info exists widgets($node)]} {
		return -code error "item \"$node\" does not exist"
	    }
	    return $widgets($node)
	}

	default {
	    set err [BWidget::badOptionString option $command [list get set]]
	    return -code error $err
	}
    }
}


proc Wizard::variable { path step option } {
    set item $path.$step
    return [Widget::varForOption $item $option]
}


proc Wizard::branch { path {node "current"} } {
    Widget::getVariable $path data
    if {[string equal $node "current"]} { set item [$path step current] }
    if {[string equal $node ""]} { return "root" }
    if {[info exists data($node,branch)]} { return $data($node,branch) }
    return -code error "item \"$node\" does not exist"
}


proc Wizard::traverse { path node } {
    Widget::getVariable $path items

    if {$node == "root"} { return 1 }

    if {![_is_branch $path $node]} {
        return -code error "branch \"$node\" does not exist"
    }

    set cmd [Widget::cget $items($node) -command]
    if {[string equal $cmd ""]} { return 1 }
    return [uplevel #0 $cmd]
}


proc Wizard::exists { path item } {
    Widget::getVariable $path items
    return [info exists items($item)]
}


proc Wizard::createStep { path item {delete 0} } {
    Widget::getVariable $path data
    Widget::getVariable $path items
    Widget::getVariable $path steps

    if {![_is_step $path $item]} { return }

    if {$delete} {
        if {[$path.steps exists $item]} {
            $path.steps delete $item
        }
        if {[info exists data($item,realized)]} {
            unset data($item,realized)
        }
    }

    if {![info exists data($item,realized)]} {
        ## Eval the global createcommand if we have one, appending the item.
        set cmd [Widget::cget $path -createcommand]
        if {![string equal $cmd ""]} {
            uplevel #0 $cmd [list $item]
        }

        ## Eval this item's createcommand if we have one.
        set cmd [Widget::cget $items($item) -createcommand]
        if {![string equal $cmd ""]} {
            uplevel #0 $cmd
        }

        set data($item,realized) 1
    }

    return
}


proc Wizard::getoption { path item option } {
    Widget::getVariable $path items
    return [Widget::getOption $option "" $path $items($item)]
}


proc Wizard::reorder { path parent nodes } {
    Widget::getVariable $path branches
    set branches($parent) $nodes
}


proc Wizard::_insert_button { path idx node args } {
    Widget::getVariable $path data
    Widget::getVariable $path items
    Widget::getVariable $path buttons
    Widget::getVariable $path widgets

    set buttons($node) 1
    set widgets($node) [eval $path.buttons insert $idx $args]
    set item   [string map [list $path.buttons.b {}] $widgets($node)]
    set items($node) $item
    return $widgets($node)
}


proc Wizard::_insert_step { path idx branch node args } {
    Widget::getVariable $path data
    Widget::getVariable $path steps
    Widget::getVariable $path items
    Widget::getVariable $path widgets
    Widget::getVariable $path branches

    set steps($node) 1
    lappend data(steps) $node
    set data($node,branch) $branch
    if {$idx == "end"} {
        lappend branches($branch) $node
    } else {
	set branches($branch) [linsert $branches($branch) $idx $node]
    }

    set items($node) $path.$node
    Widget::init Wizard::Step $items($node) $args
    set widgets($node) [$path.steps add $node]
    if {[Widget::cget $items($node) -create]} { $path createStep $node }
    return $widgets($node)
}


proc Wizard::_insert_branch { path idx branch node args } {
    Widget::getVariable $path data
    Widget::getVariable $path items
    Widget::getVariable $path branches

    set branches($node)    [list]
    lappend data(branches) $node
    set data($node,branch) $branch
    if {$idx == "end"} {
        lappend branches($branch) $node
    } else {
        set branches($branch) [linsert $branches($branch) $idx $node]
    }

    set items($node) $path.$node
    Widget::init Wizard::Branch $items($node) $args
}


proc Wizard::_is_step { path node } {
    Widget::getVariable $path steps
    return [info exists steps($node)]
}


proc Wizard::_is_branch { path node } {
    Widget::getVariable $path branches
    return [info exists branches($node)]
}


# ------------------------------------------------------------------------------
#  Command Wizard::_destroy
# ------------------------------------------------------------------------------
proc Wizard::_destroy { path } {
    Widget::destroy $path
}


proc SimpleWizard { path args } {
    option add *WizLayoutSimple*Label.padX                5    interactive
    option add *WizLayoutSimple*Label.anchor              nw   interactive
    option add *WizLayoutSimple*Label.justify             left interactive
    option add *WizLayoutSimple*Label.borderWidth         0    interactive
    option add *WizLayoutSimple*Label.highlightThickness  0    interactive

    set cmd [list Wizard::layout::simple $path]
    return [eval [list Wizard $path] $args [list -createcommand $cmd]]
}


proc ClassicWizard { path args } {
    option add *WizLayoutClassic*Label.padX                5    interactive
    option add *WizLayoutClassic*Label.anchor              nw   interactive
    option add *WizLayoutClassic*Label.justify             left interactive
    option add *WizLayoutClassic*Label.borderWidth         0    interactive
    option add *WizLayoutClassic*Label.highlightThickness  0    interactive

    set cmd [list Wizard::layout::classic $path]
    return [eval [list Wizard $path] $args [list -createcommand $cmd]]
}


proc Wizard::layout::simple { wizard step } {
    set frame [$wizard widgets get $step]

    set layout [$wizard widgets set layout -widget $frame.layout -step $step]

    foreach w [list titleframe pretext posttext clientArea] {
	set $w [$wizard widgets set $w -widget $layout.$w -step $step]
    }

    foreach w [list title subtitle icon] {
	set $w [$wizard widgets set $w -widget $titleframe.$w -step $step]
    }

    frame $layout -class WizLayoutSimple

    pack $layout -expand 1 -fill both

    # Client area. This is where the caller places its widgets.
    frame $clientArea -bd 8 -relief flat

    Separator $layout.sep1 -relief groove -orient horizontal

    # title and subtitle and icon
    frame $titleframe -bd 4 -relief flat -background white
    label $title -background white -textvariable [$wizard variable $step -text1]
    label $subtitle -height 2 -background white -padx 15 -width 40 \
    	-textvariable [$wizard variable $step -text2]

    label $icon -borderwidth 0 -background white -anchor c
    set iconImage [$wizard getoption $step -icon]
    if {![string equal $iconImage ""]} { $icon configure -image $iconImage }

    set labelfont [font actual [$title cget -font]]
    $title configure -font [concat $labelfont -weight bold]

    # put the title, subtitle and icon inside the frame we've built for them
    grid $title    -in $titleframe -row 0 -column 0 -sticky nsew
    grid $subtitle -in $titleframe -row 1 -column 0 -sticky nsew
    grid $icon     -in $titleframe -row 0 -column 1 -rowspan 2 -padx 8
    grid columnconfigure $titleframe 0 -weight 1
    grid columnconfigure $titleframe 1 -weight 0

    # pre and post text.
    label $pretext  -textvariable [$wizard variable $step -text3]
    label $posttext -textvariable [$wizard variable $step -text4]

    # when our label widgets change size we want to reset the
    # wraplength to that same size.
    foreach widget {title subtitle pretext posttext} {
	bind [set $widget] <Configure> {
            # yeah, I know this looks weird having two after idle's, but
            # it helps prevent the geometry manager getting into a tight
            # loop under certain circumstances
            #
            # note that subtracting 10 is just a somewhat arbitrary number
            # to provide a little padding...
            after idle {after idle {%W configure -wraplength [expr {%w -10}]}}
        }
    }

    grid $titleframe  -row 0 -column 0 -sticky nsew -padx 0
    grid $layout.sep1 -row 1 -sticky ew 
    grid $pretext     -row 2 -sticky nsew -padx 8 -pady 8
    grid $clientArea  -row 3 -sticky nsew -padx 8 -pady 8
    grid $posttext    -row 4 -sticky nsew -padx 8 -pady 8

    grid columnconfigure $layout 0 -weight 1
    grid rowconfigure    $layout 0 -weight 0
    grid rowconfigure    $layout 1 -weight 0
    grid rowconfigure    $layout 2 -weight 0
    grid rowconfigure    $layout 3 -weight 1
    grid rowconfigure    $layout 4 -weight 0
}

proc Wizard::layout::classic { wizard step } {
    set frame [$wizard widgets get $step]

    set layout [$wizard widgets set layout -widget $frame.layout -step $step]
    foreach w [list title subtitle icon pretext posttext clientArea] {
	set $w [$wizard widgets set $w -widget $layout.$w -step $step]
    }

    frame $layout -class WizLayoutClassic

    pack $layout -expand 1 -fill both

    # Client area. This is where the caller places its widgets.
    frame $clientArea -bd 8 -relief flat
    
    Separator $layout.sep1 -relief groove -orient vertical

    # title and subtitle
    label $title    -textvariable [$wizard variable $step -text1]
    label $subtitle -textvariable [$wizard variable $step -text2] -height 2

    array set labelfont [font actual [$title cget -font]]
    incr labelfont(-size) 6
    set  labelfont(-weight) bold
    $title configure -font [array get labelfont]

    # pre and post text. 
    label $pretext  -textvariable [$wizard variable $step -text3]
    label $posttext -textvariable [$wizard variable $step -text4]

    # when our label widgets change size we want to reset the
    # wraplength to that same size.
    foreach widget {title subtitle pretext posttext} {
        bind [set $widget] <Configure> {
            # yeah, I know this looks weird having two after idle's, but
            # it helps prevent the geometry manager getting into a tight
            # loop under certain circumstances
            #
            # note that subtracting 10 is just a somewhat arbitrary number
            # to provide a little padding...
            after idle {after idle {%W configure -wraplength [expr {%w -10}]}}
        }
    }

    label $icon -borderwidth 1 -relief sunken -background white \
        -anchor c -width 96 -image Wizard::none
    set iconImage [$wizard getoption $step -icon]
    if {![string equal $iconImage ""]} { $icon configure -image $iconImage }

    grid $icon       -row 0 -column 0 -sticky nsew -padx 8 -pady 8 -rowspan 5
    grid $title      -row 0 -column 1 -sticky ew   -padx 8 -pady 8
    grid $subtitle   -row 1 -column 1 -sticky ew   -padx 8 -pady 8
    grid $pretext    -row 2 -column 1 -sticky ew   -padx 8
    grid $clientArea -row 3 -column 1 -sticky nsew -padx 8
    grid $posttext   -row 4 -column 1 -sticky ew   -padx 8 -pady 24

    grid columnconfigure $layout 0 -weight 0
    grid columnconfigure $layout 1 -weight 1

    grid rowconfigure    $layout 0 -weight 0
    grid rowconfigure    $layout 1 -weight 0
    grid rowconfigure    $layout 2 -weight 0
    grid rowconfigure    $layout 3 -weight 1
    grid rowconfigure    $layout 4 -weight 0
}