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                 method force_if_pending {}
  23         }
  24
  25         protected {
  26                 method _on_set_state {pending}
  27         }
  28
  29         private {
  30                 variable watchvars              {}
  31                 variable lock                   0
  32                 variable afterids               {}
  33                 variable dominos
  34
  35                 method var_update {n1 n2 op}
  36                 method fire_onchange {n1 n2 op}
  37         }
  38 }
  39
  40
  41 body tlc::Varwatch::constructor {accessvar args} { #<<<1
  42         array set dominos       {}
  43
  44         tlc::Domino #auto dominos(onchange) -name "$this onchange"
  45
  46         configure {*}$args
  47
  48         $dominos(onchange) attach_output [code $this invoke_handlers onchange]
  49 }
  50
  51
  52 body tlc::Varwatch::destructor {} { #<<<1
  53         foreach var $watchvars {
  54                 detach_dirtyvar $var
  55         }
  56         foreach afterid $afterids {
  57                 after cancel $afterid
  58         }
  59         set afterids    {}
  60 }
  61
  62
  63 body tlc::Varwatch::attach_dirtyvar {varname} { #<<<1
  64         set idx         [lsearch $watchvars $varname]
  65         if {$idx == -1} {
  66                 lappend watchvars       $varname
  67         }
  68         trace variable $varname wu [code $this var_update]
  69 }
  70
  71
  72 body tlc::Varwatch::detach_dirtyvar {varname} { #<<<1
  73         set idx                 [lsearch $watchvars $varname]
  74         set watchvars   [lreplace $watchvars $idx $idx]
  75         trace vdelete $varname wu [code $this var_update]
  76 }
  77
  78
  79 body tlc::Varwatch::arm {} { #<<<1
  80         incr lock -1
  81 }
  82
  83
  84 body tlc::Varwatch::disarm {} { #<<<1
  85         incr lock
  86 }
  87
  88
  89 body tlc::Varwatch::var_update {n1 n2 op} { #<<<1
  90         if {$lock > 0} return
  91         set_state 1
  92         if {[handlers_available onchange_info]} {
  93                 lappend afterids        [after idle [code $this fire_onchange $n1 $n2 $op]]
  94         }
  95         $dominos(onchange) tip
  96 }
  97
  98
  99 body tlc::Varwatch::force_if_pending {} { #<<<1
 100         set pending             $afterids
 101         set afterids    {}
 102         foreach afterid $pending {
 103                 set script      [lindex [after info $afterid] 0]
 104                 after cancel $afterid
 105                 if {$script ne ""} {
 106                         tlc::try {
 107                                 uplevel #0 $script
 108                         } onerr {
 109                                 default {STDMSG}
 110                         }
 111                 }
 112         }
 113         $dominos(onchange) force_if_pending
 114 }
 115
 116
 117 body tlc::Varwatch::fire_onchange {n1 n2 op} { #<<<1
 118         invoke_handlers onchange_info $n1 $n2 $op
 119 }
 120
 121
 122 body tlc::Varwatch::is_armed {} { #<<<1
 123         return [expr {($lock > 0) ? 0 : 1}]
 124 }
 125
 126
 127 body tlc::Varwatch::_on_set_state {pending} { #<<<1
 128         set pending             $afterids
 129         set afterids    {}
 130         foreach afterid $pending {
 131                 after cancel $afterid
 132         }
 133 }
 134
 135