home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / tls / tls088.hpux.Z / tls088.hpux / lib / vtcl / tests / destroy.tcl < prev    next >
Encoding:
Text File  |  1995-07-20  |  2.2 KB  |  104 lines
  1. # CVS $Id: destroy.tcl,v 1.3 1995/02/03 16:54:31 zibi Exp $
  2. #
  3. # Test destroy and destroy dialog
  4. #
  5.  
  6. source tools.tcl
  7.  
  8. proc destroyDlogCB {cbs} {
  9.     set target [keylget cbs widget]
  10.  
  11.     VtDestroyDialog $target
  12. }
  13.  
  14. #
  15. # Makes a form dialog and calls the routine buildInside
  16. #
  17. proc mkDlogTst {buildInside cbs} {
  18.     set parent [keylget cbs widget]
  19.     
  20.     set dlog [VtFormDialog $parent.dlog -title $buildInside  -modeless \
  21.                -verticalSpacing 10]
  22.      
  23.     $buildInside $dlog
  24.  
  25.     VtShowDialog  $dlog
  26. }
  27.  
  28. #
  29. # Just create a button who's callback just destroys itself
  30. #
  31. proc destroyDlog {parent} {
  32.     VtPushButton $parent.destroy -label "Destroy Dialog"\
  33.     -callback destroyDlogCB
  34. }
  35.  
  36.  
  37. #
  38. # This next test creates three victims and destroys them
  39. # one by one
  40. #
  41. proc destroyCB {parent vList cbs} {
  42.     foreach but $vList {
  43.     VtDestroy $but
  44.     sleep 1
  45.     }
  46.     VtDestroyDialog $parent
  47. }
  48.  
  49. proc destroyAny {parent} {
  50.     set rc [VtRowColumn $parent.rc]
  51.  
  52.     set victimList {"Victim 1" "Victim 2" "Victim 3"}
  53.     foreach but  $victimList {
  54.     lappend vObjList [VtPushButton $rc.$but -label $but]
  55.     }
  56.  
  57.     VtPushButton $parent.destroy -label "Destroy em"\
  58.     -callback "destroyCB $parent {$vObjList}" \
  59.     -below $rc
  60. }
  61.     
  62.  
  63.  
  64. #
  65. # This routine will call Create/Destroy many, many times
  66. #
  67. proc memLeakReps {parent label cbs} {
  68.     for {set i 0} {$i < 50} {incr i} {
  69.     set boo [VtPushButton $parent.boo$i -label "boo $i"\
  70.          -shortHelpString "boo" -shortHelpCallback "QuitCB"\
  71.          -callback "QuitCB"]
  72.     VtDestroy $boo
  73.     VtSetValues $label -label $i
  74.  
  75.     }
  76. }
  77.  
  78. proc memLeak {parent} {
  79.     set label [VtLabel $parent.leak -label "Number of Reps :"]
  80.  
  81.     set num [VtLabel $parent.num -label "0" -leftSide $label -alignTop $label]
  82.  
  83.     VtPushButton $parent.start -label Start \
  84.     -leftSide FORM \
  85.     -callback "memLeakReps $parent $num"
  86.  
  87.     VtPushButton $parent.close -label Close -callback "CloseDialogCB" 
  88. }
  89.     
  90. set ap [VtOpen destroy]
  91.  
  92. set dlog [VtFormDialog $ap.form]
  93.  
  94. set rc [VtRowColumn $dlog.rc]
  95.  
  96. MakeCenteredButton $rc.destAny    "VtDestroy"         "mkDlogTst destroyAny"
  97. MakeCenteredButton $rc.destDlog   "VtDestroyDialog"   "mkDlogTst destroyDlog"
  98. MakeCenteredButton $rc.leaky      "Mem Leak"          "mkDlogTst memLeak"
  99. MakeCenteredButton $rc.exit       "Exit"              "QuitCB"
  100.  
  101. VtShowDialog $dlog
  102.  
  103. VtMainLoop
  104.