examples/pagedform.tcl

   1 #!/usr/bin/env tclsh8.5
   2
   3 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   4
   5 package require Tcl 8.5
   6 package require TLC
   7 eval [tlc::go_home]
   8
   9 set loglevels_class     "loglevels_class_[file tail [info script]]"
  10 if {[file exists $loglevels_class]} {
  11         puts "loading classmap: ($loglevels_class)"
  12         tlc::Baselog::load_classmap $loglevels_class
  13 }
  14
  15 . configure -background [ttk::style lookup $::ttk::currentTheme -background]
  16 wm geometry . "450x250"
  17
  18 tlc::Pagedform .p -mode list -input_transform {
  19         if {![info exists dat(foo)] || $dat(foo) eq ""} {
  20                 set dat(foo)    "Initial foo"
  21         }
  22         set dat(fake1)  $dat(foo)
  23         set dat(fake2)  $dat(foo)
  24 } -output_transform {
  25         array unset dat fake2
  26 } -form_schema_prefix {
  27         _layout         {row_args_sticky -resize none}
  28         _layout         {col_args_sticky -resize none}
  29 } -pages {
  30         "Page 1" { #<<<
  31                 type html
  32                 html {
  33                         Foo: &quot;%foo%&quot;<br>
  34                         Bar: &quot;%bar%&quot;<br>
  35                         Baz: &quot;%baz%&quot;<br>
  36                 }
  37                 styles {
  38                 }
  39         }
  40         #>>>
  41         "Page 2" { #<<<
  42                 type form
  43                 disabled_if {
  44                         $dat(baz) eq $dat(foo)
  45                 }
  46                 options {-padding 2}
  47                 schema {
  48                         "Foo"   {foo}
  49                         "Bar"   {bar}
  50                 }
  51         }
  52         #>>>
  53         "Page 3" { #<<<
  54                 options {-padding 2}
  55                 schema {
  56                         "Baz"   {baz}
  57                         "Quux"  {bar label}
  58
  59                         _defaults {
  60                                 baz             "Baz from _defaults"
  61                         }
  62
  63                         _validation_not_blank {
  64                                 "%1 must not be blank"
  65                                 "Quux"          bar
  66                         }
  67                 }
  68         }
  69         #>>>
  70         "This is a very long page title" { #<<<
  71                 options {-winding h}
  72                 disabled_if {
  73                         $dat(blinken)
  74                 }
  75                 schema {
  76                         "A" {a entry -width 4}
  77                         "B" {b entry -width 4}
  78                         "C" {c entry -width 4}
  79                         _defaults {
  80                                 blinken 0
  81                         }
  82                 }
  83         }
  84         #>>>
  85 }
  86
  87 .p set_data {
  88         bar             "Hello bar"
  89         b               "this is b"
  90         baz             "Updated baz"
  91 }
  92
  93 proc blink {} {
  94         set current     [dict get [.p get_data] blinken]
  95         if {$current} {
  96                 .p set_data blinken 0
  97         } else {
  98                 .p set_data blinken 1
  99         }
 100         after 1000 blink
 101 }
 102
 103 proc submit {} {
 104         array set dat   [.p get_data]
 105         puts "dat:"
 106         parray dat
 107 }
 108
 109 tlc::Tools .ops
 110 .ops add "Submit" submit right
 111 .ops add "Close" exit right
 112
 113 .ops attach_signal "Submit" [.p signal_ref valid]
 114
 115 blt::table . \
 116                 .p              1,1 -fill both \
 117                 .ops    2,1 -fill x -pady {5 0}
 118 blt::table configure . r2 -resize none
 119
 120 blink