scripts/getinf.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 proc tlc::getinf {pathName args} {
   4         uplevel tlc::Getinf $pathName $args
   5 }
   6
   7
   8 class tlc::Getinf {
   9         inherit tlc::Modal
  10
  11         constructor {args} {}
  12
  13         public {
  14                 method ask {args}
  15         }
  16
  17         private {
  18                 variable data
  19         }
  20 }
  21
  22
  23 body tlc::Getinf::constructor {args} { #<<<1
  24         eval itk_initialize $args
  25
  26         option add *$wdb*Button.width                           12      widgetDefault
  27         option add *$wdb*Button.highlightThickness      1
  28         option add *$wdb*Button.takeFocus                       1
  29
  30         frame $w.args
  31
  32         tlc::Tools $w.tools
  33         $w.tools add "OK" [code $this choose 1] right
  34         $w.tools add "Cancel" [code $this choose 0] right
  35
  36         blt::table $w -padx 5 -pady 5 \
  37                 $w.args         1,1 -fill x \
  38                 $w.tools        2,1 -pady {8 0} -fill x
  39         blt::table configure $w r2 -resize none
  40 }
  41
  42
  43 body tlc::Getinf::ask {args} { #<<<1
  44         catch {eval destroy [winfo children $w.args]}
  45         catch {unset data}
  46         array set data {}
  47
  48         set row         1
  49         foreach {label varspec} $args {
  50                 set varname             ""
  51                 set type                ""
  52                 set default             ""
  53                 foreach {varname type default} $varspec {break}
  54                 set rest                [lrange $varspec 3 end]
  55
  56                 upvar $varname dest_$varname
  57                 if {[info exists dest_$varname]} {
  58                         set data($varname)              [set dest_$varname]
  59                 } else {
  60                         set data($varname)              $default
  61                 }
  62
  63                 label $w.args.$row,l -text "${label}:"
  64
  65                 switch $type {
  66                         "" -
  67                         entry {
  68                                 entry $w.args.$row,v -textvariable [scope data($varname)]
  69                         }
  70
  71                         checkbox -
  72                         checkbutton {
  73                                 checkbutton $w.args.$row,v -variable [scope data($varname)]
  74                         }
  75
  76                         label {
  77                                 label $w.args.$row,v -text $data($varname) -justify left \
  78                                         -font [tlc::default_config get boldfont]
  79                         }
  80
  81                         textbox -
  82                         text {
  83                                 tlc::vartextbox $w.args.$row,v \
  84                                                 -textvariable [scope data($varname)]
  85                         }
  86
  87                         button {
  88                                 button $w.args.$row,v -textvariable [scope data($varname)] \
  89                                         -command [lindex $rest 0]
  90                         }
  91
  92                         combobox -
  93                         mycombobox {
  94                                 tlc::mycombobox $w.args.$row,v \
  95                                                 -textvariable [scope data($varname)] \
  96                                                 -choices [lindex $rest 0]
  97                         }
  98
  99                         default {
 100                                 puts stderr "Unknown type: ($type)"
 101                         }
 102                 }
 103
 104                 blt::table $w.args \
 105                         $w.args.$row,l          $row,1 -anchor ne \
 106                         $w.args.$row,v          $row,2 -anchor nw
 107                 blt::table configure $w.args c1 -resize none
 108
 109                 incr row
 110         }
 111         focus $w.args.1,v
 112
 113         waitresult
 114
 115         if {$result} {
 116                 foreach {label varspec} $args {
 117                         set varname             ""
 118                         set type                ""
 119                         foreach {varname type} $varspec {break}
 120                         set dest_$varname       $data($varname)
 121                 }
 122         }
 123
 124         return $result
 125 }
 126
 127