core/implementation/AutoReleasePool.tcl


@implementation AutoReleasePool {

  + new {} {
      set _id [$self alloc]
      if [string length [set _level [@getCallerLevel]]] {
        set _cmd "set AutoReleasePool $_id"
        uplevel #${_level} $_cmd
        return [$_id init]
      } else {
        puts stderr "couldn't found caller level ([info level 0])"
        return [$_id dealloc]
      }
    }

  - add: anObject {
      if {![pool contains: $anObject]} {
        set pool [linsert $pool 0 $anObject]
      }
    }

  - remove: anObject {
      if [pool contains: $anObject] {
        pool remove: $anObject
      }
    }

  - dealloc {} {
      foreach _object $pool {
        catch {$_object release}
      }
      if [string length [set _level [@getCallerLevel]]] {
        set _cmd "catch {unset AutoReleasePool}"
        uplevel #${_level} $_cmd
      } else {
        return -code error "couldn't found caller level ([info level 0])"
      }
      return [$super dealloc]
    }

  - pool {} {
      return $pool
    }

}