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