home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / buttonbox.tcl < prev    next >
Text File  |  2000-11-02  |  8KB  |  227 lines
  1. # ------------------------------------------------------------------------------
  2. #  buttonbox.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. #  Index of commands:
  6. #     - ButtonBox::create
  7. #     - ButtonBox::configure
  8. #     - ButtonBox::cget
  9. #     - ButtonBox::add
  10. #     - ButtonBox::itemconfigure
  11. #     - ButtonBox::itemcget
  12. #     - ButtonBox::setfocus
  13. #     - ButtonBox::invoke
  14. #     - ButtonBox::index
  15. #     - ButtonBox::_destroy
  16. # ------------------------------------------------------------------------------
  17.  
  18. namespace eval ButtonBox {
  19.     Button::use
  20.  
  21.     Widget::declare ButtonBox {
  22.         {-background  TkResource ""         0 frame}
  23.         {-orient      Enum       horizontal 1 {horizontal vertical}}
  24.         {-homogeneous Boolean    1          1}
  25.         {-spacing     Int        10         0 {=0}}
  26.         {-padx        TkResource ""         0 button}
  27.         {-pady        TkResource ""         0 button}
  28.         {-default     Int        -1         0 {=-1}} 
  29.         {-bg          Synonym    -background}
  30.     }
  31.  
  32.     Widget::addmap ButtonBox "" :cmd {-background {}}
  33.  
  34.     proc ::ButtonBox { path args } { return [eval ButtonBox::create $path $args] }
  35.     proc use {} {}
  36. }
  37.  
  38.  
  39. # ------------------------------------------------------------------------------
  40. #  Command ButtonBox::create
  41. # ------------------------------------------------------------------------------
  42. proc ButtonBox::create { path args } {
  43.     Widget::init ButtonBox $path $args
  44.  
  45.     variable $path
  46.     upvar 0  $path data
  47.  
  48.     eval frame $path [Widget::subcget $path :cmd] -takefocus 0 -highlightthickness 0
  49.  
  50.     set data(default)  [Widget::getoption $path -default]
  51.     set data(nbuttons) 0
  52.     set data(max)      0
  53.  
  54.     bind $path <Destroy> "ButtonBox::_destroy $path"
  55.  
  56.     rename $path ::$path:cmd
  57.     proc ::$path { cmd args } "return \[eval ButtonBox::\$cmd $path \$args\]"
  58.  
  59.     return $path
  60. }
  61.  
  62.  
  63. # ------------------------------------------------------------------------------
  64. #  Command ButtonBox::configure
  65. # ------------------------------------------------------------------------------
  66. proc ButtonBox::configure { path args } {
  67.     variable $path
  68.     upvar 0  $path data
  69.  
  70.     set res [Widget::configure $path $args]
  71.  
  72.     if { [Widget::hasChanged $path -default val] } {
  73.         if { $data(default) != -1 && $val != -1 } {
  74.             set but $path.b$data(default)
  75.             if { [winfo exists $but] } {
  76.                 $but configure -default normal
  77.             }
  78.             set but $path.b$val
  79.             if { [winfo exists $but] } {
  80.                 $but configure -default active
  81.             }
  82.             set data(default) $val
  83.         } else {
  84.             Widget::setoption $path -default $data(default)
  85.         }
  86.     }
  87.  
  88.     return $res
  89. }
  90.  
  91.  
  92. # ------------------------------------------------------------------------------
  93. #  Command ButtonBox::cget
  94. # ------------------------------------------------------------------------------
  95. proc ButtonBox::cget { path option } {
  96.     return [Widget::cget $path $option]
  97. }
  98.  
  99.  
  100. # ------------------------------------------------------------------------------
  101. #  Command ButtonBox::add
  102. # ------------------------------------------------------------------------------
  103. proc ButtonBox::add { path args } {
  104.     variable $path
  105.     upvar 0  $path data
  106.  
  107.     set but     $path.b$data(nbuttons)
  108.     set spacing [Widget::getoption $path -spacing]
  109.  
  110.     if { $data(nbuttons) == $data(default) } {
  111.         set style active
  112.     } elseif { $data(default) == -1 } {
  113.         set style disabled
  114.     } else {
  115.         set style normal
  116.     }
  117.  
  118.     eval Button::create $but \
  119.         -background [Widget::getoption $path -background]\
  120.         -padx       [Widget::getoption $path -padx] \
  121.         -pady       [Widget::getoption $path -pady] \
  122.         $args \
  123.         -default $style
  124.  
  125.     set idx [expr {2*$data(nbuttons)}]
  126.     if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  127.         grid $but -column $idx -row 0 -sticky nsew
  128.         if { [Widget::getoption $path -homogeneous] } {
  129.             set req [winfo reqwidth $but]
  130.             if { $req > $data(max) } {
  131.                 for {set i 0} {$i < $data(nbuttons)} {incr i} {
  132.                     grid columnconfigure $path [expr {2*$i}] -minsize $req
  133.                 }
  134.                 set data(max) $req
  135.             }
  136.             grid columnconfigure $path $idx -minsize $data(max) -weight 1
  137.         } else {
  138.             grid columnconfigure $path $idx -weight 0
  139.         }
  140.         if { $data(nbuttons) > 0 } {
  141.             grid columnconfigure $path [expr {$idx-1}] -minsize $spacing
  142.         }
  143.     } else {
  144.         grid $but -column 0 -row $idx -sticky nsew
  145.         grid rowconfigure $path $idx -weight 0
  146.         if { $data(nbuttons) > 0 } {
  147.             grid rowconfigure $path [expr {$idx-1}] -minsize $spacing
  148.         }
  149.     }
  150.  
  151.     incr data(nbuttons)
  152.  
  153.     return $but
  154. }
  155.  
  156.  
  157. # ------------------------------------------------------------------------------
  158. #  Command ButtonBox::itemconfigure
  159. # ------------------------------------------------------------------------------
  160. proc ButtonBox::itemconfigure { path index args } {
  161.     if { [set idx [lsearch $args -default]] != -1 } {
  162.         set args [lreplace $args $idx [expr {$idx+1}]]
  163.     }
  164.     return [eval Button::configure $path.b[index $path $index] $args]
  165. }
  166.  
  167.  
  168. # ------------------------------------------------------------------------------
  169. #  Command ButtonBox::itemcget
  170. # ------------------------------------------------------------------------------
  171. proc ButtonBox::itemcget { path index option } {
  172.     return [Button::cget $path.b[index $path $index] $option]
  173. }
  174.  
  175.  
  176. # ------------------------------------------------------------------------------
  177. #  Command ButtonBox::setfocus
  178. # ------------------------------------------------------------------------------
  179. proc ButtonBox::setfocus { path index } {
  180.     set but $path.b[index $path $index]
  181.     if { [winfo exists $but] } {
  182.         focus $but
  183.     }
  184. }
  185.  
  186.  
  187. # ------------------------------------------------------------------------------
  188. #  Command ButtonBox::invoke
  189. # ------------------------------------------------------------------------------
  190. proc ButtonBox::invoke { path index } {
  191.     set but $path.b[index $path $index]
  192.     if { [winfo exists $but] } {
  193.         Button::invoke $but
  194.     }
  195. }
  196.  
  197.  
  198. # ------------------------------------------------------------------------------
  199. #  Command ButtonBox::index
  200. # ------------------------------------------------------------------------------
  201. proc ButtonBox::index { path index } {
  202.     if { ![string compare $index "default"] } {
  203.         set res [Widget::getoption $path -default]
  204.     } elseif { ![string compare $index "end"] || ![string compare $index "last"] } {
  205.         variable $path
  206.         upvar 0  $path data
  207.  
  208.         set res [expr {$data(nbuttons)-1}]
  209.     } else {
  210.         set res $index
  211.     }
  212.     return $res
  213. }
  214.  
  215.  
  216. # ------------------------------------------------------------------------------
  217. #  Command ButtonBox::_destroy
  218. # ------------------------------------------------------------------------------
  219. proc ButtonBox::_destroy { path } {
  220.     variable $path
  221.     upvar 0  $path data
  222.  
  223.     Widget::destroy $path
  224.     unset data
  225.     rename $path {}
  226. }
  227.