home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / buttonbox.itk < prev    next >
Text File  |  2003-09-01  |  18KB  |  572 lines
  1. #
  2. # Buttonbox
  3. # ----------------------------------------------------------------------
  4. # Manages a framed area with Motif style buttons.  The button box can 
  5. # be configured either horizontally or vertically.  
  6. #
  7. # ----------------------------------------------------------------------
  8. #  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
  9. #          Bret A. Schuhmacher          EMAIL: bas@wn.com
  10. #
  11. #  @(#) $Id: buttonbox.itk,v 1.3 2001/08/15 18:30:53 smithc Exp $
  12. # ----------------------------------------------------------------------
  13. #            Copyright (c) 1995 DSC Technologies Corporation
  14. # ======================================================================
  15. # Permission to use, copy, modify, distribute and license this software 
  16. # and its documentation for any purpose, and without fee or written 
  17. # agreement with DSC, is hereby granted, provided that the above copyright 
  18. # notice appears in all copies and that both the copyright notice and 
  19. # warranty disclaimer below appear in supporting documentation, and that 
  20. # the names of DSC Technologies Corporation or DSC Communications 
  21. # Corporation not be used in advertising or publicity pertaining to the 
  22. # software without specific, written prior permission.
  23. # 
  24. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  25. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  26. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  27. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  28. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  29. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  30. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  31. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  32. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  33. # SOFTWARE.
  34. # ======================================================================
  35.  
  36. #
  37. # Usual options.
  38. #
  39. itk::usual Buttonbox {
  40.     keep -background -cursor -foreground
  41. }
  42.  
  43. # ------------------------------------------------------------------
  44. #                            BUTTONBOX
  45. # ------------------------------------------------------------------
  46. itcl::class iwidgets::Buttonbox {
  47.     inherit itk::Widget
  48.  
  49.     constructor {args} {}
  50.     destructor {}
  51.  
  52.     itk_option define -pady padY Pad 5
  53.     itk_option define -padx padX Pad 5
  54.     itk_option define -orient orient Orient "horizontal"
  55.     itk_option define -foreground foreground Foreground black
  56.     
  57.     public method index {args}
  58.     public method add {args}
  59.     public method insert {args}
  60.     public method delete {args}
  61.     public method default {args}
  62.     public method hide {args}
  63.     public method show {args}
  64.     public method invoke {args}
  65.     public method buttonconfigure {args}
  66.     public method buttoncget {index option}
  67.  
  68.     private method _positionButtons {}
  69.     private method _setBoxSize {{when later}}
  70.     private method _getMaxWidth {}
  71.     private method _getMaxHeight {}
  72.  
  73.     private variable _resizeFlag {}         ;# Flag for resize needed.
  74.     private variable _buttonList {}         ;# List of all buttons in box.
  75.     private variable _displayList {}        ;# List of displayed buttons.
  76.     private variable _unique 0              ;# Counter for button widget ids.
  77. }
  78.  
  79. namespace eval iwidgets::Buttonbox {
  80.     #
  81.     # Set up some class level bindings for map and configure events.
  82.     #
  83.     bind bbox-map <Map> [itcl::code %W _setBoxSize]
  84.     bind bbox-config <Configure> [itcl::code %W _positionButtons]
  85. }
  86.  
  87. #
  88. # Provide a lowercased access method for the Buttonbox class.
  89. # 
  90. proc ::iwidgets::buttonbox {pathName args} {
  91.     uplevel ::iwidgets::Buttonbox $pathName $args
  92. }
  93.     
  94. # ------------------------------------------------------------------
  95. #                        CONSTRUCTOR
  96. # ------------------------------------------------------------------
  97. itcl::body iwidgets::Buttonbox::constructor {args} {
  98.     # 
  99.     # Add Configure bindings for geometry management.  
  100.     #
  101.     bindtags $itk_component(hull) \
  102.         [linsert [bindtags $itk_component(hull)] 0 bbox-map]
  103.     bindtags $itk_component(hull) \
  104.         [linsert [bindtags $itk_component(hull)] 1 bbox-config]
  105.     
  106.     pack propagate $itk_component(hull) no
  107.     
  108.     #
  109.     # Initialize the widget based on the command line options.
  110.     #
  111.     eval itk_initialize $args
  112. }
  113.  
  114. # ------------------------------------------------------------------
  115. #                           DESTRUCTOR
  116. # ------------------------------------------------------------------
  117. itcl::body iwidgets::Buttonbox::destructor {} {
  118.     if {$_resizeFlag != ""} {after cancel $_resizeFlag}
  119. }
  120.  
  121. # ------------------------------------------------------------------
  122. #                             OPTIONS
  123. # ------------------------------------------------------------------
  124.  
  125. # ------------------------------------------------------------------
  126. # OPTION: -pady
  127. #
  128. # Pad the y space between the button box frame and the hull.
  129. # ------------------------------------------------------------------
  130. itcl::configbody iwidgets::Buttonbox::pady {
  131.     _setBoxSize
  132. }
  133.  
  134. # ------------------------------------------------------------------
  135. # OPTION: -padx
  136. #
  137. # Pad the x space between the button box frame and the hull.
  138. # ------------------------------------------------------------------
  139. itcl::configbody iwidgets::Buttonbox::padx {
  140.     _setBoxSize
  141. }
  142.  
  143. # ------------------------------------------------------------------
  144. # OPTION: -orient
  145. #
  146. # Position buttons either horizontally or vertically.
  147. # ------------------------------------------------------------------
  148. itcl::configbody iwidgets::Buttonbox::orient {
  149.     switch $itk_option(-orient) {
  150.     "horizontal" -
  151.     "vertical" {
  152.         _setBoxSize
  153.     }
  154.     
  155.     default {
  156.         error "bad orientation option \"$itk_option(-orient)\",\
  157.             should be either horizontal or vertical"
  158.     }
  159.     }
  160. }
  161.  
  162. # ------------------------------------------------------------------
  163. #                            METHODS
  164. # ------------------------------------------------------------------
  165.  
  166. # ------------------------------------------------------------------
  167. # METHOD: index index
  168. #
  169. # Searches the buttons in the box for the one with the requested tag,
  170. # numerical index, keyword "end" or "default".  Returns the button's 
  171. # tag if found, otherwise error.
  172. # ------------------------------------------------------------------    
  173. itcl::body iwidgets::Buttonbox::index {index} {
  174.     if {[llength $_buttonList] > 0} {
  175.     if {[regexp {(^[0-9]+$)} $index]} {
  176.         if {$index < [llength $_buttonList]} {
  177.         return $index
  178.         } else {
  179.         error "Buttonbox index \"$index\" is out of range"
  180.         }
  181.         
  182.     } elseif {$index == "end"} {
  183.         return [expr {[llength $_buttonList] - 1}]
  184.         
  185.     } elseif {$index == "default"} {
  186.         foreach knownButton $_buttonList {
  187.         if {[$itk_component($knownButton) cget -defaultring]} {
  188.             return [lsearch -exact $_buttonList $knownButton]
  189.         }
  190.         }
  191.         
  192.         error "Buttonbox \"$itk_component(hull)\" has no default"
  193.         
  194.     } else {
  195.         if {[set idx [lsearch $_buttonList $index]] != -1} {
  196.         return $idx
  197.         }
  198.         
  199.         error "bad Buttonbox index \"$index\": must be number, end,\
  200.             default, or pattern"
  201.     }
  202.     
  203.     } else {
  204.     error "Buttonbox \"$itk_component(hull)\" has no buttons"
  205.     }
  206. }
  207.  
  208. # ------------------------------------------------------------------
  209. # METHOD: add tag ?option value option value ...?
  210. #
  211. # Add the specified button to the button box.  All PushButton options
  212. # are allowed.  New buttons are added to the list of buttons and the 
  213. # list of displayed buttons.  The PushButton path name is returned.
  214. # ------------------------------------------------------------------
  215. itcl::body iwidgets::Buttonbox::add {tag args} {
  216.     itk_component add $tag {
  217.     iwidgets::Pushbutton $itk_component(hull).[incr _unique]
  218.     } {
  219.     usual
  220.     rename -highlightbackground -background background Background
  221.     }
  222.     
  223.     if {$args != ""} {
  224.     uplevel $itk_component($tag) configure $args
  225.     }
  226.     
  227.     lappend _buttonList $tag
  228.     lappend _displayList $tag
  229.     
  230.     _setBoxSize
  231. }
  232.  
  233. # ------------------------------------------------------------------
  234. # METHOD: insert index tag ?option value option value ...?
  235. #
  236. # Insert the specified button in the button box just before the one 
  237. # given by index.  All PushButton options are allowed.  New buttons 
  238. # are added to the list of buttons and the list of displayed buttons.
  239. # The PushButton path name is returned.
  240. # ------------------------------------------------------------------
  241. itcl::body iwidgets::Buttonbox::insert {index tag args} {
  242.     itk_component add $tag {
  243.     iwidgets::Pushbutton $itk_component(hull).[incr _unique]
  244.     } {
  245.     usual
  246.     rename -highlightbackground -background background Background
  247.     }
  248.     
  249.     if {$args != ""} {
  250.     uplevel $itk_component($tag) configure $args
  251.     }
  252.     
  253.     set index [index $index]
  254.     set _buttonList [linsert $_buttonList $index $tag]
  255.     set _displayList [linsert $_displayList $index $tag]
  256.     
  257.     _setBoxSize
  258. }
  259.  
  260. # ------------------------------------------------------------------
  261. # METHOD: delete index
  262. #
  263. # Delete the specified button from the button box.
  264. # ------------------------------------------------------------------
  265. itcl::body iwidgets::Buttonbox::delete {index} {
  266.     set index [index $index]
  267.     set tag [lindex $_buttonList $index]
  268.     
  269.     destroy $itk_component($tag)
  270.     
  271.     set _buttonList [lreplace $_buttonList $index $index]
  272.     
  273.     if {[set dind [lsearch $_displayList $tag]] != -1} {
  274.     set _displayList [lreplace $_displayList $dind $dind]
  275.     }
  276.     
  277.     _setBoxSize
  278.     update idletasks
  279. }
  280.  
  281. # ------------------------------------------------------------------
  282. # METHOD: default index
  283. #
  284. # Sets the default to the push button given by index.
  285. # ------------------------------------------------------------------
  286. itcl::body iwidgets::Buttonbox::default {index} {
  287.     set index [index $index]
  288.     
  289.     set defbtn [lindex $_buttonList $index]
  290.     
  291.     foreach knownButton $_displayList {
  292.     if {$knownButton == $defbtn} {
  293.         $itk_component($knownButton) configure -defaultring yes
  294.     } else {
  295.         $itk_component($knownButton) configure -defaultring no
  296.     }
  297.     }
  298. }
  299.  
  300. # ------------------------------------------------------------------
  301. # METHOD: hide index
  302. #
  303. # Hide the push button given by index.  This doesn't remove the button 
  304. # permanently from the display list, just inhibits its display.
  305. # ------------------------------------------------------------------
  306. itcl::body iwidgets::Buttonbox::hide {index} {
  307.     set index [index $index]
  308.     set tag [lindex $_buttonList $index]
  309.     
  310.     if {[set dind [lsearch $_displayList $tag]] != -1} {
  311.     place forget $itk_component($tag)
  312.     set _displayList [lreplace $_displayList $dind $dind] 
  313.     
  314.     _setBoxSize
  315.     }
  316. }
  317.  
  318. # ------------------------------------------------------------------
  319. # METHOD: show index
  320. #
  321. # Displays a previously hidden push button given by index.  Check if 
  322. # the button is already in the display list.  If not then add it back 
  323. # at it's original location and redisplay.
  324. # ------------------------------------------------------------------
  325. itcl::body iwidgets::Buttonbox::show {index} {
  326.     set index [index $index]
  327.     set tag [lindex $_buttonList $index]
  328.     
  329.     if {[lsearch $_displayList $tag] == -1} {
  330.     set _displayList [linsert $_displayList $index $tag]
  331.     
  332.     _setBoxSize
  333.     }
  334. }
  335.  
  336. # ------------------------------------------------------------------
  337. # METHOD: invoke ?index?
  338. #
  339. # Invoke the command associated with a push button.  If no arguments
  340. # are given then the default button is invoked, otherwise the argument
  341. # is expected to be a button index.
  342. # ------------------------------------------------------------------
  343. itcl::body iwidgets::Buttonbox::invoke {args} {
  344.     if {[llength $args] == 0} {
  345.     $itk_component([lindex $_buttonList [index default]]) invoke
  346.     
  347.     } else {
  348.     $itk_component([lindex $_buttonList [index [lindex $args 0]]]) \
  349.         invoke
  350.     }
  351. }
  352.  
  353. # ------------------------------------------------------------------
  354. # METHOD: buttonconfigure index ?option? ?value option value ...?
  355. #
  356. # Configure a push button given by index.  This method allows 
  357. # configuration of pushbuttons from the Buttonbox level.  The options
  358. # may have any of the values accepted by the add method.
  359. # ------------------------------------------------------------------
  360. itcl::body iwidgets::Buttonbox::buttonconfigure {index args} {
  361.     set tag [lindex $_buttonList [index $index]]
  362.     
  363.     set retstr [uplevel $itk_component($tag) configure $args]
  364.     
  365.     _setBoxSize
  366.     
  367.     return $retstr
  368. }
  369.  
  370. # ------------------------------------------------------------------
  371. # METHOD: buttonccget index option
  372. #
  373. # Return value of option for push button given by index.  Option may
  374. # have any of the values accepted by the add method.
  375. # ------------------------------------------------------------------
  376. itcl::body iwidgets::Buttonbox::buttoncget {index option} {
  377.     set tag [lindex $_buttonList [index $index]]
  378.     
  379.     set retstr [uplevel $itk_component($tag) cget [list $option]]
  380.     
  381.     return $retstr
  382. }
  383.  
  384. # -----------------------------------------------------------------
  385. # PRIVATE METHOD: _getMaxWidth
  386. #
  387. # Returns the required width of the largest button.
  388. # -----------------------------------------------------------------
  389. itcl::body iwidgets::Buttonbox::_getMaxWidth {} {
  390.     set max 0
  391.     
  392.     foreach tag $_displayList {
  393.     set w [winfo reqwidth $itk_component($tag)]
  394.     
  395.     if {$w > $max} {
  396.         set max $w
  397.     }
  398.     }
  399.     
  400.     return $max
  401. }
  402.  
  403. # -----------------------------------------------------------------
  404. # PRIVATE METHOD: _getMaxHeight
  405. #
  406. # Returns the required height of the largest button.
  407. # -----------------------------------------------------------------
  408. itcl::body iwidgets::Buttonbox::_getMaxHeight {} {
  409.     set max 0
  410.     
  411.     foreach tag $_displayList {
  412.     set h [winfo reqheight $itk_component($tag)]
  413.     
  414.     if {$h > $max} {
  415.         set max $h
  416.     }
  417.     }
  418.     
  419.     return $max
  420. }
  421.  
  422. # ------------------------------------------------------------------
  423. # METHOD: _setBoxSize ?when?
  424. #
  425. # Sets the proper size of the frame surrounding all the buttons.
  426. # If "when" is "now", the change is applied immediately.  If it is 
  427. # "later" or it is not specified, then the change is applied later, 
  428. # when the application is idle.
  429. # ------------------------------------------------------------------
  430. itcl::body iwidgets::Buttonbox::_setBoxSize {{when later}} {
  431.     if {[winfo ismapped $itk_component(hull)]} {
  432.     if {$when == "later"} {
  433.         if {$_resizeFlag == ""} {
  434.         set _resizeFlag [after idle [itcl::code $this _setBoxSize now]]
  435.         }
  436.         return
  437.     } elseif {$when != "now"} {
  438.         error "bad option \"$when\": should be now or later"
  439.     }
  440.  
  441.     set _resizeFlag ""
  442.  
  443.     set numBtns [llength $_displayList]
  444.     
  445.     if {$itk_option(-orient) == "horizontal"} {
  446.         set minw [expr {$numBtns * [_getMaxWidth] \
  447.             + ($numBtns+1) * $itk_option(-padx)}]
  448.         set minh [expr {[_getMaxHeight] + 2 * $itk_option(-pady)}]
  449.         
  450.     } else {
  451.         set minw [expr {[_getMaxWidth] + 2 * $itk_option(-padx)}]
  452.         set minh [expr {$numBtns * [_getMaxHeight] \
  453.             + ($numBtns+1) * $itk_option(-pady)}]
  454.     }
  455.     
  456.     #
  457.     # Remove the configure event bindings on the hull while we adjust the
  458.     # width/height and re-position the buttons.  Once we're through, we'll
  459.     # update and reinstall them.  This prevents double calls to position
  460.     # the buttons.
  461.     #
  462.     set tags [bindtags $itk_component(hull)]
  463.     if {[set i [lsearch $tags bbox-config]] != -1} {
  464.         set tags [lreplace $tags $i $i]
  465.         bindtags $itk_component(hull) $tags
  466.     }
  467.     
  468.     component hull configure -width $minw -height $minh
  469.     
  470.     update idletasks
  471.         
  472.     _positionButtons
  473.     
  474.     bindtags $itk_component(hull) [linsert $tags 0 bbox-config]
  475.     }
  476. }
  477.     
  478. # ------------------------------------------------------------------
  479. # METHOD: _positionButtons
  480. # 
  481. # This method is responsible setting the width/height of all the 
  482. # displayed buttons to the same value and for placing all the buttons
  483. # in equidistant locations.
  484. # ------------------------------------------------------------------
  485. itcl::body iwidgets::Buttonbox::_positionButtons {} {
  486.     set bf $itk_component(hull)
  487.     set numBtns [llength $_displayList]
  488.     
  489.     # 
  490.     # First, determine the common width and height for all the 
  491.     # displayed buttons.
  492.     #
  493.     if {$numBtns > 0} {
  494.     set bfWidth [winfo width $itk_component(hull)]
  495.     set bfHeight [winfo height $itk_component(hull)]
  496.     
  497.     if {$bfWidth >= [winfo reqwidth $itk_component(hull)]} {
  498.         set _btnWidth [_getMaxWidth] 
  499.         
  500.     } else {
  501.         if {$itk_option(-orient) == "horizontal"} {
  502.         set _btnWidth [expr {$bfWidth / $numBtns}]
  503.         } else {
  504.         set _btnWidth $bfWidth
  505.         }
  506.     }        
  507.     
  508.     if {$bfHeight >= [winfo reqheight $itk_component(hull)]} {
  509.         set _btnHeight [_getMaxHeight]
  510.         
  511.     } else {
  512.         if {$itk_option(-orient) == "vertical"} {
  513.         set _btnHeight [expr {$bfHeight / $numBtns}]
  514.         } else {
  515.         set _btnHeight $bfHeight
  516.         }
  517.     }        
  518.     }
  519.     
  520.     #
  521.     # Place the buttons at the proper locations.
  522.     #
  523.     if {$numBtns > 0} {
  524.     if {$itk_option(-orient) == "horizontal"} {
  525.         set leftover [expr {[winfo width $bf] \
  526.             - 2 * $itk_option(-padx) - $_btnWidth * $numBtns}]
  527.         
  528.         if {$numBtns > 0} {
  529.         set offset [expr {$leftover / ($numBtns + 1)}]
  530.         } else {
  531.         set offset 0
  532.         }
  533.         if {$offset < 0} {set offset 0}
  534.         
  535.         set xDist [expr {$itk_option(-padx) + $offset}]
  536.         set incrAmount [expr {$_btnWidth + $offset}]
  537.         
  538.         foreach button $_displayList {
  539.         place $itk_component($button) -anchor w \
  540.             -x $xDist -rely .5 -y 0 -relx 0 \
  541.             -width $_btnWidth -height $_btnHeight
  542.         
  543.         set xDist [expr {$xDist + $incrAmount}]
  544.         }
  545.         
  546.     } else {
  547.         set leftover [expr {[winfo height $bf] \
  548.             - 2 * $itk_option(-pady) - $_btnHeight * $numBtns}]
  549.         
  550.         if {$numBtns > 0} {
  551.         set offset [expr {$leftover / ($numBtns + 1)}]
  552.         } else {
  553.         set offset 0
  554.         }
  555.         if {$offset < 0} {set offset 0}
  556.         
  557.         set yDist [expr {$itk_option(-pady) + $offset}]
  558.         set incrAmount [expr {$_btnHeight + $offset}]
  559.         
  560.         foreach button $_displayList {
  561.         place $itk_component($button) -anchor n \
  562.             -y $yDist -relx .5 -x 0 -rely 0 \
  563.             -width $_btnWidth -height $_btnHeight
  564.         
  565.         set yDist [expr {$yDist + $incrAmount}]
  566.         }
  567.     }
  568.     }
  569. }
  570.  
  571.  
  572.