scripts/formdialog.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 option add *Formdialog.padding                  2               widgetDefault
   4 option add *Formdialog.frameRelief              groove  widgetDefault
   5 option add *Formdialog.frameBorderwidth 2               widgetDefault
   6 option add *Formdialog.formIPadX                5               widgetDefault
   7 option add *Formdialog.formIPadY                3               widgetDefault
   8
   9 proc tlc::formdialog {pathName args} {
  10         uplevel tlc::Formdialog $pathName $args
  11 }
  12
  13
  14 class tlc::Formdialog {
  15         inherit tlc::Modal
  16
  17         constructor {args} {}
  18         destructor {}
  19
  20         # Equivalence the old hack for setting tlc::Border's settings
  21         itk_option define -formrelief formRelief Relief "groove" {
  22                 $w.form configure -framerelief $itk_option(-formrelief)
  23         }
  24         itk_option define -formborderwidth formBorderwidth Borderwidth 2 {
  25                 $w.form configure -frameborderwidth $itk_option(-formborderwidth)
  26         }
  27
  28         public {
  29                 variable mode           "inline"
  30                 variable preface        ""
  31                 variable name           ""
  32
  33                 method ask {arrayvar args}
  34                 method set_tips {args} {return [eval [list $w.form set_tips] $args]}
  35                 method get_data {args} {return [eval [list $w.form get_data] $args]}
  36         }
  37
  38         private {
  39                 method form_valid_changed {isvalid reasons}
  40         }
  41 }
  42
  43
  44 configbody tlc::Formdialog::name { #<<<1
  45         $w.form configure -name $name
  46 }
  47
  48
  49 configbody tlc::Formdialog::preface { #<<<1
  50         set preface             [string trim $preface]
  51         if {$preface == ""} {
  52                 if {[winfo exists $w.preface]} {
  53                         blt::table forget $w.preface
  54                         destroy $w.preface
  55                 }
  56                 blt::table configure $w r1 -height 0
  57         }
  58         if {[winfo exists $w.preface]} {
  59                 $w.preface configure -text $preface
  60         } else {
  61                 message $w.preface -text $preface -aspect 200
  62                 blt::table $w $w.preface 1,1 -anchor nw -pady {0 8}
  63         }
  64 }
  65
  66
  67 body tlc::Formdialog::constructor {args} { #<<<1
  68         option add $wdb*Button.width            12 widgetDefault
  69
  70         itk_component add form {
  71                 tlc::Form $w.form
  72         } {
  73                 keep -padding -tooltipdelay -tooltiptimeout -winding
  74                 #rename -relief -formrelief formRelief FormRelief
  75                 #rename -borderwidth -formborderwidth formBorderWidth FormBorderWidth
  76                 keep -framerelief -frameborderwidth
  77                 rename -ipadx -formipadx formIPadX FormIPadX
  78                 rename -ipady -formipady formIPadY FormIPadY
  79         }
  80         $w.form register_handler valid_status_changed [code $this form_valid_changed]
  81         tlc::Tools $w.tools
  82         $w.tools add "OK" [code $this choose 1] right
  83         $w.tools add "Cancel" [code $this choose 0] right
  84
  85         $w.tools attach_signal "OK" [$w.form signal_ref form_valid]
  86
  87         $w.form force_form_valid_update
  88
  89         blt::table $w -padx 5 -pady 5 \
  90                         $w.form         2,1 \
  91                         $w.tools        3,1 -fill x -pady {5 0}
  92         blt::table configure $w r1 r3 -resize none
  93
  94         eval itk_initialize $args
  95 }
  96
  97
  98 body tlc::Formdialog::destructor {} { #<<<1
  99         if {[winfo exists $w.form]} {delete object $w.form}
 100 }
 101
 102
 103 body tlc::Formdialog::ask {arrayvar args} { #<<<1
 104         upvar $arrayvar arr
 105         if {![info exists arr]} {
 106                 array set arr {}
 107         }
 108
 109         if {![array exists arr]} {
 110                 error "$arrayvar is not an array"
 111         }
 112
 113         switch -- $mode {
 114                 "schema" {
 115                         $w.form configure -schema [lindex $args 0]
 116                 }
 117
 118                 default {
 119                         $w.form configure -schema $args
 120                 }
 121         }
 122
 123         $w.form clear_data
 124         $w.form set_data [array get arr]
 125
 126         $w.form takefocus
 127
 128         waitresult
 129
 130         if {$result} {
 131                 array set arr   [$w.form get_data]
 132         }
 133
 134         return $result
 135 }
 136
 137
 138 body tlc::Formdialog::form_valid_changed {isvalid reasons} { #<<<1
 139         if {$isvalid} {
 140                 $w.tools set_tips "OK" ""
 141         } else {
 142                 #puts stderr [[$w.form signal_ref form_valid] explain_txt]
 143                 $w.tools set_tips "OK" [join $reasons \n]
 144         }
 145 }
 146
 147