scripts/wizard.itk

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