You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
74 lines
2.3 KiB
Plaintext
74 lines
2.3 KiB
Plaintext
15 years ago
|
#
|
||
|
|
# 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 ""
|
||
|
|
}
|