Tk Library Source Code

Artifact a5dec1c3369feebb6a72c58b733559abc4187638:

#! /usr/bin/wish

# BWidgets 1.6.0 BUG: tk crashes when selecting interdependent ComboBoxes
#
# Steps: 
#	1. Select "elementA" from ComboBox 1
#	2. Select any element from ComboBox 2
# 	3. Select "elementB" from ComboBox 1
#	4. Select any element from ComboBox 2
#	5. tk crashes.
#		* Notice that tk does not crash if you select "elementC"
#		  instead of "elementB" in step 3 above.
#
# Proposed reason: 
#	The selection from step 3 changes the list of values in
#	ComboBox 2. If the new list of values for ComboBox 2 is 
#	less than or greater than the number of values from step
# 	1, when selecting ComboBox 2, tk crashes. 
#
##############################################################
# ::Test module namespace
##############################################################
namespace eval Test {
	# Global widgets 
	variable combo_2
	variable combo_1
	variable cb
		
    	# Global Variables
	variable combo_display		""
	variable combo2_text		""
	variable select_combo2		1
}

# ------------------------------------------------------------------------------
#  Command Test::get_list
# ------------------------------------------------------------------------------
proc Test::get_list {which} { 	
	if { $which == "elementA" } {
		return [list "l1" "l2"]
        } elseif { $which == "elementB" } {
        	return [list "l1" "l2" "l3" "l4" "l5" "l6"]
        } elseif { $which == "elementC" } {
        	return [list "l1" "l2"]
        } 
        return -code error "Cannot determine list to get."
} 

# ------------------------------------------------------------------------------
#  Command Test::change_list
# ------------------------------------------------------------------------------
proc Test::change_list { } { 
	variable combo_2
	variable combo2_text
	
	if { $combo2_text != "" } {
		$combo_2 configure -text ""	
		set rt [catch {set theList [Test::get_list $combo2_text]} err]
		if {$rt != 0} {
			tk_messageBox -icon error -type ok -title "Error" -message "$err"
			return -1
		} 
		$combo_2 configure -values $theList
        } else {
        	$combo_2 configure -values ""
        }
     	return 0
} 

# ------------------------------------------------------------------------------
#  Command Test::populate_combo2
# ------------------------------------------------------------------------------
proc Test::populate_combo2 { } { 
	variable combo_1	   
	set theList [list "elementA" "elementB" "elementC"]
     	$combo_1 configure -values $theList
     	return 0
} 

# ------------------------------------------------------------------------------
#  Command Test::create
# ------------------------------------------------------------------------------
proc Test::create { } {
	variable combo_1
     	variable combo_2	
	variable cb
	
	set entry_frame [frame .entry_frame]
	set lbl [Label $entry_frame.lbl -text "ComboBox 1:"]
	set combo_1 [ComboBox $entry_frame.combo_1  \
		-textvariable Test::combo2_text \
		-modifycmd { Test::change_list} \
		-entrybg white]  
	set combo_2 [ComboBox $entry_frame.combo_2 -width 20 \
		-editable 1 \
		-entrybg white \
		-textvariable Test::combo_display]  
	set b1 [button $entry_frame.b1 -text "Close" -command {exit}]	
	pack $entry_frame -side left -fill both -padx 10 -anchor center
	pack $lbl -side top -anchor nw
	pack $combo_1 -side top -anchor nw -fill x -padx 15 -pady 5
	pack $combo_2 -side top -anchor nw -fill x
	pack $b1 -side top -anchor center -pady 10	
	return 0
}

proc Test::main {} {
	# Load BWidget package into the interpreter
	set rt [catch {set version [package require BWidget]} err]
	if {$rt != 0 } {
		tk_messageBox -icon error -type ok -title "Missing BWidgets" -message \
			"Missing BWidgets package.  Ensure that you \n\
			TCL/TK includes BWdigets, which can be found at\n\n\
			http://sourceforge.net/projects/tcllib"
		exit
	}
	wm withdraw .
	wm title . "Test"
	Test::create  
	Test::populate_combo2  	
	set width 200
	set height 150
	wm geom . ${width}x${height}
	wm deiconify .
	raise .
	focus -force .
	return 0
}

#######################################################
# Start script here
Test::main