scripts/textvariable.itcl

   1 # vim: foldmarker=<<<,>>>
   2
   3 class tlc::Textvariable {
   4         inherit tlc::Baselog
   5
   6         public {
   7                 variable textvariable   ""
   8         }
   9
  10         protected {
  11                 method textvariable_changed {newvalue}
  12                 method set_textvariable {newvalue}
  13         }
  14
  15         private {
  16                 variable old_textvariable       ""
  17                 variable lock                           0
  18                 variable oldvalue                       ""
  19
  20                 method newvalue {args}
  21         }
  22 }
  23
  24
  25 configbody tlc::Textvariable::textvariable { #<<<1
  26         log debug $this
  27         if {$old_textvariable != ""} {
  28                 trace vdelete $old_textvariable w [code $this newvalue]
  29         }
  30         if {$textvariable != ""} {
  31                 trace variable $textvariable wu [code $this newvalue]
  32                 set old_textvariable    $textvariable
  33         }
  34         newvalue
  35 }
  36
  37
  38 body tlc::Textvariable::newvalue {args} { #<<<1
  39         log debug "$this lock: ($lock)"
  40         if {[lindex $args 2] == "u"} {
  41                 # unset
  42                 return
  43         }
  44         if {$lock} return
  45         if {$textvariable == ""} return
  46         if {![info exists $textvariable]} return
  47
  48         set newvalue    [set $textvariable]
  49
  50         incr lock
  51         tlc::try {
  52                 textvariable_changed $newvalue
  53
  54                 set oldvalue    $newvalue
  55         } onerr {
  56                 reject_change {
  57                         set $textvariable       $oldvalue
  58                 }
  59
  60                 default {
  61                         log error "\nDerived class textvariable_changed returned error: $errmsg\n$::errorInfo"
  62                 }
  63         }
  64         incr lock -1
  65 }
  66
  67
  68 body tlc::Textvariable::textvariable_changed {newvalue} { #<<<1
  69         # Override in derived class to be notified of updates to the textvariable
  70         log warning "$this This should be overridden in derived class"
  71 }
  72
  73
  74 body tlc::Textvariable::set_textvariable {newvalue} { #<<<1
  75         log debug "$this locked: ($lock)"
  76         if {$lock} return
  77
  78         incr lock
  79
  80         if {$textvariable != ""} {
  81                 set $textvariable       $newvalue
  82         }
  83
  84         incr lock -1
  85 }
  86
  87