scripts/wizard.itk

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 class tlc::Wizard {
   4         inherit tlc::Mywidget tlc::Signalsource tlc::Handlers tlc::Baselog
   5
   6         constructor {args} {}
   7         destructor {}
   8
   9         itk_option define -image image Image {}
  10
  11         public {
  12                 variable routing        {}
  13                 variable pages          {}
  14                 variable startpage      ""
  15                 variable state          ""
  16                 variable oncancel       {}
  17                 variable showhelp       0
  18                 variable helpwidth      200
  19                 variable helpstyles     {
  20                 }
  21                 variable linkhandler    {}
  22
  23                 method set_data {args}
  24                 method get_data {args}
  25                 method reset {}
  26                 method unfinish {}
  27         }
  28
  29         private {
  30                 variable dat
  31                 variable page_details
  32                 variable routing_tables
  33                 variable unload_page
  34                 variable current_page           ""
  35                 variable pagesignals
  36
  37                 method load_page {page}
  38                 method load_page_form {details}
  39                 method load_page_html {details}
  40
  41                 method apply_action {op}
  42                 method finish {}
  43                 method try_load_page {op page}
  44                 method cancel {}
  45                 method html_escape {text}
  46                 method helpshown_changed {newstate}
  47                 method htmlclick {widget x y}
  48                 method busy_changed {newstate}
  49         }
  50 }
  51
  52
  53 configbody tlc::Wizard::showhelp { #<<<
  54         $signals(helpshown) set_state $showhelp
  55 }
  56
  57 #>>>
  58 configbody tlc::Wizard::helpstyles { #<<<
  59         $w.help.html style $helpstyles
  60 }
  61
  62 #>>>
  63 configbody tlc::Wizard::state { #<<<
  64         $signals(enabled) set_state [expr {$state eq "normal"}]
  65 }
  66
  67 #>>>
  68 configbody tlc::Wizard::helpwidth { #<<<
  69         $w.help.html configure -width $helpwidth
  70 }
  71
  72 #>>>
  73 body tlc::Wizard::constructor {args} { #<<<
  74         package require Tkhtml 3.0
  75
  76         array set dat                           {}
  77         array set page_details          {}
  78         array set routing_tables        {}
  79         array set pagesignals           {}
  80
  81         tlc::Signal #auto signals(enabled) -name "$w enabled"
  82         tlc::Signal #auto signals(helpshown) -name "$w helpshown"
  83         tlc::Signal #auto signals(busy) -name "$w busy"
  84
  85         tlc::Gate #auto signals(back) -mode "and" -name "$w back"
  86         tlc::Gate #auto signals(next) -mode "and" -name "$w next"
  87         tlc::Gate #auto signals(finish) -mode "and" -name "$w finish"
  88         tlc::Gate #auto signals(valid) -mode "and" -name "$w valid"
  89         tlc::Gate #auto signals(dirty) -mode "and" -name "$w valid"
  90
  91         tlc::Signal #auto signals(back_defined) -name "$w back_defined"
  92         tlc::Signal #auto signals(next_defined) -name "$w next_defined"
  93         tlc::Signal #auto signals(finish_defined) -name "$w finish_defined"
  94         tlc::Signal #auto signals(finished) -name "$w finished"
  95
  96         $signals(back) attach_input $signals(back_defined)
  97         $signals(next) attach_input $signals(next_defined)
  98         $signals(finish) attach_input $signals(finish_defined)
  99         $signals(finish) attach_input $signals(valid)
 100
 101         $signals(back) attach_input $signals(finished) inverted
 102         $signals(next) attach_input $signals(finished) inverted
 103         $signals(finish) attach_input $signals(finished) inverted
 104
 105         $signals(back) attach_input $signals(busy) inverted
 106         $signals(next) attach_input $signals(busy) inverted
 107         $signals(finish) attach_input $signals(busy) inverted
 108
 109         ttk::label $w.title -font [$tlc::theme setting hugefont]
 110
 111         ttk::frame $w.page
 112
 113         # Help info <<<
 114         ttk::frame $w.help
 115         html $w.help.html -yscrollcommand [list $w.help.vsb set]
 116         myscrollbar_win32 $w.help.vsb -orient v -command [list $w.help.html yview]
 117
 118         bind $w.help.html <Button-1> [code $this htmlclick $w.help.html %x %y]
 119         blt::table $w.help \
 120                         $w.help.html    1,1 -fill both \
 121                         $w.help.vsb             1,2 -fill y
 122         blt::table configure $w.help c2 -resize none
 123         # Help info >>>
 124
 125         Tools $w.ops -buttonwidth 9
 126         $w.ops add "< Back" [code $this apply_action back] right
 127         $w.ops add "Next >" [code $this apply_action next] right
 128         $w.ops add "Finish" [code $this finish] right
 129         $w.ops add "Cancel" [code $this cancel] right
 130
 131         $w.ops attach_signal "< Back" $signals(back)
 132         $w.ops attach_signal "Next >" $signals(next)
 133         $w.ops attach_signal "Finish" $signals(finish)
 134
 135         blt::table $w \
 136                         $w.title        1,2 -anchor w -pady {0 5} \
 137                         $w.page         2,2 -fill both \
 138                         $w.ops          3,2 -fill x -pady 5 -padx 5
 139         blt::table configure $w c1 r1 r3 -resize none
 140         blt::table configure $w r1 r3 -resize none
 141
 142         $signals(helpshown) attach_output [code $this helpshown_changed]
 143
 144         itk_initialize {*}$args
 145
 146         foreach {page details} [tlc::decomment $pages] {
 147                 set page_details($page) [tlc::decomment $details]
 148         }
 149
 150         foreach {page info} [tlc::decomment $routing] {
 151                 foreach {op expressions} [tlc::decomment $info] {
 152                         set op  [string tolower $op]
 153                         set routing_tables($op,$page) [tlc::decomment $expressions]
 154                 }
 155         }
 156
 157         $signals(busy) attach_output [code $this busy_changed]
 158
 159         load_page $startpage
 160 }
 161
 162 #>>>
 163 body tlc::Wizard::destructor {} { #<<<
 164 }
 165
 166 #>>>
 167 body tlc::Wizard::set_data {args} { #<<<
 168         set argcount    [llength $args]
 169         if {$argcount == 1} {
 170                 set data        [lindex $args 0]
 171         } elseif {$argcount % 2 == 0} {
 172                 set data        $args
 173         } else {
 174                 error "Syntax error"
 175         }
 176
 177         array set dat   $data
 178         # TODO: update whatever page is loaded
 179 }
 180
 181 #>>>
 182 body tlc::Wizard::get_data {args} { #<<<
 183         if {[llength $args] == 0} {
 184                 return [array get dat]
 185         }
 186 }
 187
 188 #>>>
 189 body tlc::Wizard::load_page {page} { #<<<
 190         log debug "enter"
 191         if {![info exists page_details($page)]} {
 192                 error "No such page: $page" "" [list invalid_page $page]
 193         }
 194         $signals(busy) set_state 1
 195
 196         $signals(back_defined) set_state        [info exists routing_tables(back,$page)]
 197         $signals(next_defined) set_state        [info exists routing_tables(next,$page)]
 198         $signals(finish_defined) set_state      [info exists routing_tables(finish,$page)]
 199
 200         set details             $page_details($page)
 201         array set d             $details
 202
 203         if {[info exists unload_page]} {
 204                 eval $unload_page
 205                 unset unload_page
 206         }
 207         if {[winfo exists $w.page.child]} {
 208                 destroy $w.page.child
 209         }
 210
 211         $w.help.html reset
 212         if {[dict exists $details help]} {
 213                 $w.help.html style $helpstyles
 214                 $w.help.html parse -final [dict get $details help]
 215         }
 216
 217         if {[dict exists $details title]} {
 218                 $w.title configure -text [dict get $details title]
 219         } else {
 220                 $w.title configure -text ""
 221         }
 222
 223         switch -- $d(type) {
 224                 form    {load_page_form $details}
 225                 html    {load_page_html $details}
 226                 default {
 227                         error "Invalid type \"$d(type)\" for page \"$page\"" "" \
 228                                         [list invalid_type $d(type)]
 229                 }
 230         }
 231
 232         set current_page        $page
 233         $signals(busy) set_state 0
 234         log debug "leave"
 235 }
 236
 237 #>>>
 238 body tlc::Wizard::load_page_form {details} { #<<<
 239         log debug "enter"
 240         array set d {
 241                 options {}
 242         }
 243         array set d     $details
 244
 245         Form $w.page.child {*}$d(options) -schema $d(schema)
 246
 247         $w.page.child set_data [array get dat]
 248
 249         $signals(next) attach_input [$w.page.child signal_ref form_valid]
 250         $signals(valid) attach_input [$w.page.child signal_ref form_valid]
 251         $signals(dirty) attach_input [$w.page.child signal_ref form_dirty]
 252
 253         blt::table $w.page \
 254                         $w.page.child   1,1 -fill both
 255
 256         $w.page.child takefocus
 257         log debug "leave"
 258 }
 259
 260 #>>>
 261 body tlc::Wizard::load_page_html {details} { #<<<
 262         log debug "enter"
 263         package require Tkhtml 3
 264         ttk::frame $w.page.child
 265         html $w.page.child.html \
 266                         -xscrollcommand [code $w.page.child.hsb set] \
 267                         -yscrollcommand [code $w.page.child.vsb set]
 268         myscrollbar_win32 $w.page.child.hsb -orient h \
 269                         -command [code $w.page.child.html xview]
 270         myscrollbar_win32 $w.page.child.vsb -orient v \
 271                         -command [code $w.page.child.html yview]
 272         bind $w.page.child.html <Button-1> [code $this htmlclick $w.page.child.html %x %y]
 273
 274         if {[dict exists $details styles]} {
 275                 $w.page.child.html style [dict get $details styles]
 276         }
 277
 278         set map [dict create]
 279         foreach {k v} [array get dat] {
 280                 dict set map %$k% [html_escape $v]
 281         }
 282         set html        [string map $map [dict get $details html]]
 283         $w.page.child.html parse -final $html
 284
 285         blt::table $w.page.child \
 286                         $w.page.child.html              1,1 -fill both \
 287                         $w.page.child.hsb               2,1 -fill x \
 288                         $w.page.child.vsb               1,2 -fill y
 289         blt::table configure $w.page.child r2 c2 -resize none
 290
 291         tlc::Signal #auto pagesignals(form_valid) -name "fake valid"
 292         tlc::Signal #auto pagesignals(form_dirty) -name "fake dirty"
 293         $pagesignals(form_valid) set_state 1
 294         $pagesignals(form_dirty) set_state 1
 295
 296         $signals(next) attach_input $pagesignals(form_valid)
 297         $signals(valid) attach_input $pagesignals(form_valid)
 298         $signals(dirty) attach_input $pagesignals(form_dirty)
 299
 300         set unload_page {
 301                 array unset pagesignals
 302                 array set pagesignals {}
 303         }
 304
 305         blt::table $w.page \
 306                         $w.page.child           1,1 -fill both
 307         log debug "leave"
 308 }
 309
 310 #>>>
 311 body tlc::Wizard::apply_action {op} { #<<<
 312         log debug "enter"
 313         if {![$signals($op) state]} return
 314         $signals(busy) set_state 1
 315         set expressions $routing_tables($op,$current_page)
 316
 317         # TODO: Handle non-forms
 318         if {
 319                 [winfo exists $w.page.child] &&
 320                 [itcl::is object $w.page.child] &&
 321                 [$w.page.child isa tlc::Form]
 322         } {
 323                 array set dat   [$w.page.child get_data]
 324         }
 325
 326         if {[llength $expressions] == 1} {
 327                 # This is a convenience syntax where there is no logic to the next step
 328                 try_load_page $op $expressions
 329                 return
 330         }
 331
 332         set default_target_page ""
 333         foreach {expression target_page} $expressions {
 334                 if {$expression eq "default"} {
 335                         set default_target_page $target_page
 336                         continue
 337                 }
 338                 if $expression {
 339                         try_load_page $op $target_page
 340                         return
 341                 }
 342         }
 343         if {$default_target_page ne ""} {
 344                 try_load_page $op $default_target_page
 345                 return
 346         }
 347
 348         $signals(busy) set_state 0
 349         error "No routing actions specified that are applicable" "" \
 350                         [list no_matches]
 351 }
 352
 353 #>>>
 354 body tlc::Wizard::finish {} { #<<<
 355         $signals(finished) set_state 1
 356 }
 357
 358 #>>>
 359 body tlc::Wizard::try_load_page {op page} { #<<<
 360         log debug "enter"
 361         if {[info exists routing_tables(skip_if,$page)]} {
 362                 if $routing_tables(skip_if,$page) {
 363                         # TODO: handle finish
 364                         log debug "skipping because ($routing_tables(skip_if,$page)) is false"
 365                         set current_page        $page
 366                         $signals(busy) set_state 0      ;# This raises a slight risk of a race
 367                         apply_action $op
 368                         return
 369                 }
 370         }
 371         load_page $page
 372         log debug "leave"
 373 }
 374
 375 #>>>
 376 body tlc::Wizard::cancel {} { #<<<
 377         if {$oncancel ne {}} {
 378                 uplevel #0 $oncancel
 379         } else {
 380                 reset
 381         }
 382 }
 383
 384 #>>>
 385 body tlc::Wizard::reset {} { #<<<
 386         array unset dat
 387         array set dat {}
 388         load_page $startpage
 389 }
 390
 391 #>>>
 392 body tlc::Wizard::html_escape {text} { #<<<
 393         return [string map {
 394         \xa0 &nbsp; \xa1 &iexcl; \xa2 &cent; \xa3 &pound; \xa4 &curren;
 395         \xa5 &yen; \xa6 &brvbar; \xa7 &sect; \xa8 &uml; \xa9 &copy;
 396         \xaa &ordf; \xab &laquo; \xac &not; \xad &shy; \xae &reg;
 397         \xaf &macr; \xb0 &deg; \xb1 &plusmn; \xb2 &sup2; \xb3 &sup3;
 398         \xb4 &acute; \xb5 &micro; \xb6 &para; \xb7 &middot; \xb8 &cedil;
 399         \xb9 &sup1; \xba &ordm; \xbb &raquo; \xbc &frac14; \xbd &frac12;
 400         \xbe &frac34; \xbf &iquest; \xc0 &Agrave; \xc1 &Aacute; \xc2 &Acirc;
 401         \xc3 &Atilde; \xc4 &Auml; \xc5 &Aring; \xc6 &AElig; \xc7 &Ccedil;
 402         \xc8 &Egrave; \xc9 &Eacute; \xca &Ecirc; \xcb &Euml; \xcc &Igrave;
 403         \xcd &Iacute; \xce &Icirc; \xcf &Iuml; \xd0 &ETH; \xd1 &Ntilde;
 404         \xd2 &Ograve; \xd3 &Oacute; \xd4 &Ocirc; \xd5 &Otilde; \xd6 &Ouml;
 405         \xd7 &times; \xd8 &Oslash; \xd9 &Ugrave; \xda &Uacute; \xdb &Ucirc;
 406         \xdc &Uuml; \xdd &Yacute; \xde &THORN; \xdf &szlig; \xe0 &agrave;
 407         \xe1 &aacute; \xe2 &acirc; \xe3 &atilde; \xe4 &auml; \xe5 &aring;
 408         \xe6 &aelig; \xe7 &ccedil; \xe8 &egrave; \xe9 &eacute; \xea &ecirc;
 409         \xeb &euml; \xec &igrave; \xed &iacute; \xee &icirc; \xef &iuml;
 410         \xf0 &eth; \xf1 &ntilde; \xf2 &ograve; \xf3 &oacute; \xf4 &ocirc;
 411         \xf5 &otilde; \xf6 &ouml; \xf7 &divide; \xf8 &oslash; \xf9 &ugrave;
 412         \xfa &uacute; \xfb &ucirc; \xfc &uuml; \xfd &yacute; \xfe &thorn;
 413         \xff &yuml; \u192 &fnof; \u391 &Alpha; \u392 &Beta; \u393 &Gamma;
 414         \u394 &Delta; \u395 &Epsilon; \u396 &Zeta; \u397 &Eta; \u398 &Theta;
 415         \u399 &Iota; \u39A &Kappa; \u39B &Lambda; \u39C &Mu; \u39D &Nu;
 416         \u39E &Xi; \u39F &Omicron; \u3A0 &Pi; \u3A1 &Rho; \u3A3 &Sigma;
 417         \u3A4 &Tau; \u3A5 &Upsilon; \u3A6 &Phi; \u3A7 &Chi; \u3A8 &Psi;
 418         \u3A9 &Omega; \u3B1 &alpha; \u3B2 &beta; \u3B3 &gamma; \u3B4 &delta;
 419         \u3B5 &epsilon; \u3B6 &zeta; \u3B7 &eta; \u3B8 &theta; \u3B9 &iota;
 420         \u3BA &kappa; \u3BB &lambda; \u3BC &mu; \u3BD &nu; \u3BE &xi;
 421         \u3BF &omicron; \u3C0 &pi; \u3C1 &rho; \u3C2 &sigmaf; \u3C3 &sigma;
 422         \u3C4 &tau; \u3C5 &upsilon; \u3C6 &phi; \u3C7 &chi; \u3C8 &psi;
 423         \u3C9 &omega; \u3D1 &thetasym; \u3D2 &upsih; \u3D6 &piv;
 424         \u2022 &bull; \u2026 &hellip; \u2032 &prime; \u2033 &Prime;
 425         \u203E &oline; \u2044 &frasl; \u2118 &weierp; \u2111 &image;
 426         \u211C &real; \u2122 &trade; \u2135 &alefsym; \u2190 &larr;
 427         \u2191 &uarr; \u2192 &rarr; \u2193 &darr; \u2194 &harr; \u21B5 &crarr;
 428         \u21D0 &lArr; \u21D1 &uArr; \u21D2 &rArr; \u21D3 &dArr; \u21D4 &hArr;
 429         \u2200 &forall; \u2202 &part; \u2203 &exist; \u2205 &empty;
 430         \u2207 &nabla; \u2208 &isin; \u2209 &notin; \u220B &ni; \u220F &prod;
 431         \u2211 &sum; \u2212 &minus; \u2217 &lowast; \u221A &radic;
 432         \u221D &prop; \u221E &infin; \u2220 &ang; \u2227 &and; \u2228 &or;
 433         \u2229 &cap; \u222A &cup; \u222B &int; \u2234 &there4; \u223C &sim;
 434         \u2245 &cong; \u2248 &asymp; \u2260 &ne; \u2261 &equiv; \u2264 &le;
 435         \u2265 &ge; \u2282 &sub; \u2283 &sup; \u2284 &nsub; \u2286 &sube;
 436         \u2287 &supe; \u2295 &oplus; \u2297 &otimes; \u22A5 &perp;
 437         \u22C5 &sdot; \u2308 &lceil; \u2309 &rceil; \u230A &lfloor;
 438         \u230B &rfloor; \u2329 &lang; \u232A &rang; \u25CA &loz;
 439         \u2660 &spades; \u2663 &clubs; \u2665 &hearts; \u2666 &diams;
 440         \x22 &quot; \x26 &amp; \x3C &lt; \x3E &gt; \u152 &OElig;
 441         \u153 &oelig; \u160 &Scaron; \u161 &scaron; \u178 &Yuml;
 442         \u2C6 &circ; \u2DC &tilde; \u2002 &ensp; \u2003 &emsp; \u2009 &thinsp;
 443         \u200C &zwnj; \u200D &zwj; \u200E &lrm; \u200F &rlm; \u2013 &ndash;
 444         \u2014 &mdash; \u2018 &lsquo; \u2019 &rsquo; \u201A &sbquo;
 445         \u201C &ldquo; \u201D &rdquo; \u201E &bdquo; \u2020 &dagger;
 446         \u2021 &Dagger; \u2030 &permil; \u2039 &lsaquo; \u203A &rsaquo;
 447         \u20AC &euro;
 448         } $text]
 449 }
 450
 451 #>>>
 452 body tlc::Wizard::helpshown_changed {newstate} { #<<<
 453         if {$newstate} {
 454                 blt::table $w \
 455                                 $w.help         1,1 -rspan 3 -fill both
 456         } else {
 457                 if {"$w.help" in [blt::table search $w]} {
 458                         blt::table forget $w.help
 459                 }
 460         }
 461 }
 462
 463 #>>>
 464 body tlc::Wizard::htmlclick {widget x y} { #<<<
 465         set raw         [$widget node -index $x $y]
 466         if {$raw eq ""} return
 467
 468         lassign $raw node byteoffset
 469         set parent              [$node parent]
 470         if {[string tolower [$parent tag]] ne "a"} return
 471         set href                [$parent attribute -default "" href]
 472         if {$href eq ""} return
 473
 474         invoke_handlers html_link_clicked $href
 475 }
 476
 477 #>>>
 478 body tlc::Wizard::unfinish {} { #<<<
 479         $signals(finished) set_state 0
 480 }
 481
 482 #>>>
 483 body tlc::Wizard::busy_changed {newstate} { #<<<
 484         log debug
 485 }
 486
 487 #>>>