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