1# ------------------------------------------------------------------------------ 2# wizard.tcl 3# 4# ------------------------------------------------------------------------------ 5# Index of commands: 6# 7# Public commands 8# - Wizard::create 9# - Wizard::configure 10# - Wizard::cget 11# 12# Private commands (event bindings) 13# - Wizard::_destroy 14# ------------------------------------------------------------------------------ 15 16namespace eval Wizard { 17 Widget::define Wizard wizard ButtonBox Separator PagesManager 18 19 namespace eval Step { 20 Widget::declare Wizard::Step { 21 {-type String "step" 1 } 22 {-data String "" 0 } 23 {-title String "" 0 } 24 {-default String "next" 0 } 25 {-text1 String "" 0 } 26 {-text2 String "" 0 } 27 {-text3 String "" 0 } 28 {-text4 String "" 0 } 29 {-text5 String "" 0 } 30 {-icon String "" 0 } 31 {-image String "" 0 } 32 {-bitmap String "" 0 } 33 {-iconbitmap String "" 0 } 34 35 {-create Boolean "0" 1 } 36 {-appendorder Boolean "1" 0 } 37 38 {-nexttext String "Next >" 0 } 39 {-backtext String "< Back" 0 } 40 {-helptext String "Help" 0 } 41 {-canceltext String "Cancel" 0 } 42 {-finishtext String "Finish" 0 } 43 {-separatortext String "" 0 } 44 45 {-createcommand String "" 0 } 46 {-raisecommand String "" 0 } 47 {-nextcommand String "" 0 } 48 {-backcommand String "" 0 } 49 {-helpcommand String "" 0 } 50 {-cancelcommand String "" 0 } 51 {-finishcommand String "" 0 } 52 53 } 54 } 55 56 namespace eval Branch { 57 Widget::declare Wizard::Branch { 58 {-type String "branch" 1 } 59 {-command String "" 0 } 60 {-action Enum "merge" 0 {merge terminate} } 61 } 62 } 63 64 namespace eval Widget { 65 Widget::declare Wizard::Widget { 66 {-type String "widget" 1 } 67 {-step String "" 1 } 68 {-widget String "" 1 } 69 } 70 } 71 72 namespace eval layout {} 73 74 Widget::tkinclude Wizard frame :cmd \ 75 include { -width -height -background -foreground -cursor } 76 77 Widget::declare Wizard { 78 {-type Enum "dialog" 1 {dialog frame} } 79 {-width TkResource "450" 0 frame} 80 {-height TkResource "300" 0 frame} 81 {-relief TkResource "flat" 0 frame} 82 {-borderwidth TkResource "0" 0 frame} 83 {-background TkResource "" 0 frame} 84 {-foreground String "black" 0 } 85 {-title String "Wizard" 0 } 86 87 {-autobuttons Boolean "1" 0 } 88 {-helpbutton Boolean "0" 1 } 89 {-finishbutton Boolean "0" 1 } 90 {-resizable String "0 0" 0 } 91 {-separator Boolean "1" 1 } 92 {-parent String "." 1 } 93 {-transient Boolean "1" 1 } 94 {-place Enum "center" 1 95 {none center left right above below}} 96 97 {-icon String "" 0 } 98 {-image String "" 0 } 99 {-bitmap String "" 0 } 100 {-iconbitmap String "" 0 } 101 {-raisecommand String "" 0 } 102 {-createcommand String "" 0 } 103 {-separatortext String "" 0 } 104 105 {-fg Synonym -foreground } 106 {-bg Synonym -background } 107 {-bd Synonym -borderwidth } 108 } 109 110 image create photo Wizard::none 111 112 Widget::addmap Wizard "" :cmd { -background {} -relief {} -borderwidth {} } 113 114 Widget::addmap Wizard "" .steps { -width {} -height {} } 115 116 bind Wizard <Destroy> [list Wizard::_destroy %W] 117} 118 119 120# ------------------------------------------------------------------------------ 121# Command Wizard::create 122# ------------------------------------------------------------------------------ 123proc Wizard::create { path args } { 124 array set maps [list Wizard {} :cmd {}] 125 array set maps [Widget::parseArgs Wizard $args] 126 127 Widget::initFromODB Wizard $path $maps(Wizard) 128 129 Widget::getVariable $path data 130 Widget::getVariable $path branches 131 132 array set data { 133 steps "" 134 buttons "" 135 order "" 136 current "" 137 } 138 139 array set branches { 140 root "" 141 } 142 143 set frame $path 144 145 set type [Widget::cget $path -type] 146 147 if {[string equal $type "dialog"]} { 148 set top $path 149 eval [list toplevel $path] $maps(:cmd) -class Wizard 150 wm withdraw $path 151 wm protocol $path WM_DELETE_WINDOW [list $path cancel] 152 if {[Widget::cget $path -transient]} { 153 wm transient $path [Widget::cget $path -parent] 154 } 155 eval wm resizable $path [Widget::cget $path -resizable] 156 157 bind $path <Escape> [list $path cancel] 158 bind $path <<WizardFinish>> [list destroy $path] 159 bind $path <<WizardCancel>> [list destroy $path] 160 } else { 161 set top [winfo toplevel $path] 162 eval [list frame $path] $maps(:cmd) -class Wizard 163 } 164 165 wm title $top [Widget::cget $path -title] 166 167 PagesManager $path.steps 168 pack $path.steps -expand 1 -fill both 169 170 widgets $path set steps -widget $path.steps 171 172 if {[Widget::cget $path -separator]} { 173 frame $path.separator 174 pack $path.separator -fill x 175 176 label $path.separator.l -text [Widget::cget $path -separatortext] 177 pack $path.separator.l -side left 178 179 Separator $path.separator.s -orient horizontal 180 pack $path.separator.s -side left -expand 1 -fill x -pady 2 181 182 widgets $path set separator -widget $path.separator.s 183 widgets $path set separatortext -widget $path.separator.l 184 widgets $path set separatorframe -widget $path.separator 185 } 186 187 ButtonBox $path.buttons -spacing 2 -homogeneous 1 188 pack $path.buttons -anchor se -padx 10 -pady 5 189 190 widgets $path set buttons -widget $path.buttons 191 192 insert $path button end back -text "< Back" -command "$path back" -width 12 193 insert $path button end next -text "Next >" -command "$path next" 194 if {[Widget::cget $path -finishbutton]} { 195 insert $path button end finish -text "Finish" -command "$path finish" 196 } 197 insert $path button end cancel -text "Cancel" -command "$path cancel" 198 199 if {[Widget::cget $path -helpbutton]} { 200 $path.buttons configure -spacing 10 201 insert $path button 0 help -text "Help" -command "$path help" 202 $path.buttons configure -spacing 2 203 } 204 205 return [Widget::create Wizard $path] 206} 207 208 209# ------------------------------------------------------------------------------ 210# Command Wizard::configure 211# ------------------------------------------------------------------------------ 212proc Wizard::configure { path args } { 213 set res [Widget::configure $path $args] 214 215 if {[Widget::hasChanged $path -title title]} { 216 wm title [winfo toplevel $path] $title 217 } 218 219 if {[Widget::hasChanged $path -resizable resize]} { 220 eval wm resizable [winfo toplevel $path] $resize 221 } 222 223 return $res 224} 225 226 227# ------------------------------------------------------------------------------ 228# Command Wizard::cget 229# ------------------------------------------------------------------------------ 230proc Wizard::cget { path option } { 231 return [Widget::cget $path $option] 232} 233 234 235proc Wizard::itemcget { path item option } { 236 Widget::getVariable $path items 237 Widget::getVariable $path steps 238 Widget::getVariable $path buttons 239 Widget::getVariable $path widgets 240 241 if {![exists $path $item]} { 242 ## It's not an item. Just pass the configure to the widget. 243 set item [$path widgets get $item] 244 return [eval $item configure $args] 245 } 246 247 if {[_is_step $path $item]} { 248 ## It's a step 249 return [Widget::cget $items($item) $option] 250 } 251 252 if {[_is_branch $path $item]} { 253 ## It's a branch 254 return [Widget::cget $items($item) $option] 255 } 256 257 if {[info exists buttons($item)]} { 258 ## It's a button 259 return [$path.buttons itemcget $items($item) $option] 260 } 261 262 return -code error "item \"$item\" does not exist" 263} 264 265 266proc Wizard::itemconfigure { path item args } { 267 Widget::getVariable $path items 268 Widget::getVariable $path steps 269 Widget::getVariable $path buttons 270 Widget::getVariable $path widgets 271 272 if {![exists $path $item]} { 273 ## It's not an item. Just pass the configure to the widget. 274 set item [$path widgets get $item] 275 return [eval $item configure $args] 276 } 277 278 if {[info exists steps($item)]} { 279 ## It's a step. 280 set res [Widget::configure $items($item) $args] 281 282 if {$item == [$path step current]} { 283 if {[Widget::hasChanged $items($item) -title title]} { 284 wm title [winfo toplevel $path] $title 285 } 286 } 287 288 return $res 289 } 290 291 if {[_is_branch $path $item]} { 292 ## It's a branch 293 return [Widget::configure $items($item) $args] 294 } 295 296 if {[info exists buttons($item)]} { 297 ## It's a button. 298 return [eval $path.buttons itemconfigure [list $items($item)] $args] 299 } 300 301 return -code error "item \"$item\" does not exist" 302} 303 304 305proc Wizard::show { path } { 306 wm deiconify [winfo toplevel $path] 307} 308 309 310proc Wizard::invoke { path button } { 311 Widget::getVariable $path buttons 312 if {![info exists buttons($button)]} { 313 return -code error "button \"$button\" does not exist" 314 } 315 [$path widgets get $button] invoke 316} 317 318 319proc Wizard::insert { path type idx args } { 320 Widget::getVariable $path items 321 Widget::getVariable $path widgets 322 Widget::getVariable $path branches 323 324 switch -- $type { 325 "button" { 326 set node [lindex $args 0] 327 } 328 329 "step" - "branch" { 330 set node [lindex $args 1] 331 set branch [lindex $args 0] 332 333 if {![info exists branches($branch)]} { 334 return -code error "branch \"$branch\" does not exist" 335 } 336 } 337 338 default { 339 set types [list button branch step] 340 set err [BWidget::badOptionString option $type $types] 341 return -code error $err 342 } 343 } 344 345 if {[exists $path $node]} { 346 return -code error "item \"$node\" already exists" 347 } 348 349 eval _insert_$type $path $idx $args 350} 351 352 353proc Wizard::back { path } { 354 Widget::getVariable $path data 355 Widget::getVariable $path items 356 set step [$path raise] 357 if {![string equal $step ""]} { 358 set cmd [Widget::cget $items($step) -backcommand] 359 if {![string equal $cmd ""]} { 360 set res [uplevel #0 $cmd] 361 if {!$res} { return } 362 } 363 } 364 365 set data(order) [lreplace $data(order) end end] 366 set item [lindex $data(order) end] 367 368 $path raise $item 369 370 event generate $path <<WizardStep>> 371 event generate $path <<WizardBack>> 372 373 return $item 374} 375 376 377proc Wizard::next { path } { 378 Widget::getVariable $path data 379 Widget::getVariable $path items 380 381 set step [$path raise] 382 if {![string equal $step ""]} { 383 set cmd [Widget::cget $items($step) -nextcommand] 384 if {![string equal $cmd ""]} { 385 set res [uplevel #0 $cmd] 386 if {!$res} { return } 387 } 388 } 389 390 set item [step $path next] 391 392 if {[Widget::cget $items($item) -appendorder]} { 393 lappend data(order) $item 394 } 395 396 $path raise $item 397 398 event generate $path <<WizardStep>> 399 event generate $path <<WizardNext>> 400 401 return $item 402} 403 404 405proc Wizard::cancel { path } { 406 Widget::getVariable $path items 407 set step [$path raise] 408 if {![string equal $step ""]} { 409 set cmd [Widget::cget $items($step) -cancelcommand] 410 if {![string equal $cmd ""]} { 411 set res [uplevel #0 $cmd] 412 if {!$res} { return } 413 } 414 } 415 416 event generate $path <<WizardCancel>> 417} 418 419 420proc Wizard::finish { path } { 421 Widget::getVariable $path items 422 set step [$path raise] 423 if {![string equal $step ""]} { 424 set cmd [Widget::cget $items($step) -finishcommand] 425 if {![string equal $cmd ""]} { 426 set res [uplevel #0 $cmd] 427 if {!$res} { return } 428 } 429 } 430 431 event generate $path <<WizardFinish>> 432} 433 434 435proc Wizard::help { path } { 436 Widget::getVariable $path items 437 set step [$path raise] 438 if {![string equal $step ""]} { 439 set cmd [Widget::cget $items($step) -helpcommand] 440 if {![string equal $cmd ""]} { 441 uplevel #0 $cmd 442 } 443 } 444 445 event generate $path <<WizardHelp>> 446} 447 448 449proc Wizard::step { path node {start ""} {traverse 1} } { 450 Widget::getVariable $path data 451 Widget::getVariable $path items 452 Widget::getVariable $path branches 453 454 if {![string equal $start ""]} { 455 if {![exists $path $start]} { 456 return -code error "item \"$start\" does not exist" 457 } 458 } 459 460 switch -- $node { 461 "current" { 462 set item [$path raise] 463 } 464 465 "end" - "last" { 466 ## Keep looping through 'next' until we hit the end. 467 set item [$path step next] 468 while {![string equal $item ""]} { 469 set last $item 470 set item [$path step next $item] 471 } 472 set item $last 473 } 474 475 "back" - "previous" { 476 if {[string equal $start ""]} { 477 set item [lindex $data(order) end-1] 478 } else { 479 set idx [lsearch $data(order) $start] 480 incr idx -1 481 if {$idx < 0} { return } 482 set item [lindex $data(order) $idx] 483 } 484 } 485 486 "next" { 487 set step [$path raise] 488 if {![string equal $start ""]} { set step $start } 489 490 set branch [$path branch $step] 491 if {$traverse && [_is_branch $path $step]} { 492 ## This step is a branch. Let's figure out where to go next. 493 if {[traverse $path $step]} { 494 ## It's ok to traverse into this branch. 495 ## Set step to null so that we'll end up finding the 496 ## first step in the branch. 497 set branch $step 498 set step "" 499 } 500 } 501 502 set idx [lsearch $branches($branch) $step] 503 incr idx 504 505 set item [lindex $branches($branch) $idx] 506 507 if {$idx >= [llength $branches($branch)]} { 508 ## We've reached the end of this branch. 509 ## If it's the root branch, or this branch terminates we return. 510 if {[string equal $branch "root"] 511 || [Widget::cget $items($branch) -action] == "terminate"} { 512 return 513 } 514 515 ## We want to merge back with our parent branch. 516 set item [step $path next $branch 0] 517 } 518 519 ## If this step is a branch, find the next step after it. 520 if {$traverse && [_is_branch $path $item]} { 521 set item [$path step next $item] 522 } 523 } 524 525 default { 526 if {![exists $path $node]} { 527 return -code error "item \"$node\" does not exist" 528 } 529 set item $node 530 } 531 } 532 533 return $item 534} 535 536 537proc Wizard::nodes { path branch {first ""} {last ""} } { 538 Widget::getVariable $path data 539 Widget::getVariable $path branches 540 if {$first == ""} { return $branches($branch) } 541 if {$last == ""} { return [lindex $branches($branch) $first] } 542 return [lrange $data(steps) $first $last] 543} 544 545 546proc Wizard::index { path item } { 547 Widget::getVariable $path branches 548 set branch [$path branch $item] 549 return [lsearch $branches($branch) $item] 550} 551 552 553proc Wizard::raise { path {item ""} } { 554 Widget::getVariable $path data 555 Widget::getVariable $path items 556 557 set steps $path.steps 558 set buttons $path.buttons 559 560 if {[string equal $item ""]} { return $data(current) } 561 562 $path createStep $item 563 564 ## Eval the global raisecommand if we have one, appending the item. 565 set cmd [Widget::cget $path -raisecommand] 566 if {![string equal $cmd ""]} { 567 uplevel #0 $cmd [list $item] 568 } 569 570 ## Eval this item's raisecommand if we have one. 571 set cmd [Widget::cget $items($item) -raisecommand] 572 if {![string equal $cmd ""]} { 573 uplevel #0 $cmd 574 } 575 576 set title [getoption $path $item -title] 577 wm title [winfo toplevel $path] $title 578 579 if {[Widget::cget $path -separator]} { 580 set txt [getoption $path $item -separatortext] 581 $path itemconfigure separatortext -text $txt 582 } 583 584 set default [Widget::cget $items($item) -default] 585 set button [lsearch $data(buttons) $default] 586 $buttons setfocus $button 587 588 $steps raise $item 589 590 set data(current) $item 591 592 set back [$path step back] 593 set next [$path step next] 594 595 if {[Widget::cget $path -autobuttons]} { 596 set txt [Widget::cget $items($item) -backtext] 597 $path itemconfigure back -text $txt -state normal 598 set txt [Widget::cget $items($item) -nexttext] 599 $path itemconfigure next -text $txt -state normal 600 set txt [Widget::cget $items($item) -canceltext] 601 $path itemconfigure cancel -text $txt -state normal 602 if {[Widget::cget $path -helpbutton]} { 603 set txt [Widget::cget $items($item) -helptext] 604 $path itemconfigure help -text $txt 605 } 606 607 if {[Widget::cget $path -finishbutton]} { 608 set txt [Widget::cget $items($item) -finishtext] 609 $path itemconfigure finish -text $txt -state disabled 610 } 611 612 if {[string equal $back ""]} { 613 $path itemconfigure back -state disabled 614 } 615 616 if {[string equal $next ""]} { 617 if {[Widget::cget $path -finishbutton]} { 618 $path itemconfigure next -state disabled 619 $path itemconfigure finish -state normal 620 } else { 621 set txt [Widget::cget $items($item) -finishtext] 622 $path itemconfigure next -text $txt -command [list $path finish] 623 } 624 $path itemconfigure back -state disabled 625 $path itemconfigure cancel -state disabled 626 } else { 627 set txt [Widget::cget $items($item) -nexttext] 628 $path itemconfigure next -text $txt -command [list $path next] 629 } 630 } 631 632 event generate $path <<WizardStep>> 633 634 if {[string equal $next ""]} { event generate $path <<WizardLastStep>> } 635 if {[string equal $back ""]} { event generate $path <<WizardFirstStep>> } 636 637 return $item 638} 639 640 641proc Wizard::widgets { path command args } { 642 Widget::getVariable $path items 643 Widget::getVariable $path widgets 644 Widget::getVariable $path stepWidgets 645 646 switch -- $command { 647 "set" { 648 set node [lindex $args 0] 649 if {[string equal $node ""]} { 650 set err [BWidget::wrongNumArgsString \ 651 "$path widgets set <name> ?option ..?"] 652 return -code error $err 653 } 654 set args [lreplace $args 0 0] 655 set item $path.#widget#$node 656 657 Widget::init Wizard::Widget $item $args 658 set step [Widget::cget $item -step] 659 set widget [Widget::cget $item -widget] 660 if {[string equal $step ""]} { 661 set widgets($node) $widget 662 } else { 663 set stepWidgets($step,$node) $widget 664 } 665 return $widget 666 } 667 668 "get" { 669 set node [lindex $args 0] 670 if {[string equal $node ""]} { 671 return [array names widgets] 672 } 673 set args [lreplace $args 0 0] 674 675 array set map [list Wizard::Widget {}] 676 array set map [Widget::parseArgs Wizard::Widget $args] 677 array set data $map(Wizard::Widget) 678 679 if {[info exists data(-step)]} { 680 set step $data(-step) 681 } else { 682 set step [$path step current] 683 } 684 685 ## If a widget exists for this step, return it. 686 if {[info exists stepWidgets($step,$node)]} { 687 return $stepWidgets($step,$node) 688 } 689 690 ## See if a widget exists on the global level. 691 if {![info exists widgets($node)]} { 692 return -code error "item \"$node\" does not exist" 693 } 694 return $widgets($node) 695 } 696 697 default { 698 set err [BWidget::badOptionString option $command [list get set]] 699 return -code error $err 700 } 701 } 702} 703 704 705proc Wizard::variable { path step option } { 706 set item $path.$step 707 return [Widget::varForOption $item $option] 708} 709 710 711proc Wizard::branch { path {node "current"} } { 712 Widget::getVariable $path data 713 if {[string equal $node "current"]} { set item [$path step current] } 714 if {[string equal $node ""]} { return "root" } 715 if {[info exists data($node,branch)]} { return $data($node,branch) } 716 return -code error "item \"$node\" does not exist" 717} 718 719 720proc Wizard::traverse { path node } { 721 Widget::getVariable $path items 722 723 if {$node == "root"} { return 1 } 724 725 if {![_is_branch $path $node]} { 726 return -code error "branch \"$node\" does not exist" 727 } 728 729 set cmd [Widget::cget $items($node) -command] 730 if {[string equal $cmd ""]} { return 1 } 731 return [uplevel #0 $cmd] 732} 733 734 735proc Wizard::exists { path item } { 736 Widget::getVariable $path items 737 return [info exists items($item)] 738} 739 740 741proc Wizard::createStep { path item {delete 0} } { 742 Widget::getVariable $path data 743 Widget::getVariable $path items 744 Widget::getVariable $path steps 745 746 if {![_is_step $path $item]} { return } 747 748 if {$delete} { 749 if {[$path.steps exists $item]} { 750 $path.steps delete $item 751 } 752 if {[info exists data($item,realized)]} { 753 unset data($item,realized) 754 } 755 } 756 757 if {![info exists data($item,realized)]} { 758 ## Eval the global createcommand if we have one, appending the item. 759 set cmd [Widget::cget $path -createcommand] 760 if {![string equal $cmd ""]} { 761 uplevel #0 $cmd [list $item] 762 } 763 764 ## Eval this item's createcommand if we have one. 765 set cmd [Widget::cget $items($item) -createcommand] 766 if {![string equal $cmd ""]} { 767 uplevel #0 $cmd 768 } 769 770 set data($item,realized) 1 771 } 772 773 return 774} 775 776 777proc Wizard::getoption { path item option } { 778 Widget::getVariable $path items 779 return [Widget::getOption $option "" $path $items($item)] 780} 781 782 783proc Wizard::reorder { path parent nodes } { 784 Widget::getVariable $path branches 785 set branches($parent) $nodes 786} 787 788 789proc Wizard::_insert_button { path idx node args } { 790 Widget::getVariable $path data 791 Widget::getVariable $path items 792 Widget::getVariable $path buttons 793 Widget::getVariable $path widgets 794 795 set buttons($node) 1 796 set widgets($node) [eval $path.buttons insert $idx $args] 797 set item [string map [list $path.buttons.b {}] $widgets($node)] 798 set items($node) $item 799 return $widgets($node) 800} 801 802 803proc Wizard::_insert_step { path idx branch node args } { 804 Widget::getVariable $path data 805 Widget::getVariable $path steps 806 Widget::getVariable $path items 807 Widget::getVariable $path widgets 808 Widget::getVariable $path branches 809 810 set steps($node) 1 811 lappend data(steps) $node 812 set data($node,branch) $branch 813 if {$idx == "end"} { 814 lappend branches($branch) $node 815 } else { 816 set branches($branch) [linsert $branches($branch) $idx $node] 817 } 818 819 set items($node) $path.$node 820 Widget::init Wizard::Step $items($node) $args 821 set widgets($node) [$path.steps add $node] 822 if {[Widget::cget $items($node) -create]} { $path createStep $node } 823 return $widgets($node) 824} 825 826 827proc Wizard::_insert_branch { path idx branch node args } { 828 Widget::getVariable $path data 829 Widget::getVariable $path items 830 Widget::getVariable $path branches 831 832 set branches($node) [list] 833 lappend data(branches) $node 834 set data($node,branch) $branch 835 if {$idx == "end"} { 836 lappend branches($branch) $node 837 } else { 838 set branches($branch) [linsert $branches($branch) $idx $node] 839 } 840 841 set items($node) $path.$node 842 Widget::init Wizard::Branch $items($node) $args 843} 844 845 846proc Wizard::_is_step { path node } { 847 Widget::getVariable $path steps 848 return [info exists steps($node)] 849} 850 851 852proc Wizard::_is_branch { path node } { 853 Widget::getVariable $path branches 854 return [info exists branches($node)] 855} 856 857 858# ------------------------------------------------------------------------------ 859# Command Wizard::_destroy 860# ------------------------------------------------------------------------------ 861proc Wizard::_destroy { path } { 862 Widget::destroy $path 863} 864 865 866proc SimpleWizard { path args } { 867 option add *WizLayoutSimple*Label.padX 5 interactive 868 option add *WizLayoutSimple*Label.anchor nw interactive 869 option add *WizLayoutSimple*Label.justify left interactive 870 option add *WizLayoutSimple*Label.borderWidth 0 interactive 871 option add *WizLayoutSimple*Label.highlightThickness 0 interactive 872 873 set cmd [list Wizard::layout::simple $path] 874 return [eval [list Wizard $path] $args [list -createcommand $cmd]] 875} 876 877 878proc ClassicWizard { path args } { 879 option add *WizLayoutClassic*Label.padX 5 interactive 880 option add *WizLayoutClassic*Label.anchor nw interactive 881 option add *WizLayoutClassic*Label.justify left interactive 882 option add *WizLayoutClassic*Label.borderWidth 0 interactive 883 option add *WizLayoutClassic*Label.highlightThickness 0 interactive 884 885 set cmd [list Wizard::layout::classic $path] 886 return [eval [list Wizard $path] $args [list -createcommand $cmd]] 887} 888 889 890proc Wizard::layout::simple { wizard step } { 891 set frame [$wizard widgets get $step] 892 893 set layout [$wizard widgets set layout -widget $frame.layout -step $step] 894 895 foreach w [list titleframe pretext posttext clientArea] { 896 set $w [$wizard widgets set $w -widget $layout.$w -step $step] 897 } 898 899 foreach w [list title subtitle icon] { 900 set $w [$wizard widgets set $w -widget $titleframe.$w -step $step] 901 } 902 903 frame $layout -class WizLayoutSimple 904 905 pack $layout -expand 1 -fill both 906 907 # Client area. This is where the caller places its widgets. 908 frame $clientArea -bd 8 -relief flat 909 910 Separator $layout.sep1 -relief groove -orient horizontal 911 912 # title and subtitle and icon 913 frame $titleframe -bd 4 -relief flat -background white 914 label $title -background white -textvariable [$wizard variable $step -text1] 915 label $subtitle -height 2 -background white -padx 15 -width 40 \ 916 -textvariable [$wizard variable $step -text2] 917 918 label $icon -borderwidth 0 -background white -anchor c 919 set iconImage [$wizard getoption $step -icon] 920 if {![string equal $iconImage ""]} { $icon configure -image $iconImage } 921 922 set labelfont [font actual [$title cget -font]] 923 $title configure -font [concat $labelfont -weight bold] 924 925 # put the title, subtitle and icon inside the frame we've built for them 926 grid $title -in $titleframe -row 0 -column 0 -sticky nsew 927 grid $subtitle -in $titleframe -row 1 -column 0 -sticky nsew 928 grid $icon -in $titleframe -row 0 -column 1 -rowspan 2 -padx 8 929 grid columnconfigure $titleframe 0 -weight 1 930 grid columnconfigure $titleframe 1 -weight 0 931 932 # pre and post text. 933 label $pretext -textvariable [$wizard variable $step -text3] 934 label $posttext -textvariable [$wizard variable $step -text4] 935 936 # when our label widgets change size we want to reset the 937 # wraplength to that same size. 938 foreach widget {title subtitle pretext posttext} { 939 bind [set $widget] <Configure> { 940 # yeah, I know this looks weird having two after idle's, but 941 # it helps prevent the geometry manager getting into a tight 942 # loop under certain circumstances 943 # 944 # note that subtracting 10 is just a somewhat arbitrary number 945 # to provide a little padding... 946 after idle {after idle {%W configure -wraplength [expr {%w -10}]}} 947 } 948 } 949 950 grid $titleframe -row 0 -column 0 -sticky nsew -padx 0 951 grid $layout.sep1 -row 1 -sticky ew 952 grid $pretext -row 2 -sticky nsew -padx 8 -pady 8 953 grid $clientArea -row 3 -sticky nsew -padx 8 -pady 8 954 grid $posttext -row 4 -sticky nsew -padx 8 -pady 8 955 956 grid columnconfigure $layout 0 -weight 1 957 grid rowconfigure $layout 0 -weight 0 958 grid rowconfigure $layout 1 -weight 0 959 grid rowconfigure $layout 2 -weight 0 960 grid rowconfigure $layout 3 -weight 1 961 grid rowconfigure $layout 4 -weight 0 962} 963 964proc Wizard::layout::classic { wizard step } { 965 set frame [$wizard widgets get $step] 966 967 set layout [$wizard widgets set layout -widget $frame.layout -step $step] 968 foreach w [list title subtitle icon pretext posttext clientArea] { 969 set $w [$wizard widgets set $w -widget $layout.$w -step $step] 970 } 971 972 frame $layout -class WizLayoutClassic 973 974 pack $layout -expand 1 -fill both 975 976 # Client area. This is where the caller places its widgets. 977 frame $clientArea -bd 8 -relief flat 978 979 Separator $layout.sep1 -relief groove -orient vertical 980 981 # title and subtitle 982 label $title -textvariable [$wizard variable $step -text1] 983 label $subtitle -textvariable [$wizard variable $step -text2] -height 2 984 985 array set labelfont [font actual [$title cget -font]] 986 incr labelfont(-size) 6 987 set labelfont(-weight) bold 988 $title configure -font [array get labelfont] 989 990 # pre and post text. 991 label $pretext -textvariable [$wizard variable $step -text3] 992 label $posttext -textvariable [$wizard variable $step -text4] 993 994 # when our label widgets change size we want to reset the 995 # wraplength to that same size. 996 foreach widget {title subtitle pretext posttext} { 997 bind [set $widget] <Configure> { 998 # yeah, I know this looks weird having two after idle's, but 999 # it helps prevent the geometry manager getting into a tight 1000 # loop under certain circumstances 1001 # 1002 # note that subtracting 10 is just a somewhat arbitrary number 1003 # to provide a little padding... 1004 after idle {after idle {%W configure -wraplength [expr {%w -10}]}} 1005 } 1006 } 1007 1008 label $icon -borderwidth 1 -relief sunken -background white \ 1009 -anchor c -width 96 -image Wizard::none 1010 set iconImage [$wizard getoption $step -icon] 1011 if {![string equal $iconImage ""]} { $icon configure -image $iconImage } 1012 1013 grid $icon -row 0 -column 0 -sticky nsew -padx 8 -pady 8 -rowspan 5 1014 grid $title -row 0 -column 1 -sticky ew -padx 8 -pady 8 1015 grid $subtitle -row 1 -column 1 -sticky ew -padx 8 -pady 8 1016 grid $pretext -row 2 -column 1 -sticky ew -padx 8 1017 grid $clientArea -row 3 -column 1 -sticky nsew -padx 8 1018 grid $posttext -row 4 -column 1 -sticky ew -padx 8 -pady 24 1019 1020 grid columnconfigure $layout 0 -weight 0 1021 grid columnconfigure $layout 1 -weight 1 1022 1023 grid rowconfigure $layout 0 -weight 0 1024 grid rowconfigure $layout 1 -weight 0 1025 grid rowconfigure $layout 2 -weight 0 1026 grid rowconfigure $layout 3 -weight 1 1027 grid rowconfigure $layout 4 -weight 0 1028} 1029