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 / selectionbox.itk < prev    next >
Text File  |  2003-09-01  |  19KB  |  561 lines
  1. #
  2. # Selectionbox
  3. # ----------------------------------------------------------------------
  4. # Implements a selection box composed of a scrolled list of items and
  5. # a selection entry field.  The user may choose any of the items displayed
  6. # in the scrolled list of alternatives and the selection field will be
  7. # filled with the choice.  The user is also free to enter a new value in
  8. # the selection entry field.  Both the list and entry areas have labels.
  9. # A child site is also provided in which the user may create other widgets
  10. # to be used in conjunction with the selection box.
  11. # 
  12. # ----------------------------------------------------------------------
  13. #  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
  14. #
  15. #  @(#) $Id: selectionbox.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
  16. # ----------------------------------------------------------------------
  17. #            Copyright (c) 1995 DSC Technologies Corporation
  18. # ======================================================================
  19. # Permission to use, copy, modify, distribute and license this software 
  20. # and its documentation for any purpose, and without fee or written 
  21. # agreement with DSC, is hereby granted, provided that the above copyright 
  22. # notice appears in all copies and that both the copyright notice and 
  23. # warranty disclaimer below appear in supporting documentation, and that 
  24. # the names of DSC Technologies Corporation or DSC Communications 
  25. # Corporation not be used in advertising or publicity pertaining to the 
  26. # software without specific, written prior permission.
  27. # 
  28. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  29. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  30. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  31. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  32. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  33. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  34. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  35. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  36. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  37. # SOFTWARE.
  38. # ======================================================================
  39.  
  40. #
  41. # Usual options.
  42. #
  43. itk::usual Selectionbox {
  44.     keep -activebackground -activerelief -background -borderwidth -cursor \
  45.      -elementborderwidth -foreground -highlightcolor -highlightthickness \
  46.      -insertbackground -insertborderwidth -insertofftime -insertontime \
  47.      -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
  48.      -selectforeground -textbackground -textfont -troughcolor
  49. }
  50.  
  51. # ------------------------------------------------------------------
  52. #                            SELECTIONBOX
  53. # ------------------------------------------------------------------
  54. itcl::class iwidgets::Selectionbox {
  55.     inherit itk::Widget
  56.  
  57.     constructor {args} {}
  58.     destructor {}
  59.  
  60.     itk_option define -childsitepos childSitePos Position center
  61.     itk_option define -margin margin Margin 7
  62.     itk_option define -itemson itemsOn ItemsOn true
  63.     itk_option define -selectionon selectionOn SelectionOn true
  64.     itk_option define -width width Width 260
  65.     itk_option define -height height Height 320
  66.  
  67.     public method childsite {}
  68.     public method get {}
  69.     public method curselection {}
  70.     public method clear {component}
  71.     public method insert {component index args}
  72.     public method delete {first {last {}}}
  73.     public method size {}
  74.     public method scan {option args}
  75.     public method nearest {y}
  76.     public method index {index}
  77.     public method selection {option args}
  78.     public method selectitem {}
  79.  
  80.     private method _packComponents {{when later}}
  81.  
  82.     private variable _repacking {}     ;# non-null => _packComponents pending
  83. }
  84.  
  85. #
  86. # Provide a lowercased access method for the Selectionbox class.
  87. # 
  88. proc ::iwidgets::selectionbox {pathName args} {
  89.     uplevel ::iwidgets::Selectionbox $pathName $args
  90. }
  91.  
  92. #
  93. # Use option database to override default resources of base classes.
  94. #
  95. option add *Selectionbox.itemsLabel Items widgetDefault
  96. option add *Selectionbox.selectionLabel Selection widgetDefault
  97. option add *Selectionbox.width 260 widgetDefault
  98. option add *Selectionbox.height 320 widgetDefault
  99.  
  100. # ------------------------------------------------------------------
  101. #                        CONSTRUCTOR
  102. # ------------------------------------------------------------------
  103. itcl::body iwidgets::Selectionbox::constructor {args} {
  104.     #
  105.     # Set the borderwidth to zero and add width and height options
  106.     # back to the hull.
  107.     #
  108.     component hull configure -borderwidth 0
  109.     itk_option add hull.width hull.height
  110.     
  111.     #
  112.     # Create the child site widget.
  113.     #
  114.     itk_component add -protected sbchildsite {
  115.     frame $itk_interior.sbchildsite
  116.     } 
  117.     
  118.     #
  119.     # Create the items list.
  120.     #
  121.     itk_component add items {
  122.     iwidgets::Scrolledlistbox $itk_interior.items -selectmode single \
  123.         -visibleitems 20x10 -labelpos nw -vscrollmode static \
  124.         -hscrollmode none 
  125.     } {
  126.     usual
  127.     keep -dblclickcommand -exportselection 
  128.     
  129.     rename -labeltext -itemslabel itemsLabel Text
  130.     rename -selectioncommand -itemscommand itemsCommand Command
  131.     }
  132.     configure -itemscommand [itcl::code $this selectitem]
  133.     
  134.     #
  135.     # Create the selection entry.
  136.     #
  137.     itk_component add selection {
  138.     iwidgets::Entryfield $itk_interior.selection -labelpos nw
  139.     } {
  140.     usual
  141.  
  142.     keep -exportselection 
  143.     
  144.     rename -labeltext -selectionlabel selectionLabel Text
  145.     rename -command -selectioncommand selectionCommand Command
  146.     }
  147.     
  148.     #
  149.     # Set the interior to the childsite for derived classes.
  150.     #
  151.     set itk_interior $itk_component(sbchildsite)
  152.  
  153.     #
  154.     # Initialize the widget based on the command line options.
  155.     #
  156.     eval itk_initialize $args
  157.  
  158.     # 
  159.     # When idle, pack the components.
  160.     #
  161.     _packComponents
  162. }   
  163.  
  164. # ------------------------------------------------------------------
  165. #                           DESTRUCTOR
  166. # ------------------------------------------------------------------
  167. itcl::body iwidgets::Selectionbox::destructor {} {
  168.     if {$_repacking != ""} {after cancel $_repacking}
  169. }
  170.  
  171. # ------------------------------------------------------------------
  172. #                             OPTIONS
  173. # ------------------------------------------------------------------
  174.  
  175. # ------------------------------------------------------------------
  176. # OPTION: -childsitepos
  177. #
  178. # Specifies the position of the child site in the selection box.
  179. # ------------------------------------------------------------------
  180. itcl::configbody iwidgets::Selectionbox::childsitepos {
  181.     _packComponents 
  182. }
  183.  
  184. # ------------------------------------------------------------------
  185. # OPTION: -margin
  186. #
  187. # Specifies distance between the items list and selection entry.
  188. # ------------------------------------------------------------------
  189. itcl::configbody iwidgets::Selectionbox::margin {
  190.     _packComponents 
  191. }
  192.  
  193. # ------------------------------------------------------------------
  194. # OPTION: -itemson
  195. #
  196. # Specifies whether or not to display the items list.
  197. # ------------------------------------------------------------------
  198. itcl::configbody iwidgets::Selectionbox::itemson {
  199.     _packComponents 
  200. }
  201.  
  202. # ------------------------------------------------------------------
  203. # OPTION: -selectionon
  204. #
  205. # Specifies whether or not to display the selection entry widget.
  206. # ------------------------------------------------------------------
  207. itcl::configbody iwidgets::Selectionbox::selectionon {
  208.     _packComponents
  209. }
  210.  
  211. # ------------------------------------------------------------------
  212. # OPTION: -width
  213. #
  214. # Specifies the width of the hull.  The value may be specified in 
  215. # any of the forms acceptable to Tk_GetPixels.  A value of zero 
  216. # causes the width to be adjusted to the required value based on 
  217. # the size requests of the components.  Otherwise, the width is 
  218. # fixed.
  219. # ------------------------------------------------------------------
  220. itcl::configbody iwidgets::Selectionbox::width {
  221.     #
  222.     # The width option was added to the hull in the constructor.
  223.     # So, any width value given is passed automatically to the
  224.     # hull.  All we have to do is play with the propagation.
  225.     #
  226.     if {$itk_option(-width) != 0} {
  227.     set propagate 0
  228.     } else {
  229.     set propagate 1
  230.     }
  231.  
  232.     #
  233.     # Due to a bug in the tk4.2 grid, we have to check the 
  234.     # propagation before setting it.  Setting it to the same
  235.     # value it already is will cause it to toggle.
  236.     #
  237.     if {[grid propagate $itk_component(hull)] != $propagate} {
  238.     grid propagate $itk_component(hull) $propagate
  239.     }
  240. }
  241.  
  242. # ------------------------------------------------------------------
  243. # OPTION: -height
  244. #
  245. # Specifies the height of the hull.  The value may be specified in 
  246. # any of the forms acceptable to Tk_GetPixels.  A value of zero 
  247. # causes the height to be adjusted to the required value based on 
  248. # the size requests of the components. Otherwise, the height is 
  249. # fixed.
  250. # ------------------------------------------------------------------
  251. itcl::configbody iwidgets::Selectionbox::height {
  252.     #
  253.     # The height option was added to the hull in the constructor.
  254.     # So, any height value given is passed automatically to the
  255.     # hull.  All we have to do is play with the propagation.
  256.     #
  257.     if {$itk_option(-height) != 0} {
  258.     set propagate 0
  259.     } else {
  260.     set propagate 1
  261.     }
  262.  
  263.     #
  264.     # Due to a bug in the tk4.2 grid, we have to check the 
  265.     # propagation before setting it.  Setting it to the same
  266.     # value it already is will cause it to toggle.
  267.     #
  268.     if {[grid propagate $itk_component(hull)] != $propagate} {
  269.     grid propagate $itk_component(hull) $propagate
  270.     }
  271. }
  272.  
  273. # ------------------------------------------------------------------
  274. #                            METHODS
  275. # ------------------------------------------------------------------
  276.  
  277. # ------------------------------------------------------------------
  278. # METHOD: childsite
  279. #
  280. # Returns the path name of the child site widget.
  281. # ------------------------------------------------------------------
  282. itcl::body iwidgets::Selectionbox::childsite {} {
  283.     return $itk_component(sbchildsite)
  284. }
  285.  
  286. # ------------------------------------------------------------------
  287. # METHOD: get 
  288. #
  289. # Returns the current selection.
  290. # ------------------------------------------------------------------
  291. itcl::body iwidgets::Selectionbox::get {} {
  292.     return [$itk_component(selection) get]
  293. }
  294.  
  295. # ------------------------------------------------------------------
  296. # METHOD: curselection
  297. #
  298. # Returns the current selection index.
  299. # ------------------------------------------------------------------
  300. itcl::body iwidgets::Selectionbox::curselection {} {
  301.     return [$itk_component(items) curselection]
  302. }
  303.  
  304. # ------------------------------------------------------------------
  305. # METHOD: clear component
  306. #
  307. # Delete the contents of either the selection entry widget or items
  308. # list.
  309. # ------------------------------------------------------------------
  310. itcl::body iwidgets::Selectionbox::clear {component} {
  311.     switch $component {
  312.     selection {
  313.         $itk_component(selection) clear
  314.     }
  315.     
  316.     items {
  317.         delete 0 end
  318.     }
  319.     
  320.     default {
  321.         error "bad clear argument \"$component\": should be\
  322.            selection or items"
  323.     }
  324.     }
  325. }
  326.  
  327. # ------------------------------------------------------------------
  328. # METHOD: insert component index args
  329. #
  330. # Insert element(s) into either the selection or items list widget.
  331. # ------------------------------------------------------------------
  332. itcl::body iwidgets::Selectionbox::insert {component index args} {
  333.     switch $component {
  334.     selection {
  335.         eval $itk_component(selection) insert $index $args
  336.     }
  337.     
  338.     items {
  339.         eval $itk_component(items) insert $index $args
  340.     }
  341.     
  342.     default {
  343.         error "bad insert argument \"$component\": should be\
  344.            selection or items"
  345.     }
  346.     }
  347. }
  348.  
  349. # ------------------------------------------------------------------
  350. # METHOD: delete first ?last?
  351. #
  352. # Delete one or more elements from the items list box.  The default 
  353. # is to delete by indexed range. If an item is to be removed by name, 
  354. # it must be preceeded by the keyword "item". Only index numbers can 
  355. # be used to delete a range of items. 
  356. # ------------------------------------------------------------------
  357. itcl::body iwidgets::Selectionbox::delete {first {last {}}} {
  358.     set first [index $first]
  359.     
  360.     if {$last != {}} {
  361.     set last [index $last]
  362.     } else {
  363.     set last $first
  364.     }
  365.     
  366.     if {$first <= $last} {
  367.     eval $itk_component(items) delete $first $last
  368.     } else {
  369.     error "first index must not be greater than second"
  370.     }
  371. }
  372.  
  373. # ------------------------------------------------------------------
  374. # METHOD: size 
  375. #
  376. # Returns a decimal string indicating the total number of elements 
  377. # in the items list.
  378. # ------------------------------------------------------------------
  379. itcl::body iwidgets::Selectionbox::size {} {
  380.     return [$itk_component(items) size]
  381. }
  382.  
  383. # ------------------------------------------------------------------
  384. # METHOD: scan option args 
  385. #
  386. # Implements scanning on items list.
  387. # ------------------------------------------------------------------
  388. itcl::body iwidgets::Selectionbox::scan {option args} {
  389.     eval $itk_component(items) scan $option $args
  390. }
  391.  
  392. # ------------------------------------------------------------------
  393. # METHOD: nearest y
  394. #
  395. # Returns the index to the nearest listbox item given a y coordinate.
  396. # ------------------------------------------------------------------
  397. itcl::body iwidgets::Selectionbox::nearest {y} {
  398.     return [$itk_component(items) nearest $y]
  399. }
  400.  
  401. # ------------------------------------------------------------------
  402. # METHOD: index index
  403. #
  404. # Returns the decimal string giving the integer index corresponding 
  405. # to index.
  406. # ------------------------------------------------------------------
  407. itcl::body iwidgets::Selectionbox::index {index} {
  408.     return [$itk_component(items) index $index]
  409. }
  410.  
  411. # ------------------------------------------------------------------
  412. # METHOD: selection option args
  413. #
  414. # Adjusts the selection within the items list.
  415. # ------------------------------------------------------------------
  416. itcl::body iwidgets::Selectionbox::selection {option args} {
  417.     eval $itk_component(items) selection $option $args
  418.  
  419.     selectitem
  420. }
  421.  
  422. # ------------------------------------------------------------------
  423. # METHOD: selectitem
  424. #
  425. # Replace the selection entry field contents with the currently 
  426. # selected items value.
  427. # ------------------------------------------------------------------
  428. itcl::body iwidgets::Selectionbox::selectitem {} {
  429.     $itk_component(selection) clear
  430.     set numSelected [$itk_component(items) selecteditemcount]
  431.  
  432.     if {$numSelected == 1} {
  433.     $itk_component(selection) insert end \
  434.         [$itk_component(items) getcurselection]
  435.     } elseif {$numSelected > 1} {
  436.     $itk_component(selection) insert end \
  437.         [lindex [$itk_component(items) getcurselection] 0]
  438.     }
  439.  
  440.     $itk_component(selection) icursor end
  441. }
  442.  
  443. # ------------------------------------------------------------------
  444. # PRIVATE METHOD: _packComponents ?when?
  445. #
  446. # Pack the selection, items, and child site widgets based on options.
  447. # If "when" is "now", the change is applied immediately.  If it is 
  448. # "later" or it is not specified, then the change is applied later, 
  449. # when the application is idle.
  450. # ------------------------------------------------------------------
  451. itcl::body iwidgets::Selectionbox::_packComponents {{when later}} {
  452.     if {$when == "later"} {
  453.     if {$_repacking == ""} {
  454.         set _repacking [after idle [itcl::code $this _packComponents now]]
  455.     }
  456.     return
  457.     } elseif {$when != "now"} {
  458.     error "bad option \"$when\": should be now or later"
  459.     }
  460.  
  461.     set _repacking ""
  462.  
  463.     set parent [winfo parent $itk_component(sbchildsite)]
  464.     set margin [winfo pixels $itk_component(hull) $itk_option(-margin)]
  465.  
  466.     switch $itk_option(-childsitepos) {
  467.     n {
  468.         grid $itk_component(sbchildsite) -row 0 -column 0 \
  469.             -sticky nsew -rowspan 1
  470.         grid $itk_component(items) -row 1 -column 0 -sticky nsew
  471.         grid $itk_component(selection) -row 3 -column 0 -sticky ew
  472.         
  473.         grid rowconfigure $parent 0 -weight 0 -minsize 0
  474.         grid rowconfigure $parent 1 -weight 1 -minsize 0
  475.         grid rowconfigure $parent 2 -weight 0 -minsize $margin
  476.         grid rowconfigure $parent 3 -weight 0 -minsize 0
  477.  
  478.         grid columnconfigure $parent 0 -weight 1 -minsize 0
  479.         grid columnconfigure $parent 1 -weight 0 -minsize 0
  480.     }
  481.     
  482.     w {
  483.         grid $itk_component(sbchildsite) -row 0 -column 0 \
  484.             -sticky nsew -rowspan 3
  485.         grid $itk_component(items) -row 0 -column 1 -sticky nsew
  486.         grid $itk_component(selection) -row 2 -column 1 -sticky ew
  487.         
  488.         grid rowconfigure $parent 0 -weight 1 -minsize 0
  489.         grid rowconfigure $parent 1 -weight 0 -minsize $margin
  490.         grid rowconfigure $parent 2 -weight 0 -minsize 0
  491.         grid rowconfigure $parent 3 -weight 0 -minsize 0
  492.  
  493.         grid columnconfigure $parent 0 -weight 0 -minsize 0
  494.         grid columnconfigure $parent 1 -weight 1 -minsize 0
  495.     }
  496.     
  497.     s {
  498.         grid $itk_component(items) -row 0 -column 0 -sticky nsew
  499.         grid $itk_component(selection) -row 2 -column 0 -sticky ew
  500.         grid $itk_component(sbchildsite) -row 3 -column 0 \
  501.             -sticky nsew -rowspan 1
  502.         
  503.         grid rowconfigure $parent 0 -weight 1 -minsize 0
  504.         grid rowconfigure $parent 1 -weight 0 -minsize $margin
  505.         grid rowconfigure $parent 2 -weight 0 -minsize 0
  506.         grid rowconfigure $parent 3 -weight 0 -minsize 0
  507.  
  508.         grid columnconfigure $parent 0 -weight 1 -minsize 0
  509.         grid columnconfigure $parent 1 -weight 0 -minsize 0
  510.     }
  511.     
  512.     e {
  513.         grid $itk_component(items) -row 0 -column 0 -sticky nsew
  514.         grid $itk_component(selection) -row 2 -column 0 -sticky ew
  515.         grid $itk_component(sbchildsite) -row 0 -column 1 \
  516.             -sticky nsew -rowspan 3
  517.         
  518.         grid rowconfigure $parent 0 -weight 1 -minsize 0
  519.         grid rowconfigure $parent 1 -weight 0 -minsize $margin
  520.         grid rowconfigure $parent 2 -weight 0 -minsize 0
  521.         grid rowconfigure $parent 3 -weight 0 -minsize 0
  522.  
  523.         grid columnconfigure $parent 0 -weight 1 -minsize 0
  524.         grid columnconfigure $parent 1 -weight 0 -minsize 0
  525.     }
  526.     
  527.     center {
  528.         grid $itk_component(items) -row 0 -column 0 -sticky nsew
  529.         grid $itk_component(sbchildsite) -row 1 -column 0 \
  530.             -sticky nsew -rowspan 1
  531.         grid $itk_component(selection) -row 3 -column 0 -sticky ew
  532.         
  533.         grid rowconfigure $parent 0 -weight 1 -minsize 0
  534.         grid rowconfigure $parent 1 -weight 0 -minsize 0
  535.         grid rowconfigure $parent 2 -weight 0 -minsize $margin
  536.         grid rowconfigure $parent 3 -weight 0 -minsize 0
  537.  
  538.         grid columnconfigure $parent 0 -weight 1 -minsize 0
  539.         grid columnconfigure $parent 1 -weight 0 -minsize 0
  540.     }
  541.     
  542.     default {
  543.         error "bad childsitepos option \"$itk_option(-childsitepos)\":\
  544.            should be n, e, s, w, or center"
  545.     }
  546.     }
  547.     
  548.     if {$itk_option(-itemson)} {
  549.     } else {
  550.     grid forget $itk_component(items)
  551.     }
  552.     
  553.     if {$itk_option(-selectionon)} {
  554.     } else {
  555.     grid forget $itk_component(selection)
  556.     }
  557.     
  558.     raise $itk_component(sbchildsite)
  559. }
  560.  
  561.