I686LINUX/util/I686LINUX/lib/vtk/tcl/vtkinteraction/setget.tcl

   1 namespace eval ::vtk {
   2
   3     namespace export *
   4
   5     # -------------------------------------------------------------------
   6     # Some functions that can be used to associate variables to
   7     # widgets without polluting the global space
   8
   9     variable gvars
  10
  11     # Generate a "unique" name for a widget variable
  12
  13     proc get_widget_variable {widget var_name} {
  14         variable gvars
  15         return "gvars($widget,vars,$var_name)"
  16     }
  17
  18     # Set the value of a widget variable
  19
  20     proc set_widget_variable_value {widget var_name value} {
  21         variable gvars
  22         set var [get_widget_variable $widget $var_name]
  23         set $var $value
  24     }
  25
  26     proc unset_widget_variable {widget var_name} {
  27         variable gvars
  28         set var [get_widget_variable $widget $var_name]
  29         if {[info exists $var]} {
  30             unset $var
  31         }
  32     }
  33
  34     # Get the value of a widget variable ("" if undef)
  35
  36     proc get_widget_variable_value {widget var_name} {
  37         variable gvars
  38         set var [get_widget_variable $widget $var_name]
  39         if {[info exists $var]} {
  40             return [expr $$var]
  41         } else {
  42             return ""
  43         }
  44     }
  45
  46     # Return an object which will be associated with a widget
  47
  48     proc new_widget_object {widget type var_name} {
  49         variable gvars
  50         set var [get_widget_variable $widget "${var_name}_obj"]
  51         $type $var
  52         set_widget_variable_value $widget $var_name $var
  53         return $var
  54     }
  55 }
  56
  57 # Handle deprecated calls
  58
  59 proc GetWidgetVariable {widget varName} {
  60     puts stderr "GetWidgetVariable is deprecated. Please use ::vtk::get_widget_variable instead"
  61     return [::vtk::get_widget_variable $widget $varName]
  62 }
  63
  64 proc SetWidgetVariableValue {widget varName value} {
  65     puts stderr "SetWidgetVariableValue is deprecated. Please use ::vtk::set_widget_variable_value instead"
  66     ::vtk::set_widget_variable_value $widget $varName $value
  67 }
  68
  69 proc GetWidgetVariableValue {widget varName} {
  70     puts stderr "GetWidgetVariableValue is deprecated. Please use ::vtk::get_widget_variable_value instead"
  71     return [::vtk::get_widget_variable_value $widget $varName]
  72 }
  73
  74 proc NewWidgetObject {widget type varName} {
  75     puts stderr "NewWidgetObject is deprecated. Please use ::vtk::new_widget_object instead"
  76     return [::vtk::new_widget_object $widget $type $varName]
  77 }