home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2005 March / PCWELT_3_2005.ISO / pcwsoft / framework-2.2.exe / disjointlistbox.itk < prev    next >
Encoding:
Text File  |  2003-09-01  |  15.9 KB  |  530 lines
  1. #
  2. # ::iwidgets::Disjointlistbox
  3. # ----------------------------------------------------------------------
  4. # Implements a widget which maintains a disjoint relationship between
  5. # the items displayed by two listboxes.  The disjointlistbox is composed
  6. # of 2 Scrolledlistboxes,  2 Pushbuttons, and 2 labels.
  7. #
  8. # The disjoint behavior of this widget exists between the two Listboxes,
  9. # That is, a given instance of a ::iwidgets::Disjointlistbox will never
  10. # exist which has Listbox widgets with items in common.
  11. #
  12. # Users may transfer items between the two Listbox widgets using the
  13. # the two Pushbuttons.
  14. #
  15. # The options include the ability to configure the "items" displayed by
  16. # either of the two Listboxes and to control the placement of the insertion
  17. # and removal buttons.
  18. #
  19. # The following depicts the allowable "-buttonplacement" option values
  20. # and their associated layout:
  21. #
  22. #   "-buttonplacement" => center
  23. #
  24. #   --------------------------
  25. #   |listbox|        |listbox|
  26. #   |       |________|       |
  27. #   | (LHS) | button | (RHS) |
  28. #   |       |========|       |
  29. #   |       | button |       |
  30. #   |_______|--------|_______|
  31. #   | count |        | count |
  32. #   --------------------------
  33. #
  34. #   "-buttonplacement" => bottom
  35. #
  36. #   ---------------------
  37. #   | listbox | listbox |
  38. #   |  (LHS)  |  (RHS)  |
  39. #   |_________|_________|
  40. #   | button  | button  |
  41. #   |---------|---------|
  42. #   | count   | count   |
  43. #   ---------------------
  44. #
  45. # ----------------------------------------------------------------------
  46. #  AUTHOR: John A. Tucker               EMAIL: jatucker@spd.dsccc.com
  47. #
  48. # ======================================================================
  49.  
  50. #
  51. # Default resources.
  52. #
  53. option add *Disjointlistbox.lhsLabelText    Available   widgetDefault
  54. option add *Disjointlistbox.rhsLabelText    Current     widgetDefault
  55. option add *Disjointlistbox.lhsButtonLabel  {Insert >>} widgetDefault
  56. option add *Disjointlistbox.rhsButtonLabel  {<< Remove} widgetDefault
  57. option add *Disjointlistbox.vscrollMode     static      widgetDefault
  58. option add *Disjointlistbox.hscrollMode     static      widgetDefault
  59. option add *Disjointlistbox.selectMode      multiple    widgetDefault
  60. option add *Disjointlistbox.labelPos        nw          widgetDefault
  61. option add *Disjointlistbox.buttonPlacement bottom      widgetDefault
  62. option add *Disjointlistbox.lhsSortOption   increasing  widgetDefault
  63. option add *Disjointlistbox.rhsSortOption   increasing  widgetDefault
  64.  
  65.  
  66. #
  67. # Usual options.
  68. #
  69. itk::usual Disjointlistbox {
  70.   keep -background -textbackground -cursor \
  71.        -foreground -textfont -labelfont
  72. }
  73.  
  74.  
  75. # ----------------------------------------------------------------------
  76. # ::iwidgets::Disjointlistbox 
  77. # ----------------------------------------------------------------------
  78. itcl::class ::iwidgets::Disjointlistbox {
  79.  
  80.   inherit itk::Widget
  81.  
  82.   #
  83.   # options
  84.   #
  85.   itk_option define -buttonplacement buttonPlacement ButtonPlacement bottom
  86.   itk_option define -lhsbuttonlabel  lhsButtonLabel  LabelText       {Insert >>}
  87.   itk_option define -rhsbuttonlabel  rhsButtonLabel  LabelText       {<< Remove}
  88.   itk_option define -lhssortoption   lhsSortOption   LhsSortOption   increasing
  89.   itk_option define -rhssortoption   rhsSortOption   RhsSortOption   increasing
  90.  
  91.   constructor {args} {}
  92.  
  93.   #
  94.   # PUBLIC
  95.   #
  96.   public {
  97.     method clear {}
  98.     method getlhs {{first 0} {last end}}
  99.     method getrhs {{first 0} {last end}}
  100.     method lhs {args}
  101.     method insertlhs {items}
  102.     method insertrhs {items}
  103.     method setlhs {items}
  104.     method setrhs {items}
  105.     method rhs {args}
  106.   }
  107.  
  108.   #
  109.   # PROTECTED
  110.   #
  111.   protected {
  112.     method insert {theListbox items}
  113.     method listboxClick {clickSide otherSide}
  114.     method listboxDblClick {clickSide otherSide}
  115.     method remove {theListbox items}
  116.     method showCount {}
  117.     method transfer {}
  118.  
  119.     variable sourceListbox {}
  120.     variable destinationListbox {}
  121.   }
  122. }
  123.  
  124. #
  125. # Provide a lowercased access method for the ::iwidgets::Disjointlistbox class.
  126. # 
  127. proc ::iwidgets::disjointlistbox {pathName args} {
  128.     uplevel ::iwidgets::Disjointlistbox $pathName $args
  129. }
  130.  
  131. # ------------------------------------------------------------------
  132. #
  133. # Method: Constructor
  134. #
  135. # Purpose:   
  136. #
  137. itcl::body ::iwidgets::Disjointlistbox::constructor {args} {
  138.     #
  139.     # Create the left-most Listbox
  140.     #
  141.     itk_component add lhs {
  142.         iwidgets::Scrolledlistbox $itk_interior.lhs \
  143.                 -selectioncommand [itcl::code $this listboxClick lhs rhs] \
  144.                 -dblclickcommand [itcl::code $this listboxDblClick lhs rhs]
  145.     } {
  146.         usual
  147.         keep -selectmode -vscrollmode -hscrollmode
  148.         rename -labeltext -lhslabeltext lhsLabelText LabelText
  149.     }
  150.  
  151.     #
  152.     # Create the right-most Listbox
  153.     #
  154.     itk_component add rhs {
  155.         iwidgets::Scrolledlistbox $itk_interior.rhs \
  156.                 -selectioncommand [itcl::code $this listboxClick rhs lhs] \
  157.                 -dblclickcommand [itcl::code $this listboxDblClick rhs lhs]
  158.     } {
  159.         usual
  160.         keep -selectmode -vscrollmode -hscrollmode
  161.         rename -labeltext -rhslabeltext rhsLabelText LabelText
  162.     }
  163.  
  164.     #
  165.     # Create the left-most item count Label
  166.     #
  167.     itk_component add lhsCount {
  168.         label $itk_interior.lhscount
  169.     } {
  170.         usual
  171.         rename -font -labelfont labelFont Font
  172.     }
  173.  
  174.     #
  175.     # Create the right-most item count Label
  176.     #
  177.     itk_component add rhsCount {
  178.         label $itk_interior.rhscount
  179.     } {
  180.         usual
  181.         rename -font -labelfont labelFont Font
  182.     }
  183.  
  184.     set sourceListbox $itk_component(lhs)
  185.     set destinationListbox $itk_component(rhs)
  186.  
  187.     #
  188.     # Bind the "showCount" method to the Map event of one of the labels
  189.     # to keep the diplayed item count current.
  190.     #
  191.     bind $itk_component(lhsCount) <Map> [itcl::code $this showCount]
  192.  
  193.     grid $itk_component(lhs) -row 0 -column 0 -sticky nsew
  194.     grid $itk_component(rhs) -row 0 -column 2 -sticky nsew
  195.  
  196.     grid rowconfigure    $itk_interior 0 -weight 1
  197.     grid columnconfigure $itk_interior 0 -weight 1
  198.     grid columnconfigure $itk_interior 2 -weight 1
  199.  
  200.     eval itk_initialize $args
  201. }
  202.  
  203. # ------------------------------------------------------------------
  204. # Method:  listboxClick
  205. #
  206. # Purpose: Evaluate a single click make in the specified Listbox.
  207. #
  208. itcl::body ::iwidgets::Disjointlistbox::listboxClick {clickSide otherSide} {
  209.     set button "button"
  210.     $itk_component($clickSide$button) configure -state active
  211.     $itk_component($otherSide$button) configure -state disabled
  212.     set sourceListbox      $clickSide
  213.     set destinationListbox $otherSide
  214. }
  215.  
  216. # ------------------------------------------------------------------
  217. # Method:  listboxDblClick
  218. #
  219. # Purpose: Evaluate a double click in the specified Listbox.
  220. #
  221. itcl::body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} {
  222.     listboxClick $clickSide $otherSide
  223.     transfer
  224. }
  225.  
  226. # ------------------------------------------------------------------
  227. # Method:  transfer
  228. #
  229. # Purpose: Transfer source Listbox items to destination Listbox
  230. #
  231. itcl::body ::iwidgets::Disjointlistbox::transfer {} {
  232.  
  233.     if {[$sourceListbox selecteditemcount] == 0} {
  234.         return
  235.     }
  236.     set selectedindices [lsort -integer -decreasing [$sourceListbox curselection]]
  237.     set selecteditems [$sourceListbox getcurselection]
  238.  
  239.     foreach index $selectedindices {
  240.         $sourceListbox delete $index
  241.     }
  242.  
  243.     foreach item $selecteditems {
  244.         $destinationListbox insert end $item
  245.     }
  246.  
  247.     if {![string equal $itk_option(-${destinationListbox}sortoption) "none"]} {
  248.         $destinationListbox sort $itk_option(-${destinationListbox}sortoption)
  249.     }
  250.  
  251.     showCount
  252. }
  253.  
  254. # ------------------------------------------------------------------
  255. # Method: getlhs
  256. #
  257. # Purpose: Retrieve the items of the left Listbox widget
  258. #
  259. itcl::body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} {
  260.     return [lhs get $first $last]
  261. }
  262.  
  263. # ------------------------------------------------------------------
  264. # Method: getrhs
  265. #
  266. # Purpose: Retrieve the items of the right Listbox widget
  267. #
  268. itcl::body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} {
  269.     return [rhs get $first $last]
  270. }
  271.  
  272. # ------------------------------------------------------------------
  273. # Method: insertrhs
  274. #
  275. # Purpose: Insert items into the right Listbox widget
  276. #
  277. itcl::body ::iwidgets::Disjointlistbox::insertrhs {items} {
  278.     remove $itk_component(lhs) $items
  279.     insert rhs $items
  280. }
  281.  
  282. # ------------------------------------------------------------------
  283. # Method: insertlhs
  284. #
  285. # Purpose: Insert items into the left Listbox widget
  286. #
  287. itcl::body ::iwidgets::Disjointlistbox::insertlhs {items} {
  288.     remove $itk_component(rhs) $items
  289.     insert lhs $items
  290. }
  291.  
  292. # ------------------------------------------------------------------
  293. # Method:  clear
  294. #
  295. # Purpose: Remove the items from the Listbox widgets and set the item count
  296. #          Labels text to 0
  297. #
  298. itcl::body ::iwidgets::Disjointlistbox::clear {} {
  299.     lhs clear
  300.     rhs clear
  301.     showCount
  302. }
  303.  
  304. # ------------------------------------------------------------------
  305. # Method: insert
  306. #
  307. # Purpose: Insert the input items into the input Listbox widget while
  308. #          maintaining the disjoint property between them.
  309. #
  310. itcl::body ::iwidgets::Disjointlistbox::insert {theListbox items} {
  311.  
  312.     set curritems [$theListbox get 0 end]
  313.  
  314.     foreach item $items {
  315.         #
  316.         # if the item is not already present in the Listbox then insert it
  317.         #
  318.         if {[lsearch -exact $curritems $item] == -1} {
  319.             $theListbox insert end $item
  320.         }
  321.     }
  322.  
  323.     if {![string equal $itk_option(-${theListbox}sortoption) "none"]} {
  324.         $theListbox sort $itk_option(-${theListbox}sortoption)
  325.     }
  326.  
  327.     showCount
  328. }
  329.  
  330. # ------------------------------------------------------------------
  331. # Method: remove
  332. #
  333. # Purpose: Remove the input items from the input Listbox widget while
  334. #          maintaining the disjoint property between them.
  335. #
  336. itcl::body ::iwidgets::Disjointlistbox::remove {theListbox items} {
  337.  
  338.     set indexes {}
  339.     set curritems [$theListbox get 0 end]
  340.  
  341.     foreach item $items {
  342.         #
  343.         # if the item is in the listbox then add its index to the index list
  344.         # 
  345.         if {[set index [lsearch -exact $curritems $item]] != -1} {
  346.             lappend indexes $index
  347.         }
  348.     }
  349.  
  350.     foreach index [lsort -integer -decreasing $indexes] {
  351.         $theListbox delete $index
  352.     }
  353.     showCount
  354. }
  355.  
  356. # ------------------------------------------------------------------
  357. # Method: showCount
  358. #
  359. # Purpose: Set the text of the item count Labels.
  360. #
  361. itcl::body ::iwidgets::Disjointlistbox::showCount {} {
  362.     $itk_component(lhsCount) config -text "item count: [lhs size]"
  363.     $itk_component(rhsCount) config -text "item count: [rhs size]"
  364. }
  365.  
  366. # ------------------------------------------------------------------
  367. # METHOD: setlhs
  368. #
  369. # Set the items of the left-most Listbox with the input list
  370. # option.  Remove all (if any) items from the right-most Listbox
  371. # which exist in the input list option to maintain the disjoint
  372. # property between the two
  373. #
  374. itcl::body ::iwidgets::Disjointlistbox::setlhs {items} {
  375.     lhs clear
  376.     insertlhs $items
  377. }
  378.  
  379. # ------------------------------------------------------------------
  380. # METHOD: setrhs
  381. #
  382. # Set the items of the right-most Listbox with the input list
  383. # option.  Remove all (if any) items from the left-most Listbox
  384. # which exist in the input list option to maintain the disjoint
  385. # property between the two
  386. #
  387. itcl::body ::iwidgets::Disjointlistbox::setrhs {items} {
  388.     rhs clear
  389.     insertrhs $items
  390. }
  391.  
  392. # ------------------------------------------------------------------
  393. # Method:  lhs
  394. #
  395. # Purpose: Evaluates the specified arguments against the lhs Listbox
  396. #
  397. itcl::body ::iwidgets::Disjointlistbox::lhs {args} {
  398.     return [eval $itk_component(lhs) $args]
  399. }
  400.  
  401. # ------------------------------------------------------------------
  402. # Method:  rhs
  403. #
  404. # Purpose: Evaluates the specified arguments against the rhs Listbox
  405. #
  406. itcl::body ::iwidgets::Disjointlistbox::rhs {args} {
  407.     return [eval $itk_component(rhs) $args]
  408. }
  409.  
  410. # ------------------------------------------------------------------
  411. # OPTION: buttonplacement
  412. #
  413. # Configure the placement of the buttons to be either between or below
  414. # the two list boxes.
  415. #
  416. itcl::configbody ::iwidgets::Disjointlistbox::buttonplacement {
  417.     if {$itk_option(-buttonplacement) != ""} {
  418.  
  419.         if { [lsearch [component] lhsbutton] != -1 } {
  420.             eval destroy $itk_component(rhsbutton) $itk_component(lhsbutton)
  421.         }
  422.  
  423.         if { [lsearch [component] bbox] != -1 } {
  424.             destroy $itk_component(bbox)
  425.         }
  426.  
  427.         set where $itk_option(-buttonplacement)
  428.  
  429.         switch $where {
  430.  
  431.             center {
  432.                 #
  433.                 # Create the button box frame
  434.                 #
  435.                 itk_component add bbox {
  436.                     frame $itk_interior.bbox
  437.                 }
  438.     
  439.                 itk_component add lhsbutton {
  440.                     button $itk_component(bbox).lhsbutton -command [itcl::code \
  441.                             $this transfer]
  442.                 } {
  443.                     usual
  444.                     rename -text -lhsbuttonlabel lhsButtonLabel LabelText
  445.                     rename -font -labelfont labelFont Font
  446.                 }
  447.     
  448.                 itk_component add rhsbutton {
  449.                     button $itk_component(bbox).rhsbutton -command [itcl::code \
  450.                             $this transfer]
  451.                 } {
  452.                     usual
  453.                     rename -text -rhsbuttonlabel rhsButtonLabel LabelText
  454.                     rename -font -labelfont labelFont Font
  455.                 }
  456.     
  457.                 grid configure $itk_component(lhsCount) -row 1 -column 0 \
  458.                         -sticky ew
  459.                 grid configure $itk_component(rhsCount) -row 1 -column 2 \
  460.                         -sticky ew
  461.      
  462.                 grid configure $itk_component(bbox) \
  463.                         -in $itk_interior -row 0 -column 1 -columnspan 1 \
  464.                                 -sticky nsew
  465.     
  466.                 grid configure $itk_component(rhsbutton) \
  467.                         -in $itk_component(bbox) -row 0 -column 0 -sticky ew
  468.                 grid configure $itk_component(lhsbutton) \
  469.                         -in $itk_component(bbox) -row 1 -column 0 -sticky ew
  470.                 }
  471.  
  472.             bottom {
  473.     
  474.                 itk_component add lhsbutton {
  475.                     button $itk_interior.lhsbutton -command [itcl::code $this \
  476.                             transfer]
  477.                 } {
  478.                     usual
  479.                     rename -text -lhsbuttonlabel lhsButtonLabel LabelText
  480.                     rename -font -labelfont labelFont Font
  481.                 }
  482.  
  483.                 itk_component add rhsbutton {
  484.                     button $itk_interior.rhsbutton -command [itcl::code $this \
  485.                             transfer]
  486.                 } {
  487.                     usual
  488.                     rename -text -rhsbuttonlabel rhsButtonLabel LabelText
  489.                     rename -font -labelfont labelFont Font
  490.                 }
  491.  
  492.                 grid $itk_component(lhsCount)  -row 2 -column 0 -sticky ew
  493.                 grid $itk_component(rhsCount)  -row 2 -column 2 -sticky ew
  494.                 grid $itk_component(lhsbutton) -row 1 -column 0 -sticky ew
  495.                 grid $itk_component(rhsbutton) -row 1 -column 2 -sticky ew
  496.             }
  497.  
  498.             default {
  499.                 error "bad buttonplacement option\"$where\": should be center\
  500.                         or bottom"
  501.             }
  502.         }
  503.     }
  504. }
  505.  
  506. # ------------------------------------------------------------------
  507. # OPTION: lhssortoption
  508. #
  509. # Configure the sort option to use for the left side
  510. #
  511. itcl::configbody ::iwidgets::Disjointlistbox::lhssortoption {
  512.  
  513.     if {![string equal $itk_option(-lhssortoption) "none"]} {
  514.         $itk_component(lhs) sort $itk_option(-lhssortoption)
  515.     }
  516. }
  517.  
  518.  
  519. # ------------------------------------------------------------------
  520. # OPTION: rhssortoption
  521. #
  522. # Configure the sort option to use for the right side
  523. #
  524. itcl::configbody ::iwidgets::Disjointlistbox::rhssortoption {
  525.  
  526.     if {![string equal $itk_option(-rhssortoption) "none"]} {
  527.         $itk_component(rhs) sort $itk_option(-rhssortoption)
  528.     }
  529. }
  530.