#!/usr/bin/wishx
#Attempt to demonstrate a memory leak in TCL/TK/X-server
#Usage:
#  Start with a fresh (newly running) X server so it is at its minimum size
#  Run this program.  Press the Reload button multiple times (or hold it)
#  Watch the size of the X server grow
#  comment out the "configure -cursor" calls, server no longer grows

set wordfile {/usr/share/dict/words}	;#could be any data
set lines 4000				;#limit to 4000 words

set words [split [read_file $wordfile] "\n"]	;#make it into a tcl list
set words [lrange $words 0 $lines]	;#trim the list
set reps 1				;#keep track of how many times we reload

# Clear and then reload the listbox with some content data
#------------------------------------------
proc reload {} {
    global reps words

    set lb .lb    
    $lb delete 0 end
    $lb configure -cursor watch			;#comment out this line
    update
    $lb configure -cursor top_left_arrow	;#and this line to stop leak
    foreach word $words {$lb insert end $word}

    puts "reps:[incr reps]"
}

# Make the button repeat when held pressed
#------------------------------------------
proc b_press {b} {
    global baid bp
    if {[info exists baid] && $baid != {}} {after cancel $baid}	;#kill any leftover alarms
    if {$bp} {
        set baid [after 100 "$b invoke; b_press $b"]	;#push the button, reschedule a new alarm
    }
}

# Main
#------------------------------------------
button .rel -text Reload -command reload
pack .rel -side bottom -fill x
bind .rel <Button-1>		"+set ::bp 1; b_press .rel"
bind .rel <ButtonRelease-1>	"+set ::bp 0"

listbox .lb -height 40 -width 80
pack .lb -side right -fill both
reload