/02-development/uDrawGraph-3.1/lib/BWidget-1.7.0/wizard.tcl

https://bitbucket.org/jmelo_lyncode/thesis · TCL · 1028 lines · 732 code · 224 blank · 72 comment · 106 complexity · 280399e3f5bbe2b9ef810f83be2b8dd9 MD5 · raw file

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