home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / ITCL / _ITCL.TAR / usr / lib / itcl / destroy.tcl next >
Encoding:
Text File  |  1994-09-14  |  2.3 KB  |  56 lines
  1. # destroy
  2. # ----------------------------------------------------------------------
  3. # Replacement for the usual Tk "destroy" command.
  4. # Recognizes mega-widgets as [incr Tcl] objects and deletes them
  5. # appropriately.  Destroys ordinary Tk windows in the usual manner.
  6. # ----------------------------------------------------------------------
  7. #   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
  8. #            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
  9. #
  10. #      RCS:  destroy.tcl,v 1.1 1994/04/22 13:36:07 mmc Exp
  11. # ----------------------------------------------------------------------
  12. #               Copyright (c) 1994  AT&T Bell Laboratories
  13. # ======================================================================
  14. # Permission to use, copy, modify, and distribute this software and its
  15. # documentation for any purpose and without fee is hereby granted,
  16. # provided that the above copyright notice appear in all copies and that
  17. # both that the copyright notice and warranty disclaimer appear in
  18. # supporting documentation, and that the names of AT&T Bell Laboratories
  19. # any of their entities not be used in advertising or publicity
  20. # pertaining to distribution of the software without specific, written
  21. # prior permission.
  22. #
  23. # AT&T disclaims all warranties with regard to this software, including
  24. # all implied warranties of merchantability and fitness.  In no event
  25. # shall AT&T be liable for any special, indirect or consequential
  26. # damages or any damages whatsoever resulting from loss of use, data or
  27. # profits, whether in an action of contract, negligence or other
  28. # tortuous action, arising out of or in connection with the use or
  29. # performance of this software.
  30. # ======================================================================
  31.  
  32. if {[info commands tk_destroy] == ""} {
  33.     rename destroy tk_destroy
  34. }
  35.  
  36. # ----------------------------------------------------------------------
  37. #  USAGE:  destroy ?window window...?
  38. #
  39. #  Replacement for the usual Tk "destroy" command.  Destroys both
  40. #  Tk windows and [incr Tcl] objects.
  41. # ----------------------------------------------------------------------
  42. proc destroy {args} {
  43.     global itcl_destroy
  44.  
  45.     foreach win $args {
  46.         if {[itcl_info objects $win] != "" &&
  47.             ![info exists itcl_destroy($win)]} {
  48.             set itcl_destroy($win) "in progress"
  49.             $win delete
  50.             unset itcl_destroy($win)
  51.         } else {
  52.             tk_destroy $win
  53.         }
  54.     }
  55. }
  56.