scripts/refcounted.itcl

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 class tlc::Refcounted {
   4         constructor {} {}
   5         destructor {}
   6
   7         public {
   8                 method object_registry {varname}
   9                 method incref {args}
  10                 method decref {args}
  11                 method refcount {}
  12         }
  13
  14         protected {
  15                 method autoscoperef {}
  16         }
  17
  18         private {
  19                 variable refcount       1
  20                 variable registry_var
  21
  22                 method clear_registry {}
  23         }
  24 }
  25
  26
  27 body tlc::Refcounted::constructor {} { #<<<
  28 }
  29
  30 #>>>
  31 body tlc::Refcounted::destructor {} { #<<<
  32         clear_registry
  33 }
  34
  35 #>>>
  36 body tlc::Refcounted::autoscoperef {} { #<<<
  37         #puts stderr "Refcounted::constructor callstack: [tlc::stackdump]"
  38         upvar 2 _mware_msg_scoperef_[string map {:: //} $this] scopevar
  39         set scopevar    $this
  40         trace variable scopevar u [code $this decref]
  41 }
  42
  43 #>>>
  44 body tlc::Refcounted::incref {args} { #<<<
  45         set old         $refcount
  46         incr refcount
  47         #puts stderr "$this: refcount $old -> $refcount ($args)"
  48 }
  49
  50 #>>>
  51 body tlc::Refcounted::decref {args} { #<<<
  52         set old         $refcount
  53         incr refcount -1
  54         #puts stderr "$this: refcount $old -> $refcount ($args)"
  55         if {$refcount <= 0} {
  56                 #puts stderr "$this: our time has come"
  57                 delete object $this
  58                 return -code return
  59         }
  60 }
  61
  62 #>>>
  63 body tlc::Refcounted::refcount {} { #<<<
  64         return $refcount
  65 }
  66
  67 #>>>
  68 body tlc::Refcounted::object_registry {varname} { #<<<
  69         clear_registry
  70
  71         set registry_var        $varname
  72         upvar $registry_var var_ref
  73
  74         set var_ref             $this
  75 }
  76
  77 #>>>
  78 body tlc::Refcounted::clear_registry {} { #<<<
  79         if {[info exists registry_var]} {
  80                 upvar $registry_var old_registry
  81                 if {[info exists old_registry]} {
  82                         unset old_registry
  83                 }
  84         }
  85 }
  86
  87 #>>>