#///////////////////////////////////////////////////////////////////////////// # FILE : mulselec.tcl # PURPOSE : This file contains a namespace called MultipleSelector with its # functions. It's for creating a multiple selector of items and # managing its events. A multiple selector consist of two listboxes: # unselected (left) and selected (right) with items which you can # move from one listbox to the other. #///////////////////////////////////////////////////////////////////////////// #///////////////////////////////////////////////////////////////////////////// # TESTING #///////////////////////////////////////////////////////////////////////////// # Put if {1} for testing this file. if {0} { package require Tk package require BWidget # force BWidget autoload Bitmap::use set toltk_script_path [file dirname [info script]] set toltk_images_path [file join ${toltk_script_path} images] if { [lsearch $Bitmap::path $toltk_images_path] == -1 } { lappend Bitmap::path [file join $toltk_script_path images] } package require msgcat namespace import msgcat::* ::msgcat::mclocale es ::msgcat::mcload [file join $toltk_script_path msgs] } package require blistbox #///////////////////////////////////////////////////////////////////////////// namespace eval MultipleSelector { # # PURPOSE: The purpose of this namespace is organize code and functions. # #///////////////////////////////////////////////////////////////////////////// } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::CreateToplevel { w unselvar selvar {label1 "Not selected"} {label2 "Selected"} } { # # PURPOSE: Creates a multiple selector in a modal toplevel window. # # PARAMETERS: # w -> widget's path (toplevel) # unselvar -> name of the variable that has the unselected items # selvar -> name of the variable that has the selected items # label1 -> label of the unselected listbox # label2 -> label of the selected listbox # #///////////////////////////////////////////////////////////////////////////// global _MS_QUIT upvar #0 $unselvar unsel upvar #0 $selvar sel variable widget set label1 [mc $label1] set label2 [mc $label2] toplevel $w # Dialog boxes should be transient with respect to their parent, # so that they will always stay on top of their parent window. However, # some window managers will create the window as withdrawn if the parent # window is withdrawn or iconified. Combined with the grab we put on the # window, this can hang the entire application. Therefore we only make # the dialog transient if the parent is viewable. # if { [winfo viewable [winfo toplevel [winfo parent $w]]] } { wm transient $w [winfo toplevel [winfo parent $w]] } wm title $w [mc "Multiple Selector"] wm protocol $w WM_DELETE_WINDOW "set _MS_QUIT 0" #wm geometry $w +[winfo partent $w]150+100 wm geometry $w +350+200 CreateFrame $w.f $unsel $sel $label1 $label2 set fb [frame $w.fb] Button $fb.ok -image [::Bitmap::get accept] -relief link \ -text [mc "Accept"] -command "set _MS_QUIT 1" \ -helptext [mc "Accept selection"] Button $fb.cancel -image [::Bitmap::get txt] -relief link \ -text [mc "Cancel"] -command "set _MS_QUIT 0" \ -helptext [mc "Cancel selection"] grid $fb.ok $fb.cancel grid $w.f -sticky news grid $w.fb -sticky ew -pady 2 grid rowconfigure $w 0 -weight 1 grid columnconfigure $w 0 -weight 1 set oldFocus [focus] set oldGrab [grab current $w] if {[string compare $oldGrab ""]} { set grabStatus [grab status $oldGrab] } grab $w focus $w tkwait variable _MS_QUIT if {$_MS_QUIT} { set unsel [GetUnselected $w.f] set sel [GetSelected $w.f] } catch { focus $oldFocus } catch { # It's possible that the window has already been destroyed, # hence this "catch". Delete the Destroy handler so that # data(quit) doesn't get reset by it. #bind $w {} destroy $w } if {[string compare $oldGrab ""]} { if {[string compare $grabStatus "global"]} { grab $oldGrab } else { grab -global $oldGrab } } } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::CreateFrame {w unsel sel {label1 "Not selected"} {label2 "Selected"} } { # # PURPOSE: Creates a multiple selector in a frame. # # PARAMETERS: # w -> widget's path (frame) # unsel -> list of unselected items # sel -> list of selected items # label1 -> label of the unselected listbox # label2 -> label of the selected listbox # # RETURN: Path of multiple selector # #///////////////////////////////////////////////////////////////////////////// upvar #0 $w data set label1 [mc $label1] set label2 [mc $label2] set data(OnChanged) "" frame $w -class MultipleSelector set left [frame $w.left] set right [frame $w.right] # listbox 1 label $w.l1 -text $label1 -bd 1 -relief raised ScrolledWindow $w.sw1 blistbox $w.sw1.lb -selectmode extended \ -breadonly true -bkeypress true -bparent $w $w.sw1 setwidget $w.sw1.lb bind $w.sw1.lb +[list focus -force %W] bind $w.sw1.lb +[list ::MultipleSelector::LBLeftToRight $w] # buttons set bbox [ButtonBox $w.bb -orient vertical -spacing 0 -padx 4 -pady 1] $bbox add -image [Bitmap::get play] -height 16 -width 16 \ -command [list ::MultipleSelector::LBLeftToRight $w] -relief link \ -helptext [mc "Moves selection from left to right"] $bbox add -image [Bitmap::get backward] -height 16 -width 16 \ -command [list ::MultipleSelector::LBRightToLeft $w] -relief link \ -helptext [mc "Moves selection from right to left"] $bbox add -image [Bitmap::get end] -height 16 -width 16 \ -command [list ::MultipleSelector::LBAllLeftToRight $w] -relief link \ -helptext [mc "Moves all from left to right"] $bbox add -image [Bitmap::get begin] -height 16 -width 16 \ -command [list ::MultipleSelector::LBAllRightToLeft $w] -relief link \ -helptext [mc "Moves all from right to left"] # listbox 2 label $w.l2 -text $label2 -bd 1 -relief raised ScrolledWindow $w.sw2 blistbox $w.sw2.lb -selectmode extended \ -breadonly true -bkeypress true -bparent $w $w.sw2 setwidget $w.sw2.lb bind $w.sw2.lb +[list focus -force %W] bind $w.sw2.lb +[list ::MultipleSelector::LBRightToLeft $w] # fill the listbox FillLB $w $unsel $sel grid $w.l1 $bbox $w.l2 -sticky news grid $w.sw1 ^ $w.sw2 -sticky news grid rowconfigure $w 0 -weight 0 grid rowconfigure $w 1 -weight 1 grid columnconfigure $w 0 -weight 1 grid columnconfigure $w 1 -pad 5 grid columnconfigure $w 2 -weight 1 update bind $w [list ::MultipleSelector::KillData $w] return $w } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::EvalOnChanged { w } { # # PURPOSE: Evaluates a procedure when any of the listboxes changes any of # its items. # # PARAMETERS: # w -> widget's path (frame). It stores data # #///////////////////////////////////////////////////////////////////////////// upvar #0 $w data if { [string length $data(OnChanged)] } { eval $data(OnChanged) } } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::FillLB { w unsel sel } { # # PURPOSE: Fill unselected and selected listboxes of widget 'w'. # # PARAMETERS: # w -> widget's path # unsel -> list of unselected items # sel -> list of selected items # #///////////////////////////////////////////////////////////////////////////// $w.sw1.lb delete 0 end $w.sw2.lb delete 0 end foreach it $unsel { $w.sw1.lb insert end $it } foreach it $sel { $w.sw2.lb insert end $it } EvalOnChanged $w } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::OnChanged { w script } { # # PURPOSE: Stores a script to evaluate when a listbox changes. # # PARAMETERS: # w -> widget's path (stores data, the script in this case) # script -> script to evaluate when a listbox changes # #///////////////////////////////////////////////////////////////////////////// upvar #0 $w data set data(OnChanged) $script } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::ListTransferSel {scr dst} { # # PURPOSE: Transfer selected items from scr listbox to dst listbox. # # PARAMETERS: # scr -> source listbox path # dst -> destination listbox path # #///////////////////////////////////////////////////////////////////////////// foreach i [$scr curselection] { $dst insert end [$scr get $i] } } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::ListDeleteSel {w} { # # PURPOSE: Deletes selected items of a listbox # # PARAMETERS: # w -> listbox's path # #///////////////////////////////////////////////////////////////////////////// foreach i [lsort -integer -decreasing [$w curselection]] { $w delete $i } } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::LBLeftToRight { w } { # # PURPOSE: Moves selected items from unselected listbox to selected listbox # # PARAMETERS: # w -> multiple selector's path # #///////////////////////////////////////////////////////////////////////////// ListTransferSel $w.sw1.lb $w.sw2.lb ListDeleteSel $w.sw1.lb EvalOnChanged $w } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::LBRightToLeft { w } { # # PURPOSE: Moves selected items from selected listbox to unselected listbox # # PARAMETERS: # w -> multiple selector's path # #///////////////////////////////////////////////////////////////////////////// ListTransferSel $w.sw2.lb $w.sw1.lb ListDeleteSel $w.sw2.lb EvalOnChanged $w } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::LBAllLeftToRight { w } { # # PURPOSE: Moves all items from unselected listbox to selected listbox # # PARAMETERS: # w -> multiple selector's path # #///////////////////////////////////////////////////////////////////////////// eval "$w.sw2.lb insert end [$w.sw1.lb get 0 end]" $w.sw1.lb delete 0 end EvalOnChanged $w } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::LBAllRightToLeft { w } { # # PURPOSE: Moves all items from selected listbox to unselected listbox # # PARAMETERS: # w -> multiple selector's path # #///////////////////////////////////////////////////////////////////////////// eval "$w.sw1.lb insert end [$w.sw2.lb get 0 end]" $w.sw2.lb delete 0 end EvalOnChanged $w } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::GetSelected { w } { # # PURPOSE: Gets item from selected listbox (rigth) # # PARAMETERS: # w -> multiple selector's path # #///////////////////////////////////////////////////////////////////////////// $w.sw2.lb get 0 end } #///////////////////////////////////////////////////////////////////////////// proc ::MultipleSelector::GetUnselected { w } { # # PURPOSE: Gets item from unselected listbox (left) # # PARAMETERS: # w -> multiple selector's path # #///////////////////////////////////////////////////////////////////////////// $w.sw1.lb get 0 end }