scripts/varwatch.itcl

   1 # vim: foldmarker=<<<,>>>
   2
   3 # Signals:
   4 #       onchange()                                      - Fired when a variable changes value
   5 #       onchange_info(n1, n2, op)       - Fired when a variable changes value
   6
   7 class tlc::Varwatch {
   8         inherit tlc::Signal
   9
  10         constructor {accessvar args} {
  11                 upvar $accessvar scopevar
  12                 eval tlc::Signal::constructor scopevar
  13         } {}
  14         destructor {}
  15
  16         public {
  17                 method attach_dirtyvar {varname}
  18                 method detach_dirtyvar {varname}
  19                 method arm {}
  20                 method disarm {}
  21                 method is_armed {}
  22         }
  23
  24         protected {
  25                 method _on_set_state {pending}
  26         }
  27
  28         private {
  29                 variable watchvars              {}
  30                 variable lock                   0
  31                 variable afterid                ""
  32
  33                 method var_update {n1 n2 op}
  34                 method fire_onchange {n1 n2 op}
  35         }
  36 }
  37
  38
  39 body tlc::Varwatch::constructor {accessvar args} { #<<<1
  40         eval configure $args
  41 }
  42
  43
  44 body tlc::Varwatch::destructor {} { #<<<1
  45         foreach var $watchvars {
  46                 detach_dirtyvar $var
  47         }
  48         after cancel $afterid; set afterid      ""
  49 }
  50
  51
  52 body tlc::Varwatch::attach_dirtyvar {varname} { #<<<1
  53         set idx         [lsearch $watchvars $varname]
  54         if {$idx == -1} {
  55                 lappend watchvars       $varname
  56         }
  57         trace variable $varname wu [code $this var_update]
  58 }
  59
  60
  61 body tlc::Varwatch::detach_dirtyvar {varname} { #<<<1
  62         set idx                 [lsearch $watchvars $varname]
  63         set watchvars   [lreplace $watchvars $idx $idx]
  64         trace vdelete $varname wu [code $this var_update]
  65 }
  66
  67
  68 body tlc::Varwatch::arm {} { #<<<1
  69         incr lock -1
  70 }
  71
  72
  73 body tlc::Varwatch::disarm {} { #<<<1
  74         incr lock
  75 }
  76
  77
  78 body tlc::Varwatch::var_update {n1 n2 op} { #<<<1
  79         if {$lock > 0} return
  80         set_state 1
  81         if {$afterid == "" && ([handlers_available onchange] || [handlers_available onchange_info])} {
  82                 set afterid             [after idle [code $this fire_onchange $n1 $n2 $op]]
  83         }
  84 }
  85
  86
  87 body tlc::Varwatch::fire_onchange {n1 n2 op} { #<<<1
  88         after cancel $afterid; set afterid      ""
  89         invoke_handlers onchange
  90         invoke_handlers onchange_info $n1 $n2 $op
  91 }
  92
  93
  94 body tlc::Varwatch::is_armed {} { #<<<1
  95         return [expr {($lock > 0) ? 0 : 1}]
  96 }
  97
  98
  99 body tlc::Varwatch::_on_set_state {pending} { #<<<1
 100         after cancel $afterid; set afterid      ""
 101 }
 102
 103