File: Toplevel.itk

package info (click to toggle)
itcl3.1 3.1.0-6
  • links: PTS
  • area: main
  • in suites: woody
  • size: 9,604 kB
  • ctags: 1,045
  • sloc: tcl: 33,268; ansic: 14,071; sh: 3,918; makefile: 762; awk: 273; perl: 265
file content (73 lines) | stat: -rw-r--r-- 2,351 bytes parent folder | download | duplicates (10)
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
71
72
73
#
# 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 ""
}