#Copyright 2001, R. Gentleman, all rights reserved.

#A simple class structure for containers
#These are simply lists where the list can contain only
#objects of the specified class


setClass("container", representation( x = "list", content =
                                     "character", locked = "logical"),
         prototype = list(x=vector("list", 0), content="object",
                                     locked=FALSE))

if( !isGeneric("content") )
    setGeneric("content", function(object)
 standardGeneric("content"))

setMethod("content", "container", function(object) object@content)

if( !isGeneric("locked") )
    setGeneric("locked", function(object)
 standardGeneric("locked"))

setMethod("locked", "container", function(object) object@locked )

setReplaceMethod("[[", "container", function(x,..., value) {
    if( locked(x) )
        stop("cannot assign into a locked container")
    cv <- class(value)
    cont <- content(x)
    if( !extends(cv, cont) )
        stop(paste("the container is class", cont,
                   "the object is class", cv, "cannot assign",
                   sep=" "))
    l1 <- list(...)
    x@x[[l1[[1]]]] <- value
    x
})

setMethod("[[", "container", function(x,...) {
    x@x[[...]]
})

setMethod("show", "container", function(object) {
    cat("Container of ", content(object), "\n", sep="")
    print(object@x)
})

setMethod("[", "container",
    def = function(x, ..., drop = F){
      new("container", content = content(x), x = x@x[...],
          locked = locked(x))
})


x1 <- new("container", x=vector("list", length=3), content="lm")

lm1 <- lm(rnorm(10)~runif(10))

x1[[1]] <- lm1