| # |
| # 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.1 1998/07/27 18:45:27 stanton 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 -background -cursor -takefocus |
| } |
| bind itk-delete-$itk_hull <Destroy> "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_option define -title title Title "" { |
| wm title $itk_hull $itk_option(-title) |
| } |
| |
| private variable itk_hull "" |
| } |