home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets2.2.0 / scripts / optionmenu.itk < prev    next >
Text File  |  1999-02-24  |  21KB  |  635 lines
  1. #
  2. # Optionmenu
  3. # ----------------------------------------------------------------------
  4. # Implements an option menu widget with options to manage it. 
  5. # An option menu displays a frame containing a label and a button.
  6. # A pop-up menu will allow for the value of the button to change. 
  7. #
  8. # ----------------------------------------------------------------------
  9. #  AUTHOR:  Alfredo Jahn             Phone: (214) 519-3545
  10. #                                    Email: ajahn@spd.dsccc.com
  11. #                                           alfredo@wn.com
  12. #
  13. #  @(#) $Id: optionmenu.itk,v 1.2 1998/08/11 14:46:40 welch Exp $
  14. # ----------------------------------------------------------------------
  15. #            Copyright (c) 1995 DSC Technologies Corporation
  16. # ======================================================================
  17. # Permission to use, copy, modify, distribute and license this software 
  18. # and its documentation for any purpose, and without fee or written 
  19. # agreement with DSC, is hereby granted, provided that the above copyright 
  20. # notice appears in all copies and that both the copyright notice and 
  21. # warranty disclaimer below appear in supporting documentation, and that 
  22. # the names of DSC Technologies Corporation or DSC Communications 
  23. # Corporation not be used in advertising or publicity pertaining to the 
  24. # software without specific, written prior permission.
  25. # 
  26. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  27. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  28. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  29. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  30. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  31. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  32. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  33. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  34. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  35. # SOFTWARE.
  36. # ======================================================================
  37.  
  38. #
  39. # Default resources.
  40. #
  41.  
  42. option add *Optionmenu.highlightThickness    1    widgetDefault
  43. option add *Optionmenu.borderWidth        2    widgetDefault
  44. option add *Optionmenu.labelPos            w    widgetDefault
  45. option add *Optionmenu.labelMargin        2    widgetDefault
  46. option add *Optionmenu.popupCursor        arrow    widgetDefault
  47.  
  48. #
  49. # Usual options.
  50. #
  51. itk::usual Optionmenu {
  52.     keep -activebackground -activeborderwidth -activeforeground \
  53.      -background -borderwidth -cursor -disabledforeground -font \
  54.      -foreground -highlightcolor -highlightthickness -labelfont \
  55.      -popupcursor
  56. }
  57.  
  58. # ------------------------------------------------------------------
  59. #                            OPTONMENU
  60. # ------------------------------------------------------------------
  61. class iwidgets::Optionmenu {
  62.     inherit iwidgets::Labeledwidget
  63.     
  64.     constructor {args} {}
  65.     destructor {}
  66.  
  67.     itk_option define -clicktime clickTime ClickTime 150
  68.     itk_option define -command command Command {}
  69.     itk_option define -cyclicon cyclicOn CyclicOn true
  70.     itk_option define -width width Width 0
  71.     itk_option define -font font Font -Adobe-Helvetica-Bold-R-Normal--*-120-*
  72.     itk_option define -items items Items ""
  73.     itk_option define -borderwidth borderWidth BorderWidth 2
  74.     itk_option define -highlightthickness highlightThickness HighlightThickness 1
  75.     itk_option define -state state State normal
  76.  
  77.     public {
  78.       method index {index} 
  79.       method delete {first {last {}}} 
  80.       method disable {index} 
  81.       method enable {args} 
  82.       method get {} 
  83.       method insert {index string args} 
  84.       method popupMenu {args} 
  85.       method select {index} 
  86.       method sort {{mode "increasing"}} 
  87.     }
  88.  
  89.     protected {
  90.       variable _calcSize ""  ;# non-null => _calcSize pending
  91.     }
  92.  
  93.     private {
  94.       method _buttonRelease {time} 
  95.       method _getNextItem {index} 
  96.       method _next {} 
  97.       method _postMenu {time} 
  98.       method _previous {} 
  99.       method _setItem {item} 
  100.       method _setSize {{when later}} 
  101.       method _setitems {items} ;# Set the list of menu entries
  102.  
  103.       variable _postTime 0
  104.       variable _items {}       ;# List of popup menu entries
  105.       variable _numitems 0     ;# List of popup menu entries
  106.  
  107.       variable _currentItem "" ;# Active menu selection
  108.     }
  109. }
  110.  
  111. #
  112. # Provide a lowercased access method for the Optionmenu class.
  113. # 
  114. proc ::iwidgets::optionmenu {pathName args} {
  115.     uplevel ::iwidgets::Optionmenu $pathName $args
  116. }
  117.  
  118. # ------------------------------------------------------------------
  119. #                        CONSTRUCTOR
  120. # ------------------------------------------------------------------
  121. body iwidgets::Optionmenu::constructor {args} {
  122.     global tcl_platform
  123.  
  124.     component hull configure -highlightthickness 0
  125.  
  126.     itk_component add menuBtn {
  127.     menubutton $itk_interior.menuBtn -relief raised -indicator on \
  128.             -textvariable [scope _currentItem] -takefocus 1 \
  129.             -menu $itk_interior.menuBtn.menu
  130.     } {
  131.         usual
  132.     keep -borderwidth
  133.         if {$tcl_platform(platform) != "unix"} {
  134.             ignore -activebackground -activeforeground
  135.         }
  136.     }
  137.     pack $itk_interior.menuBtn -fill x
  138.     pack propagate $itk_interior no
  139.  
  140.     itk_component add popupMenu {
  141.     menu $itk_interior.menuBtn.menu -tearoff no
  142.     } {
  143.     usual
  144.     ignore -tearoff
  145.     keep -activeborderwidth -borderwidth
  146.     rename -cursor -popupcursor popupCursor Cursor
  147.     }
  148.  
  149.     #
  150.     # Bind to button release for all components.
  151.     #
  152.     bind $itk_component(menuBtn) <ButtonPress-1> \
  153.         "[code $this _postMenu %t]; break"
  154.     bind $itk_component(menuBtn) <KeyPress-space> \
  155.         "[code $this _postMenu %t]; break"
  156.     bind $itk_component(popupMenu) <ButtonRelease-1> \
  157.         [code $this _buttonRelease %t]
  158.  
  159.     #
  160.     # Initialize the widget based on the command line options.
  161.     #
  162.     eval itk_initialize $args
  163. }
  164.  
  165. # ------------------------------------------------------------------
  166. #                           DESTRUCTOR
  167. # ------------------------------------------------------------------
  168. body iwidgets::Optionmenu::destructor {} {
  169.     if {$_calcSize != ""} {after cancel $_calcSize}
  170. }
  171.  
  172. # ------------------------------------------------------------------
  173. #                             OPTIONS
  174. # ------------------------------------------------------------------
  175.  
  176. # ------------------------------------------------------------------
  177. # OPTION -clicktime
  178. #
  179. # Interval time (in msec) used to determine that a single mouse 
  180. # click has occurred. Used to post menu on a quick mouse click.
  181. # **WARNING** changing this value may cause the sigle-click 
  182. # functionality to not work properly!
  183. # ------------------------------------------------------------------
  184. configbody iwidgets::Optionmenu::clicktime {}
  185.  
  186. # ------------------------------------------------------------------
  187. # OPTION -command
  188. #
  189. # Specifies a command to be evaluated upon change in option menu.
  190. # ------------------------------------------------------------------
  191. configbody iwidgets::Optionmenu::command {}
  192.  
  193. # ------------------------------------------------------------------
  194. # OPTION -cyclicon
  195. #
  196. # Turns on/off the 3rd mouse button capability. This feature
  197. # allows the right mouse button to cycle through the popup 
  198. # menu list without poping it up. <shift>M3 cycles through
  199. # the menu in reverse order.
  200. # ------------------------------------------------------------------
  201. configbody iwidgets::Optionmenu::cyclicon {
  202.     if {$itk_option(-cyclicon)} {
  203.         bind $itk_component(menuBtn) <3> [code $this _next]
  204.         bind $itk_component(menuBtn) <Shift-3> [code $this _previous]
  205.         bind $itk_component(menuBtn) <KeyPress-Down> [code $this _next]
  206.         bind $itk_component(menuBtn) <KeyPress-Up> [code $this _previous]
  207.     } else {
  208.         bind $itk_component(menuBtn) <3> break
  209.         bind $itk_component(menuBtn) <Shift-3> break
  210.         bind $itk_component(menuBtn) <KeyPress-Down> break
  211.         bind $itk_component(menuBtn) <KeyPress-Up> break
  212.     }
  213. }
  214.  
  215. # ------------------------------------------------------------------
  216. # OPTION -width
  217. #
  218. # Allows the menu label width to be set to a fixed size
  219. # ------------------------------------------------------------------
  220. configbody iwidgets::Optionmenu::width {
  221.     _setSize
  222. }
  223.  
  224. # ------------------------------------------------------------------
  225. # OPTION -font
  226. #
  227. # Change all fonts for this widget. Also re-calculate height based
  228. # on font size (used to line up menu items over menu button label).
  229. # ------------------------------------------------------------------
  230. configbody iwidgets::Optionmenu::font {
  231.     _setSize
  232. }
  233.  
  234. # ------------------------------------------------------------------
  235. # OPTION -items
  236. #
  237. # Create a list of items available on the menu. Used to create the
  238. # popup menu.
  239. # ------------------------------------------------------------------
  240. configbody iwidgets::Optionmenu::items {
  241.     _setitems $itk_option(-items)
  242. }
  243.  
  244. # ------------------------------------------------------------------
  245. # OPTION -borderwidth
  246. #
  247. # Change borderwidth for this widget. Also re-calculate height based
  248. # on font size (used to line up menu items over menu button label).
  249. # ------------------------------------------------------------------
  250. configbody iwidgets::Optionmenu::borderwidth {
  251.     _setSize
  252. }
  253.  
  254. # ------------------------------------------------------------------
  255. # OPTION -highlightthickness
  256. #
  257. # Change highlightthickness for this widget. Also re-calculate
  258. # height based on font size (used to line up menu items over
  259. # menu button label).
  260. # ------------------------------------------------------------------
  261. configbody iwidgets::Optionmenu::highlightthickness {
  262.     _setSize
  263. }
  264.  
  265. # ------------------------------------------------------------------
  266. # OPTION -state
  267. #
  268. # Specified one of two states for the Optionmenu: normal, or
  269. # disabled.  If the Optionmenu is disabled, then option menu
  270. # selection is ignored.
  271. # ------------------------------------------------------------------
  272. configbody iwidgets::Optionmenu::state {
  273.     switch $itk_option(-state) {
  274.         normal {
  275.             $itk_component(menuBtn) config -state normal
  276.             $itk_component(label) config -fg $itk_option(-foreground)
  277.         } 
  278.         disabled {
  279.             $itk_component(menuBtn) config -state disabled
  280.             $itk_component(label) config -fg $itk_option(-disabledforeground)
  281.         }
  282.         default {
  283.             error "bad state option \"$itk_option(-state)\":\
  284.             should be disabled or normal"
  285.         }
  286.     }
  287. }
  288.  
  289. # ------------------------------------------------------------------
  290. #                            METHODS
  291. # ------------------------------------------------------------------
  292.  
  293. # ------------------------------------------------------------------
  294. # METHOD: index index
  295. #
  296. # Return the numerical index corresponding to index.
  297. # ------------------------------------------------------------------
  298. body iwidgets::Optionmenu::index {index} {
  299.  
  300.     if {[regexp {(^[0-9]+$)} $index]} {
  301.     set idx [$itk_component(popupMenu) index $index]
  302.  
  303.     if {$idx == "none"} {
  304.         return 0
  305.     }
  306.     return [expr {$index > $idx ? $_numitems : $idx}]
  307.     
  308.     } elseif {$index == "end"} {
  309.     return $_numitems
  310.     
  311.     } elseif {$index == "select"} {
  312.     return [lsearch $_items $_currentItem]
  313.     
  314.     }
  315.  
  316.     set numValue [lsearch -glob $_items $index]
  317.  
  318.     if {$numValue == -1} {
  319.         error "bad Optionmenu index \"$index\""
  320.     }
  321.     return $numValue
  322. }
  323.  
  324. # ------------------------------------------------------------------
  325. # METHOD: delete first ?last?
  326. #
  327. # Remove an item (or range of items) from the popup menu. 
  328. # ------------------------------------------------------------------
  329. body iwidgets::Optionmenu::delete {first {last {}}} {
  330.  
  331.     set first [index $first]
  332.     set last [expr {$last != {} ? [index $last] : $first}]    
  333.     set nextAvail $_currentItem
  334.     
  335.     #
  336.     # If current item is in delete range point to next available.
  337.     #
  338.     if {$_numitems > 1 &&
  339.     ([lsearch -exact [lrange $_items $first $last] [get]] != -1)} {
  340.     set nextAvail [_getNextItem $last]
  341.     }
  342.     
  343.     _setitems [lreplace $_items $first $last]
  344.     
  345.     #
  346.     # Make sure "nextAvail" is still in the list.
  347.     #
  348.     set index [lsearch -exact $_items $nextAvail]
  349.     _setItem [expr {$index != -1 ? $nextAvail : ""}]
  350. }
  351.  
  352. # ------------------------------------------------------------------
  353. # METHOD: disable index
  354. #
  355. # Disable a menu item in the option menu.  This will prevent the user
  356. # from being able to select this item from the menu.  This only effects
  357. # the state of the item in the menu, in other words, should the item
  358. # be the currently selected item, the user is responsible for 
  359. # determining this condition and taking appropriate action.
  360. # ------------------------------------------------------------------
  361. body iwidgets::Optionmenu::disable {index} {
  362.     set index [index $index]
  363.     $itk_component(popupMenu) entryconfigure $index -state disabled
  364. }
  365.  
  366. # ------------------------------------------------------------------
  367. # METHOD: enable index
  368. #
  369. # Enable a menu item in the option menu.  This will allow the user
  370. # to select this item from the menu.  
  371. # ------------------------------------------------------------------
  372. body iwidgets::Optionmenu::enable {index} {
  373.     set index [index $index]
  374.     $itk_component(popupMenu) entryconfigure $index -state normal
  375. }
  376.  
  377. # ------------------------------------------------------------------
  378. # METHOD: get
  379. #
  380. # Returns the current menu item.
  381. # ------------------------------------------------------------------
  382. body iwidgets::Optionmenu::get {} {
  383.     return $_currentItem
  384. }
  385.  
  386. # ------------------------------------------------------------------
  387. # METHOD: insert index string ?string?
  388. #
  389. # Insert an item in the popup menu.
  390. # ------------------------------------------------------------------
  391. body iwidgets::Optionmenu::insert {index string args} {
  392.     set index [index $index]
  393.     set args [linsert $args 0 $string]
  394.     _setitems [eval linsert {$_items} $index $args]
  395.     return ""
  396. }
  397.  
  398. # ------------------------------------------------------------------
  399. # METHOD: select index
  400. #
  401. # Select an item from the popup menu to display on the menu label
  402. # button. 
  403. # ------------------------------------------------------------------
  404. body iwidgets::Optionmenu::select {index} {
  405.     set index [index $index]
  406.     _setItem [lindex $_items $index]
  407. }
  408.  
  409. # ------------------------------------------------------------------
  410. # METHOD: popupMenu
  411. #
  412. # Evaluates the specified args against the popup menu component
  413. # and returns the result.
  414. # ------------------------------------------------------------------
  415. body iwidgets::Optionmenu::popupMenu {args} {
  416.     return [eval $itk_component(popupMenu) $args]    
  417. }
  418.  
  419. # ------------------------------------------------------------------
  420. # METHOD: sort mode
  421. #
  422. # Sort the current menu in either "ascending" or "descending" order.
  423. # ------------------------------------------------------------------
  424. body iwidgets::Optionmenu::sort {{mode "increasing"}} {
  425.     switch $mode {
  426.     ascending -
  427.     increasing {
  428.         _setitems [lsort -increasing $_items]
  429.     }
  430.     descending -
  431.     decreasing {
  432.         _setitems [lsort -decreasing $_items]
  433.     }
  434.     default {
  435.         error "bad sort argument \"$mode\": should be ascending,\
  436.             descending, increasing, or decreasing"
  437.     }
  438.     }
  439.     return ""
  440. }
  441.  
  442. # ------------------------------------------------------------------
  443. # PRIVATE METHOD: _buttonRelease
  444. #
  445. # Display the popup menu. Menu position is calculated.
  446. # ------------------------------------------------------------------
  447. body iwidgets::Optionmenu::_buttonRelease {time} {
  448.     if {[expr abs([expr $_postTime - $time])] <= $itk_option(-clicktime)} {
  449.         return -code break
  450.     }
  451. }
  452.  
  453. # ------------------------------------------------------------------
  454. # PRIVATE METHOD: _getNextItem index
  455. #
  456. # Allows either a string or index number to be passed in, and returns
  457. # the next item in the list in string format. Wrap around is automatic.
  458. # ------------------------------------------------------------------
  459. body iwidgets::Optionmenu::_getNextItem {index} {
  460.  
  461.     if {[incr index] >= $_numitems} {
  462.     set index 0   ;# wrap around
  463.     }
  464.     return [lindex $_items $index]
  465. }
  466.  
  467. # ------------------------------------------------------------------
  468. # PRIVATE METHOD: _next
  469. #
  470. # Sets the current option label to next item in list if that item is
  471. # not disbaled.
  472. # ------------------------------------------------------------------
  473. body iwidgets::Optionmenu::_next {} {
  474.     if {$itk_option(-state) != "normal"} {
  475.         return
  476.     }
  477.     set i [lsearch -exact $_items $_currentItem]
  478.     
  479.     for {set cnt 0} {$cnt < $_numitems} {incr cnt} {
  480.  
  481.         if {[incr i] >= $_numitems} {
  482.             set i 0
  483.         }
  484.         
  485.         if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} {
  486.             _setItem [lindex $_items $i]
  487.             break
  488.         }
  489.     }
  490. }
  491.  
  492. # ------------------------------------------------------------------
  493. # PRIVATE METHOD: _previous
  494. #
  495. # Sets the current option label to previous item in list if that 
  496. # item is not disbaled.
  497. # ------------------------------------------------------------------
  498. body iwidgets::Optionmenu::_previous {} {
  499.     if {$itk_option(-state) != "normal"} {
  500.         return
  501.     }
  502.  
  503.     set i [lsearch -exact $_items $_currentItem]
  504.     
  505.     for {set cnt 0} {$cnt < $_numitems} {incr cnt} {
  506.     set i [expr $i - 1]
  507.     
  508.     if {$i < 0} {
  509.         set i [expr $_numitems - 1]
  510.     }
  511.  
  512.     if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} {
  513.         _setItem [lindex $_items $i]
  514.         break
  515.     }
  516.     }
  517. }
  518.  
  519. # ------------------------------------------------------------------
  520. # PRIVATE METHOD: _postMenu time
  521. #
  522. # Display the popup menu. Menu position is calculated.
  523. # ------------------------------------------------------------------
  524. body iwidgets::Optionmenu::_postMenu {time} {
  525.     #
  526.     # Don't bother to post if menu is empty.
  527.     #
  528.     if {[llength $_items] > 0 && $itk_option(-state) == "normal"} {
  529.         set _postTime $time
  530.         set itemIndex [lsearch -exact $_items $_currentItem]
  531.  
  532.         set margin [expr $itk_option(-borderwidth) \
  533.             + $itk_option(-highlightthickness)]
  534.  
  535.         set x [expr [winfo rootx $itk_component(menuBtn)] + $margin]
  536.         set y [expr [winfo rooty $itk_component(menuBtn)] \
  537.             - [$itk_component(popupMenu) yposition $itemIndex] + $margin]
  538.  
  539.         tk_popup $itk_component(popupMenu) $x $y
  540.     }
  541. }
  542.  
  543. # ------------------------------------------------------------------
  544. # PRIVATE METHOD: _setItem
  545. #
  546. # Set the menu button label to item, then dismiss the popup menu.
  547. # Also check if item has been changed. If so, also call user-supplied
  548. # command.
  549. # ------------------------------------------------------------------
  550. body iwidgets::Optionmenu::_setItem {item} {
  551.     if {$_currentItem != $item} {
  552.         set _currentItem $item
  553.     if {[winfo ismapped $itk_component(hull)]} {
  554.         uplevel #0 $itk_option(-command)
  555.     }
  556.     }
  557. }
  558.  
  559. # ------------------------------------------------------------------
  560. # PRIVATE METHOD: _setitems items
  561. #
  562. # Create a list of items available on the menu. Used to create the
  563. # popup menu.
  564. # ------------------------------------------------------------------
  565. body iwidgets::Optionmenu::_setitems {items_} {
  566.  
  567.     #
  568.     # Delete the old menu entries, and set the new list of
  569.     # menu entries to those specified in "items_".
  570.     #
  571.     $itk_component(popupMenu) delete 0 last
  572.     set _items ""
  573.     set _numitems [llength $items_]
  574.  
  575.     #
  576.     # Clear the menu button label.
  577.     #
  578.     if {$_numitems == 0} {
  579.     _setItem ""
  580.     return
  581.     }
  582.  
  583.     set savedCurrentItem $_currentItem
  584.     
  585.     foreach opt $items_ {
  586.         lappend _items $opt
  587.         $itk_component(popupMenu) add command -label " $opt " \
  588.             -command [code $this _setItem $opt]
  589.     }
  590.     set first [lindex $_items 0]
  591.     
  592.     #
  593.     # Make sure "savedCurrentItem" is still in the list.
  594.     #
  595.     if {$first != ""} {
  596.         set i [lsearch -exact $_items $savedCurrentItem]
  597.         select [expr {$i != -1 ? $savedCurrentItem : $first}]
  598.     } else {
  599.     _setItem ""
  600.     }
  601.  
  602.     _setSize
  603.     set itk_option(-items) $_items
  604. }
  605.  
  606. # ------------------------------------------------------------------
  607. # PRIVATE METHOD: _setSize ?when?
  608. #
  609. # Set the size of the option menu.  If "when" is "now", the change 
  610. # is applied immediately.  If it is "later" or it is not specified, 
  611. # then the change is applied later, when the application is idle.
  612. # ------------------------------------------------------------------
  613. body iwidgets::Optionmenu::_setSize {{when later}} {
  614.  
  615.     if {$when == "later"} {
  616.     if {$_calcSize == ""} {
  617.         set _calcSize [after idle [code $this _setSize now]]
  618.     }
  619.     return
  620.     }
  621.  
  622.     set margin [expr 2*($itk_option(-borderwidth) \
  623.         + $itk_option(-highlightthickness))]
  624.  
  625.     if {"0" != $itk_option(-width)} {
  626.         set width $itk_option(-width)
  627.     } else {
  628.     set width [expr [winfo reqwidth $itk_component(popupMenu)]+$margin+20]
  629.     }
  630.     set height [winfo reqheight $itk_component(menuBtn)]
  631.     $itk_component(lwchildsite) configure -width $width -height $height
  632.  
  633.     set _calcSize ""
  634. }
  635.