/usr/lib/tcltk/vtk-7.1/vtkinteraction/setget.tcl is in tcl-vtk7 7.1.1+dfsg1-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 74 75 76 77 | namespace eval ::vtk {
namespace export *
# -------------------------------------------------------------------
# Some functions that can be used to associate variables to
# widgets without polluting the global space
variable gvars
# Generate a "unique" name for a widget variable
proc get_widget_variable {widget var_name} {
variable gvars
return "gvars($widget,vars,$var_name)"
}
# Set the value of a widget variable
proc set_widget_variable_value {widget var_name value} {
variable gvars
set var [get_widget_variable $widget $var_name]
set $var $value
}
proc unset_widget_variable {widget var_name} {
variable gvars
set var [get_widget_variable $widget $var_name]
if {[info exists $var]} {
unset $var
}
}
# Get the value of a widget variable ("" if undef)
proc get_widget_variable_value {widget var_name} {
variable gvars
set var [get_widget_variable $widget $var_name]
if {[info exists $var]} {
return [expr $$var]
} else {
return ""
}
}
# Return an object which will be associated with a widget
proc new_widget_object {widget type var_name} {
variable gvars
set var [get_widget_variable $widget "${var_name}_obj"]
$type $var
set_widget_variable_value $widget $var_name $var
return $var
}
}
# Handle deprecated calls
proc GetWidgetVariable {widget varName} {
puts stderr "GetWidgetVariable is deprecated. Please use ::vtk::get_widget_variable instead"
return [::vtk::get_widget_variable $widget $varName]
}
proc SetWidgetVariableValue {widget varName value} {
puts stderr "SetWidgetVariableValue is deprecated. Please use ::vtk::set_widget_variable_value instead"
::vtk::set_widget_variable_value $widget $varName $value
}
proc GetWidgetVariableValue {widget varName} {
puts stderr "GetWidgetVariableValue is deprecated. Please use ::vtk::get_widget_variable_value instead"
return [::vtk::get_widget_variable_value $widget $varName]
}
proc NewWidgetObject {widget type varName} {
puts stderr "NewWidgetObject is deprecated. Please use ::vtk::new_widget_object instead"
return [::vtk::new_widget_object $widget $type $varName]
}
|