itcl/itk/library/Widget.itk

   1 #
   2 # itk::Widget
   3 # ----------------------------------------------------------------------
   4 # Base class for ordinary widgets in the [incr Tk] Toolkit.  Creates
   5 # a frame to contain the widget.  Derived classes add widgets and
   6 # methods to specialize behavior.
   7 #
   8 #   METHODS:
   9 #
  10 #   WIDGET ATTRIBUTES:
  11 #     switch:  -background .... normal background color for widget
  12 #       name:  background
  13 #      class:  Background
  14 #
  15 #     switch:  -cursor ........ cursor used when pointer is inside
  16 #       name:  cursur           widget
  17 #      class:  Cursur
  18 #
  19 # ----------------------------------------------------------------------
  20 #   AUTHOR:  Michael J. McLennan
  21 #            Bell Labs Innovations for Lucent Technologies
  22 #            mmclennan@lucent.com
  23 #            http://www.tcltk.com/itcl
  24 #
  25 #      RCS:  $Id$
  26 # ----------------------------------------------------------------------
  27 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
  28 # ======================================================================
  29 # See the file "license.terms" for information on usage and
  30 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  31
  32 itcl::class itk::Widget {
  33     inherit itk::Archetype
  34
  35     # ------------------------------------------------------------------
  36     #  CONSTRUCTOR
  37     # ------------------------------------------------------------------
  38     constructor {args} {
  39         #
  40         #  Create a window with the same name as this object
  41         #
  42         set itk_hull [namespace tail $this]
  43         set itk_interior $itk_hull
  44
  45         itk_component add hull {
  46             frame $itk_hull -class [namespace tail [info class]]
  47         } {
  48             keep -background -cursor
  49         }
  50         bind itk-delete-$itk_hull <Destroy> "itcl::delete object $this"
  51
  52         set tags [bindtags $itk_hull]
  53         bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
  54
  55         eval itk_initialize $args
  56     }
  57
  58     destructor {
  59         if {[winfo exists $itk_hull]} {
  60             set tags [bindtags $itk_hull]
  61             set i [lsearch $tags itk-delete-$itk_hull]
  62             if {$i >= 0} {
  63                 bindtags $itk_hull [lreplace $tags $i $i]
  64             }
  65             destroy $itk_hull
  66         }
  67         itk_component delete hull
  68
  69         set components [component]
  70         foreach component $components {
  71             set path($component) [component $component]
  72         }
  73         foreach component $components {
  74             if {[winfo exists $path($component)]} {
  75                 destroy $path($component)
  76             }
  77         }
  78     }
  79
  80     private variable itk_hull ""
  81 }