Tk Source Code

Artifact 6afb8cfd267976b3d37238b25123563a07cb25ef:

Attachment "crash1.tcl" to ticket [661549ffff] added by vwartelle 2003-01-03 18:10:05.

---

#
#   crash wish with toplevel / other toplevel /  build content 
#   with comboboxes / update idletasks / wm transient
#

#   crashes on windows xp (version 5.1.2600)

#   modify the program (crash1.tcl) to provide
#   the right path to combobox 2.2.1

#   source the program, it creates
#   - a main window
#   - a transient sub window

#   click "quit" in the sub window
#   click "generate" in the main window

#   when clicking on any other application,
#   wish gets crashed.



wm withdraw .


# require combobox
set LIBPATH /vincent/dag/libwrap
if {  [lsearch -exact $auto_path "$LIBPATH/combobox221"] == -1 } {
    lappend auto_path "$LIBPATH/combobox221"
}
package require combobox
namespace import -force ::combobox::*


#   create the main window
proc create_main { win } {
    catch { destroy $win }

    toplevel $win
    set ::mainwin $win

    wm protocol $win WM_DELETE_WINDOW "delete_window $win"
    
    wm geometry $win "600x400+50+50"
    focus -force $win
    generate_subs $win
}

#   generate the subwindows
proc generate_subs { mainwin } {
    for { set i 1 } { $i < 2 } {incr i } {
        create_sub .sub[set i] $i
    }
    focus -force $mainwin
}



#   fill a window (main or sub) with comboboxes
proc fill_win { win type j } {
    for { set x 1 } { $x < 10 } { incr x } {
        set ::sub($win,$x) "variable - $x - [expr rand()]"
        for { set y 1 } { $y < 20 } { incr y } {
            lappend ::bigvar($x,$y) "this is  - $x,$y - "
        }

    } 
    
    for { set i 1 } { $i < 10 } { incr i } {
        catch { destroy $win.f[set i]}
        frame $win.f[set i]
        label $win.f[set i].lab[set i] -text "label [set i]"
        # entry $win.f[set i].ent[set i] -textvariable ::sub($win,$i)
        combobox $win.f[set i].ent[set i]
        $win.f[set i].ent[set i] insert end $::sub($win,$i)
                 
        pack $win.f[set i].lab[set i] -side left
        pack $win.f[set i].ent[set i] -side right
        pack $win.f[set i] -side top
    
    }
    
    if { $type == "sub" } {
        catch { destroy $win.quit}
        button $win.quit -text "quit" -command "delete_window $win"
        pack $win.quit
    } elseif { $type == "main" } {
        catch { destroy $win.gen }
        button $win.gen -text "generate" -command "generate_subs $win"
        pack $win.gen
    }
    
    focus -force $win
    
}

#   create a sub window
proc create_sub { win i } {
    puts "create_sub $win $i"
    catch { destroy $win }

    toplevel $win

    wm protocol $win WM_DELETE_WINDOW "delete_window $win"
    set x [expr $i * 10]
    wm geometry $win "+$x+$x"
    
    wm title $win "window $win: $i"

    fill_win $win "sub" $i

    update idletasks
     
    wm resizable $win 0 0 

    wm transient $win $::mainwin
    
    focus -force $win
    
}

#   delete a sub window 
#   when deleting a subwindow, refill the main window
proc delete_window { win } {
    puts "delete_window $win"

    fill_win .main "main" 0

    if { [grab status $win] != "none" } {
        grab release $win
        puts "$win : was modal"
    }
    if { [wm transient $win] != "" } {
        wm transient $win ""
        puts "$win : was transient"

    }
    
    if { [winfo exists $win] } {
        set ::geom($win) [wm geometry $win]
        # set invisible
        wm state $win withdrawn
        # assign nothing to wm protocol before to delete
        wm protocol $win WM_DELETE_WINDOW ""

        destroy $win        
    }
    update idletasks

}

create_main .main