wizard.tcl

Linux下的MSN聊天程序源码

# ------------------------------------------------------------------------------
#  wizard.tcl
#
# ------------------------------------------------------------------------------
#  Index of commands:
#
#   Public commands
#     - Wizard::create
#     - Wizard::configure
#     - Wizard::cget
#
#   Private commands (event bindings)
#     - Wizard::_destroy
# ------------------------------------------------------------------------------

namespace eval Wizard {
    Widget::define Wizard wizard ButtonBox Separator PagesManager

    namespace eval Step {
	Widget::declare Wizard::Step {
            {-type            String     "step"   1  }
	    {-data            String     ""       0  }
	    {-title           String     ""       0  }
	    {-default         String     "next"   0  }
	    {-text1           String     ""       0  }
	    {-text2           String     ""       0  }
	    {-text3           String     ""       0  }
	    {-text4           String     ""       0  }
	    {-text5           String     ""       0  }
	    {-icon            String     ""       0  }
	    {-image           String     ""       0  }
	    {-bitmap          String     ""       0  }
	    {-iconbitmap      String     ""       0  }

            {-create          Boolean    "0"      1  }
            {-appendorder     Boolean    "1"      0  }

            {-nexttext        String     "Next >" 0  }
            {-backtext        String     "< Back" 0  }
            {-helptext        String     "Help"   0  }
            {-canceltext      String     "Cancel" 0  }
            {-finishtext      String     "Finish" 0  }
            {-separatortext   String     ""       0  }

            {-createcommand   String     ""       0  }
            {-raisecommand    String     ""       0  }
	    {-nextcommand     String     ""       0  }
	    {-backcommand     String     ""       0  }
	    {-helpcommand     String     ""       0  }
	    {-cancelcommand   String     ""       0  }
	    {-finishcommand   String     ""       0  }

	}
    }

    namespace eval Branch {
	Widget::declare Wizard::Branch {
            {-type            String     "branch" 1  }
            {-command         String     ""       0  }
            {-action          Enum       "merge"  0  {merge terminate} }
        }
    }

    namespace eval Widget {
	Widget::declare Wizard::Widget {
            {-type            String     "widget" 1  }
            {-step            String     ""       1  }
            {-widget          String     ""       1  }
	}
    }

    namespace eval layout {}

    Widget::tkinclude Wizard frame :cmd \
    	include    { -width -height -background -foreground -cursor }

    Widget::declare Wizard {
   	{-type            Enum       "dialog" 1 {dialog frame} }
   	{-width           TkResource "450"    0 frame}
	{-height          TkResource "300"    0 frame}
	{-relief          TkResource "flat"   0 frame}
	{-borderwidth     TkResource "0"      0 frame}
	{-background      TkResource ""       0 frame}
	{-foreground      String     "black"  0      }
	{-title           String     "Wizard" 0      }

	{-autobuttons     Boolean    "1"      0      }
	{-helpbutton      Boolean    "0"      1      }
	{-finishbutton    Boolean    "0"      1      }
        {-resizable       String     "0 0"    0      }
	{-separator       Boolean    "1"      1      }
        {-parent          String     "."      1      }
        {-transient       Boolean    "1"      1      }
        {-place           Enum       "center" 1
                                     {none center left right above below}}

        {-icon            String     ""       0      }
        {-image           String     ""       0      }
	{-bitmap          String     ""       0      }
	{-iconbitmap      String     ""       0      }
        {-raisecommand    String     ""       0      }
        {-createcommand   String     ""       0      }
        {-separatortext   String     ""       0      }

        {-fg              Synonym    -foreground     }
        {-bg              Synonym    -background     }
        {-bd              Synonym    -borderwidth    }
    }

    image create photo Wizard::none

    Widget::addmap Wizard "" :cmd { -background {} -relief {} -borderwidth {} }

    Widget::addmap Wizard "" .steps { -width {} -height {} }

    bind Wizard <Destroy> [list Wizard::_destroy %W]
}


# ------------------------------------------------------------------------------
#  Command Wizard::create
# ------------------------------------------------------------------------------
proc Wizard::create { path args } {
    array set maps [list Wizard {} :cmd {}]
    array set maps [Widget::parseArgs Wizard $args]

    Widget::initFromODB Wizard $path $maps(Wizard)

    Widget::getVariable $path data
    Widget::getVariable $path branches

    array set data {
        steps   ""
        buttons ""
        order   ""
	current ""
    }

    array set branches {
        root    ""
    }

    set frame $path

    set type [Widget::cget $path -type]

    if {[string equal $type "dialog"]} {
        set top $path
        eval [list toplevel $path] $maps(:cmd) -class Wizard
        wm withdraw   $path
        wm protocol   $path WM_DELETE_WINDOW [list $path cancel]
        if {[Widget::cget $path -transient]} {
	    wm transient  $path [Widget::cget $path -parent]
        }
        eval wm resizable $path [Widget::cget $path -resizable]

        bind $path <Escape>         [list $path cancel]
        bind $path <<WizardFinish>> [list destroy $path]
        bind $path <<WizardCancel>> [list destroy $path]
    } else {
        set top [winfo toplevel $path]
        eval [list frame $path] $maps(:cmd) -class Wizard
    }

    wm title $top [Widget::cget $path -title]

    PagesManager $path.steps
    pack $path.steps -expand 1 -fill both

    widgets $path set steps -widget $path.steps

    if {[Widget::cget $path -separator]} {
        frame $path.separator
        pack $path.separator -fill x

        label $path.separator.l -text [Widget::cget $path -separatortext]
        pack  $path.separator.l -side left

        Separator $path.separator.s -orient horizontal
        pack $path.separator.s -side left -expand 1 -fill x -pady 2

	widgets $path set separator      -widget $path.separator.s
	widgets $path set separatortext  -widget $path.separator.l
	widgets $path set separatorframe -widget $path.separator
    }

    ButtonBox $path.buttons -spacing 2 -homogeneous 1
    pack $path.buttons -anchor se -padx 10 -pady 5

    widgets $path set buttons -widget $path.buttons

    insert $path button end back  -text "< Back" -command "$path back" -width 12
    insert $path button end next  -text "Next >" -command "$path next"
    if {[Widget::cget $path -finishbutton]} {
	insert $path button end finish -text "Finish" -command "$path finish"
    }
    insert $path button end cancel -text "Cancel" -command "$path cancel"

    if {[Widget::cget $path -helpbutton]} {
	$path.buttons configure -spacing 10
	insert $path button 0 help -text "Help" -command "$path help"
	$path.buttons configure -spacing 2
    }

    return [Widget::create Wizard $path]
}


# ------------------------------------------------------------------------------
#  Command Wizard::configure
# ------------------------------------------------------------------------------
proc Wizard::configure { path args } {
    set res [Widget::configure $path $args]

    if {[Widget::hasChanged $path -title title]} {
	wm title [winfo toplevel $path] $title
    }

    if {[Widget::hasChanged $path -resizable resize]} {
	eval wm resizable [winfo toplevel $path] $resize
    }

    return $res
}


# ------------------------------------------------------------------------------
#  Command Wizard::cget
# ------------------------------------------------------------------------------
proc Wizard::cget { path option } {
    return [Widget::cget $path $option]
}


proc Wizard::itemcget { path item option } {
    Widget::getVariable $path items
    Widget::getVariable $path steps
    Widget::getVariable $path buttons
    Widget::getVariable $path widgets

    if {![exists $path $item]} {
	## It's not an item.  Just pass the configure to the widget.
	set item [$path widgets get $item]
	return [eval $item configure $args] 
    }

    if {[_is_step $path $item]} {
        ## It's a step
        return [Widget::cget $items($item) $option]
    }

    if {[_is_branch $path $item]} {
        ## It's a branch
        return [Widget::cget $items($item) $option]
    }

    if {[info exists buttons($item)]} {
        ## It's a button
        return [$path.buttons itemcget $items($item) $option]
    }

    return -code error "item \"$item\" does not exist"
}


proc Wizard::itemconfigure { path item args } {
    Widget::getVariable $path items
    Widget::getVariable $path steps
    Widget::getVariable $path buttons
    Widget::getVariable $path widgets

    if {![exists $path $item]} {
	## It's not an item.  Just pass the configure to the widget.
	set item [$path widgets get $item]
	return [eval $item configure $args] 
    }

    if {[info exists steps($item)]} {
        ## It's a step.
        set res [Widget::configure $items($item) $args]

	if {$item == [$path step current]} {
	    if {[Widget::hasChanged $items($item) -title title]} {
		wm title [winfo toplevel $path] $title
	    }
	}

	return $res
    }

    if {[_is_branch $path $item]} {
        ## It's a branch
        return [Widget::configure $items($item) $args]
    }

    if {[info exists buttons($item)]} {
        ## It's a button.
        return [eval $path.buttons itemconfigure [list $items($item)] $args]
    }

    return -code error "item \"$item\" does not exist"
}


proc Wizard::show { path } {
    wm deiconify [winfo toplevel $path]
}


proc Wizard::invoke { path button } {
    Widget::getVariable $path buttons
    if {![info exists buttons($button)]} {
        return -code error "button \"$button\" does not exist"
    }
    [$path widgets get $button] invoke
}


proc Wizard::insert { path type idx args } {
    Widget::getVariable $path items
    Widget::getVariable $path widgets
    Widget::getVariable $path branches

    switch -- $type {
        "button" {
            set node [lindex $args 0]
        }

        "step" - "branch" {
            set node   [lindex $args 1]
            set branch [lindex $args 0]

            if {![info exists branches($branch)]} {
                return -code error "branch \"$branch\" does not exist"
            }
	}

	default {
	    set types [list button branch step]
	    set err [BWidget::badOptionString option $type $types]
	    return -code error $err
	}
    }