Subversion Repositories or1k

#

# 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.1.1 2002-01-16 10:24:47 markom 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  "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 ""

}