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                 variable log_cmd        ""
  16
  17                 method autoscoperef {}
  18         }
  19
  20         private {
  21                 variable refcount       1
  22                 variable registry_var
  23
  24                 method clear_registry {}
  25                 method reflog {lvl msg args}
  26         }
  27 }
  28
  29
  30 body tlc::Refcounted::constructor {} { #<<<
  31 }
  32
  33 #>>>
  34 body tlc::Refcounted::destructor {} { #<<<
  35         clear_registry
  36 }
  37
  38 #>>>
  39 body tlc::Refcounted::autoscoperef {} { #<<<
  40         reflog debug "Refcounted::constructor callstack: [tlc::stackdump]"
  41         upvar 2 _tlc_refcounted_scoperef_[string map {:: //} $this] scopevar
  42         set scopevar    $this
  43         trace variable scopevar u [code $this decref "scopevar unset"]
  44 }
  45
  46 #>>>
  47 body tlc::Refcounted::incref {args} { #<<<
  48         set old         $refcount
  49         incr refcount
  50         reflog debug "$this: refcount $old -> $refcount ($args)"
  51 }
  52
  53 #>>>
  54 body tlc::Refcounted::decref {args} { #<<<
  55         set old         $refcount
  56         incr refcount -1
  57         reflog debug "$this: refcount $old -> $refcount ($args)"
  58         if {$refcount <= 0} {
  59                 reflog debug "$this: our time has come"
  60                 delete object $this
  61                 return
  62         }
  63 }
  64
  65 #>>>
  66 body tlc::Refcounted::refcount {} { #<<<
  67         return $refcount
  68 }
  69
  70 #>>>
  71 body tlc::Refcounted::object_registry {varname} { #<<<
  72         clear_registry
  73
  74         set registry_var        $varname
  75         upvar $registry_var var_ref
  76
  77         set var_ref             $this
  78 }
  79
  80 #>>>
  81 body tlc::Refcounted::clear_registry {} { #<<<
  82         if {[info exists registry_var]} {
  83                 upvar $registry_var old_registry
  84                 if {[info exists old_registry]} {
  85                         unset old_registry
  86                 }
  87         }
  88 }
  89
  90 #>>>
  91 body tlc::Refcounted::reflog {lvl msg args} { #<<<
  92         if {$log_cmd ne ""} {
  93                 uplevel 1 $log_cmd [list $lvl $msg {*}$args]
  94         }
  95 }
  96
  97 #>>>