home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 November / CPNL0711.ISO / beeld / teken / scribus-1.3.3.9-win32-install.exe / tcl / tix8.1 / Variable.tcl < prev    next >
Text File  |  2001-11-03  |  3KB  |  102 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: Variable.tcl,v 1.3.2.1 2001/11/03 07:26:10 idiscovery Exp $
  4. #
  5. # Variable.tcl --
  6. #
  7. #    Routines in this file are used to set up and operate variables
  8. #    for classes that support the -variable option
  9. #
  10. # Copyright (c) 1993-1999 Ioi Kim Lam.
  11. # Copyright (c) 2000-2001 Tix Project Group.
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16.  
  17.  
  18.  
  19. # tixVariable:ConfigVariable --
  20. #
  21. #     Set up the -variable option for the object $w
  22. #
  23. # Side effects:
  24. #
  25. #    data(-variable) is changed to the name of the global variable
  26. #    if the global variable exists, data(-value) takes the value of this
  27. #    variable.
  28. #    if the global variable does not exist, it is created with the
  29. #    current data(-value)
  30. #
  31. # Return value:
  32. #
  33. #    true is data(-value) is changed, indicating that data(-command)
  34. #    should be invoked.
  35. #
  36. proc tixVariable:ConfigVariable {w arg} {
  37.     upvar #0 $w data
  38.  
  39.     set changed 0
  40.  
  41.     if {$data(-variable) != ""} {
  42.     uplevel #0 \
  43.         [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"]
  44.     }
  45.  
  46.     if {$arg != ""} {
  47.     if {[uplevel #0 info exists [list $arg]]} {
  48.         # This global variable exists, we use its value
  49.         #
  50.         set data(-value) [uplevel #0 set [list $arg]]
  51.         set changed 1
  52.     } else {
  53.         # This global variable does not exist; let's set it 
  54.         #
  55.         uplevel #0 [list set $arg $data(-value)]
  56.     }
  57.     uplevel #0 \
  58.         [list trace variable $arg w "tixVariable:TraceProc $w"]
  59.     }
  60.  
  61.     return $changed
  62. }
  63.  
  64. proc tixVariable:UpdateVariable {w} {
  65.     upvar #0 $w data
  66.  
  67.     if {$data(-variable) != ""} {
  68.     uplevel #0 \
  69.         [list trace vdelete  $data(-variable) w "tixVariable:TraceProc $w"]
  70.     uplevel #0 \
  71.         [list set $data(-variable) $data(-value)]
  72.     uplevel #0 \
  73.         [list trace variable $data(-variable) w "tixVariable:TraceProc $w"]
  74.  
  75.     # just in case someone has another trace and restricted my change
  76.     #
  77.     set data(-value) [uplevel #0 set [list $data(-variable)]]
  78.     }
  79. }
  80.  
  81. proc tixVariable:TraceProc {w name1 name2 op} {
  82.     upvar #0 $w data
  83.     set varname $data(-variable)
  84.  
  85.     if {[catch {$w config -value [uplevel #0 [list set $varname]]} err]} {
  86.     uplevel #0 [list set $varname [list [$w cget -value]]]
  87.     error $err
  88.     }
  89.     return
  90. }
  91.  
  92. proc tixVariable:DeleteVariable {w} {
  93.     upvar #0 $w data
  94.  
  95.     # Must delete the trace command of the -variable
  96.     #
  97.     if {$data(-variable) != ""} {
  98.     uplevel #0 \
  99.         [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"]
  100.     }
  101. }
  102.