blob: 8c455e3211ed9bfa6ea352f5abd6a01086e8da6c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
#
# itk::Widget
# ----------------------------------------------------------------------
# Base class for ordinary widgets in the [incr Tk] Toolkit. Creates
# a frame to contain the widget. Derived classes add widgets and
# methods to specialize behavior.
#
# METHODS:
#
# WIDGET ATTRIBUTES:
# switch: -background .... normal background color for widget
# name: background
# class: Background
#
# switch: -cursor ........ cursor used when pointer is inside
# name: cursur widget
# class: Cursur
#
# ----------------------------------------------------------------------
# AUTHOR: Michael J. McLennan
# Bell Labs Innovations for Lucent Technologies
# mmclennan@lucent.com
# http://www.tcltk.com/itcl
#
# RCS: $Id$
# ----------------------------------------------------------------------
# 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::Widget {
inherit itk::Archetype
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
constructor {args} {
#
# Create a window with the same name as this object
#
set itk_hull [namespace tail $this]
set itk_interior $itk_hull
itk_component add hull {
frame $itk_hull -class [namespace tail [info class]]
} {
keep -background -cursor
}
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
}
}
private variable itk_hull ""
}
|
