home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / bwidget1.3.0 / buttonbox.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  9.2 KB  |  321 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 "%d >= 0"}
  26.         {-padx        TkResource ""         0 button}
  27.         {-pady        TkResource ""         0 button}
  28.         {-default     Int        -1         0 "%d >= -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.     array set flags $args
  119.     set tags ""
  120.     if { [info exists flags(-tags)] } {
  121.     set tags $flags(-tags)
  122.     unset flags(-tags)
  123.     set args [array get flags]
  124.     }
  125.  
  126.     eval Button::create $but \
  127.         -background [Widget::getoption $path -background]\
  128.         -padx       [Widget::getoption $path -padx] \
  129.         -pady       [Widget::getoption $path -pady] \
  130.         $args \
  131.         -default $style
  132.  
  133.     # ericm@scriptics.com:  set up tags, just like the menu items
  134.     foreach tag $tags {
  135.     lappend data(tags,$tag) $but
  136.     if { ![info exists data(tagstate,$tag)] } {
  137.         set data(tagstate,$tag) 0
  138.     }
  139.     }
  140.     set data(buttontags,$but) $tags
  141.     # ericm@scriptics.com
  142.  
  143.     set idx [expr {2*$data(nbuttons)}]
  144.     if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  145.         grid $but -column $idx -row 0 -sticky nsew
  146.         if { [Widget::getoption $path -homogeneous] } {
  147.             set req [winfo reqwidth $but]
  148.             if { $req > $data(max) } {
  149.                 for {set i 0} {$i < $data(nbuttons)} {incr i} {
  150.                     grid columnconfigure $path [expr {2*$i}] -minsize $req
  151.                 }
  152.                 set data(max) $req
  153.             }
  154.             grid columnconfigure $path $idx -minsize $data(max) -weight 1
  155.         } else {
  156.             grid columnconfigure $path $idx -weight 0
  157.         }
  158.         if { $data(nbuttons) > 0 } {
  159.             grid columnconfigure $path [expr {$idx-1}] -minsize $spacing
  160.         }
  161.     } else {
  162.         grid $but -column 0 -row $idx -sticky nsew
  163.         grid rowconfigure $path $idx -weight 0
  164.         if { $data(nbuttons) > 0 } {
  165.             grid rowconfigure $path [expr {$idx-1}] -minsize $spacing
  166.         }
  167.     }
  168.  
  169.     incr data(nbuttons)
  170.  
  171.     return $but
  172. }
  173.  
  174. # ::ButtonBox::setbuttonstate --
  175. #
  176. #    Set the state of a given button tag.  If this makes any buttons
  177. #       enable-able (ie, all of their tags are TRUE), enable them.
  178. #
  179. # Arguments:
  180. #    path        the button box widget name
  181. #    tag         the tag to modify
  182. #    state       the new state of $tag (0 or 1)
  183. #
  184. # Results:
  185. #    None.
  186.  
  187. proc ::ButtonBox::setbuttonstate {path tag state} {
  188.     variable $path
  189.     upvar 0  $path data
  190.     # First see if this is a real tag
  191.     if { [info exists data(tagstate,$tag)] } {
  192.     set data(tagstate,$tag) $state
  193.     foreach but $data(tags,$tag) {
  194.         set expression "1"
  195.         foreach buttontag $data(buttontags,$but) {
  196.         append expression " && $data(tagstate,$buttontag)"
  197.         }
  198.         if { [expr $expression] } {
  199.         set state normal
  200.         } else {
  201.         set state disabled
  202.         }
  203.         $but configure -state $state
  204.     }
  205.     }
  206.     return
  207. }
  208.  
  209. # ::ButtonBox::getbuttonstate --
  210. #
  211. #    Retrieve the state of a given button tag.
  212. #
  213. # Arguments:
  214. #    path        the button box widget name
  215. #    tag         the tag to modify
  216. #
  217. # Results:
  218. #    None.
  219.  
  220. proc ::ButtonBox::getbuttonstate {path tag} {
  221.     variable $path
  222.     upvar 0  $path data
  223.     # First see if this is a real tag
  224.     if { [info exists data(tagstate,$tag)] } {
  225.     return $data(tagstate,$tag)
  226.     } else {
  227.     error "unknown tag $tag"
  228.     }
  229. }
  230.  
  231. # ------------------------------------------------------------------------------
  232. #  Command ButtonBox::itemconfigure
  233. # ------------------------------------------------------------------------------
  234. proc ButtonBox::itemconfigure { path index args } {
  235.     if { [set idx [lsearch $args -default]] != -1 } {
  236.         set args [lreplace $args $idx [expr {$idx+1}]]
  237.     }
  238.     return [eval Button::configure $path.b[index $path $index] $args]
  239. }
  240.  
  241.  
  242. # ------------------------------------------------------------------------------
  243. #  Command ButtonBox::itemcget
  244. # ------------------------------------------------------------------------------
  245. proc ButtonBox::itemcget { path index option } {
  246.     return [Button::cget $path.b[index $path $index] $option]
  247. }
  248.  
  249.  
  250. # ------------------------------------------------------------------------------
  251. #  Command ButtonBox::setfocus
  252. # ------------------------------------------------------------------------------
  253. proc ButtonBox::setfocus { path index } {
  254.     set but $path.b[index $path $index]
  255.     if { [winfo exists $but] } {
  256.         focus $but
  257.     }
  258. }
  259.  
  260.  
  261. # ------------------------------------------------------------------------------
  262. #  Command ButtonBox::invoke
  263. # ------------------------------------------------------------------------------
  264. proc ButtonBox::invoke { path index } {
  265.     set but $path.b[index $path $index]
  266.     if { [winfo exists $but] } {
  267.         Button::invoke $but
  268.     }
  269. }
  270.  
  271.  
  272. # ------------------------------------------------------------------------------
  273. #  Command ButtonBox::index
  274. # ------------------------------------------------------------------------------
  275. proc ButtonBox::index { path index } {
  276.     if { ![string compare $index "default"] } {
  277.         set res [Widget::getoption $path -default]
  278.     } elseif { ![string compare $index "end"] || ![string compare $index "last"] } {
  279.         variable $path
  280.         upvar 0  $path data
  281.  
  282.         set res [expr {$data(nbuttons)-1}]
  283.     } else {
  284.         set res $index
  285.     }
  286.     return $res
  287. }
  288.  
  289.  
  290. # ------------------------------------------------------------------------------
  291. #  Command ButtonBox::_destroy
  292. # ------------------------------------------------------------------------------
  293. proc ButtonBox::_destroy { path } {
  294.     variable $path
  295.     upvar 0  $path data
  296.  
  297.     Widget::destroy $path
  298.     unset data
  299.     rename $path {}
  300. }
  301.  
  302. # ::ButtonBox::gettags --
  303. #
  304. #    Return a list of all the tags on all the buttons in a buttonbox.
  305. #
  306. # Arguments:
  307. #    path      the buttonbox to query.
  308. #
  309. # Results:
  310. #    taglist   a list of tags on the buttons in the buttonbox
  311.  
  312. proc ::ButtonBox::gettags {path} {
  313.     upvar ::ButtonBox::$path data
  314.     set taglist {}
  315.     foreach tag [array names data "tags,*"] {
  316.     lappend taglist [string range $tag 5 end]
  317.     }
  318.     return $taglist
  319. }
  320.  
  321.