# # itk::Toplevel # ---------------------------------------------------------------------- # Base class for toplevel windows in the [incr Tk] Toolkit. Creates # a new toplevel window to contain the widget. Derived classes add # widgets and methods to specialize behavior. # # WIDGET ATTRIBUTES: # switch: -background .... normal background color for widget # name: background # class: Background # # switch: -cursor ........ cursor for widget # name: cursor # class: Cursor # # switch: -title ......... title given to window manager # name: title # class: Title # # ---------------------------------------------------------------------- # AUTHOR: Michael J. McLennan # Bell Labs Innovations for Lucent Technologies # mmclennan@lucent.com # http://www.tcltk.com/itcl # # RCS: $Id: Toplevel.itk,v 1.4 2007/05/24 23:29:30 hobbs Exp $ # ---------------------------------------------------------------------- # Copyright (c) 1993-1998 Lucent Technologies, Inc. # ====================================================================== # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. itcl::class itk::Toplevel { inherit itk::Archetype constructor {args} { # # Create a toplevel window with the same name as this object # set itk_hull [namespace tail $this] set itk_interior $itk_hull itk_component add hull { toplevel $itk_hull -class [namespace tail [info class]] } { keep -menu -background -cursor -takefocus } bind itk-delete-$itk_hull [list itcl::delete object $this] set tags [bindtags $itk_hull] bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull] eval itk_initialize $args } destructor { if {[winfo exists $itk_hull]} { set tags [bindtags $itk_hull] set i [lsearch $tags itk-delete-$itk_hull] if {$i >= 0} { bindtags $itk_hull [lreplace $tags $i $i] } destroy $itk_hull } itk_component delete hull set components [component] foreach component $components { set path($component) [component $component] } foreach component $components { if {[winfo exists $path($component)]} { destroy $path($component) } } } itk_option define -title title Title "" { wm title $itk_hull $itk_option(-title) } private variable itk_hull "" }