Fold refClass2 into refClass

NAMESPACE

@@ -1,8 +1,5 @@
 # Generated by roxygen2 (4.0.0): do not edit by hand
 
 S3method(print,RefClass)
-S3method(print,RefClass2)
-S3method(print,RefClass2Generator)
 S3method(print,RefClassGenerator)
 export(createRefClass)
-export(createRefClass2)

R/print.R

@@ -1,3 +1,30 @@
+#' @export
+print.RefClass <- function(x, ...) {
+  cat("<", class(x)[1], ">\n", sep = "")
+
+  if (is.environment(x$private)) {
+    cat(
+      "  Private:\n",
+      indent(object_summaries(x$private), 4),
+      "\n",
+      sep = ""
+    )
+  }
+
+  cat(
+    "  Public:\n",
+    indent(object_summaries(x), 4),
+    sep = ""
+  )
+}
+
+#' @export
+print.RefClassGenerator <- function(x, ...) {
+  classname <- x$classname
+  if (is.null(classname)) classname <- "unnamed"
+  cat("<", classname, "> object generator", sep = "")
+}
+
 # Return a summary string of the items of a list or environment
 # x must be a list or environment
 object_summaries <- function(x) {

R/ref_class.R

@@ -1,17 +1,25 @@
-#' Reference class generator, with all public members
+#' Reference class generator, with public and optional private members
 #'
 #' Classes created by this generator have the following properties:
 #' \itemize{
-#'   \item Has public members only (no private).
-#'   \item Each object created by the generator's \code{$new} function is the
-#'     public environment, with a class.
-#'   \item Methods can directly access the public (or object) environment, by
-#'     using \code{self$foo}. Assignment can be done with \code{<<-}, but it's
-#'     more precise to explicitly use \code{self}.
-#'   \item Active bindings can be used to call a function that looks like an
-#'     object.
-#'   \item The execution environment of all methods is set to the public
-#'     environment.
+#'   \item Has public members, and optionally has private members, as well as
+#'     active bindings.
+#'   \item If there are any private members, they are put in a private
+#'     environment, which is the parent of the public environment. The parent
+#'     of the private environment is set with the \code{parent_env} argument.
+#'   \item If there are no private members, then no private environment is
+#'     created, and the parent of the public environment is set with
+#'     \code{parent_env}.
+#'   \item The generator's \code{$new} method creates a new object and returns
+#'     its public environment, which has a class attribute.
+#'   \item Methods can directly access the public and private environments, by
+#'     using \code{private$foo} or \code{self$foo} (for public). Assignment to
+#'     either environment can be done with \code{<<-}, but it's more precise to
+#'     explicitly specify \code{private} or \code{self}.
+#'   \item The enclosing environment of all methods is set to the public
+#'     environment, even if for private methods. In other words, rivate methods
+#'     are found in the private environment, but when they are called, their
+#'     parent environment is the public environment.
 #'   \item Each instance of the class has its own copy of each method. The
 #'     memory cost of this is small; it should be 56 bytes per method.
 #' }
@@ -28,103 +36,113 @@
 #' @seealso \code{\link{makeActiveBinding}}
 #' @export
 #' @param classname Name of the class.
-#' @param members A list of public members, which can be functions and
+#' @param public A list of public members, which can be functions and
 #'   non-functions.
+#' @param private An optional list of private members, which can be functions
+#'   and non-functions.
+#' @param active An optional list of active binding functions.
 #' @param parent_env An environment to use as the parent of newly-created
 #'   objects.
-#' @param active An optional list of active binding functions.
 #' @param lock Should the environments of the generated objects be locked?
 #' @examples
-#' Class4 <- createRefClass("Class4",
-#'   members = list(
+#' MyClass <- createRefClass("MyClass",
+#'   private = list(
 #'     x = 1,
 #'     y = 2,
-#'     initialize = function(x = NULL, y = NULL) {
-#'       if (!is.null(x)) self$x <- x
-#'       if (!is.null(y)) self$y <- y
+#'     sum_xz = function() x + z
+#'   ),
+#'   public = list(
+#'     z = 3,
+#'     initialize = function(x = NULL, y = NULL, z = NULL) {
+#'       if (!is.null(x)) private$x <- x
+#'       if (!is.null(y)) private$y <- y
+#'       if (!is.null(z)) self$z  <- z
 #'     },
-#'     # Set a variable
-#'     set_x = function(value) self$x <- value,
-#'     # Set a variable with <<-
-#'     set_y = function(value) y <<- value,
-#'     # Access variables
-#'     sum_xy = function() x + y,
-#'     # Access variables and a method
-#'     sum_xy2 = function() x + y + sum_xy()
+#'     # Set a private variable
+#'     set_x = function(value) private$x <- value,
+#'     # Access private and public variables
+#'     sum_xyz = function() x + y + z,
+#'     # Access a private variable and private method
+#'     sum_xyz2 = function() y + sum_xz()
 #'   ),
 #'   active = list(
 #'     x2 = function(value) {
 #'       if (missing(value)) return(x * 2)
-#'       else self$x <- value/2
+#'       else private$x <- value/2
 #'     }
 #'   )
 #' )
 #'
-#' # Create a new object with a specified value for y
-#' z <- Class4$new(y = 10)
+#' z <- MyClass$new(11, z = 13)
 #'
-#' z$sum_xy()
-#' # z$x <- 20  # Set member directly
-#' z$sum_xy()
-#' z$set_x(40)  # Set member with setter function
-#' z$set_y(60)
-#' z$sum_xy()
-#' z$sum_xy2()
+#' z$sum_xyz()
+#' z$sum_xyz2()
+#' # z$x <- 20  # Error - can't access private member directly
+#' z$set_x(20)
+#' z$sum_xyz()
+#' z$sum_xyz2()
+#' z$z <- 100   # Can set public members directly
+#' z$sum_xyz()
 #'
 #' z$x2         # An active binding that returns x*2
-#' z$x2 <- 100  # Setting an active binding
-#' z$x          # 50
+#' z$x2 <- 1000 # Setting an active binding
+#' z$sum_xyz()  # 515
 #'
 #' # Print, using the print.RefClass method:
 #' print(z)
-createRefClass <- function(classname = NULL, members = list(), active = NULL,
-                           parent_env = parent.frame(), lock = TRUE) {
+createRefClass <- function(classname = NULL, public = list(),
+                            private = NULL, active = NULL,
+                            parent_env = parent.frame(), lock = TRUE) {
+
+  has_private <- !is.null(private)
 
   newfun <- function(...) {
-    env <- new.env(parent = parent_env, hash = (length(members) > 100))
+    if (has_private) {
+      private_env <- new.env(parent = parent_env, hash = (length(private) > 100))
+      public_env <- new.env(parent = private_env, hash = (length(public) > 100))
+    } else {
+      public_env <- new.env(parent = parent_env, hash = (length(public) > 100))
+    }
 
     # Fix environment for functions
-    members <- assign_func_envs(members, env)
+    public <- assign_func_envs(public, public_env)
 
     # Copy objects to environments
-    list2env(members, envir = env)
+    list2env(public, envir = public_env)
+
+    # Add self pointer
+    public_env$self <- public_env
 
-    env$self <- env
+    # Do same for private
+    if (has_private) {
+      private <- assign_func_envs(private, public_env)
+      list2env(private, envir = private_env)
+      # Add private and self pointers
+      public_env$private <- private_env
+      private_env$private <- private_env
+      private_env$self <- public_env
+    }
 
     if (!is.null(active)) {
-      active <- assign_func_envs(active, env)
+      active <- assign_func_envs(active, public_env)
 
       for (name in names(active)) {
-        makeActiveBinding(name, active[[name]], env)
+        makeActiveBinding(name, active[[name]], public_env)
       }
     }
 
-    if (lock) lockEnvironment(env)
-    if (is.function(env$initialize)) env$initialize(...)
+    if (lock) {
+      if (has_private) lockEnvironment(private_env)
+      lockEnvironment(public_env)
+    }
+    if (is.function(public_env$initialize)) public_env$initialize(...)
 
-    class(env) <- c(classname, "RefClass")
-    env
+    class(public_env) <- c(classname, "RefClass")
+    public_env
   }
 
   structure(
     list(new = newfun, classname = classname),
     class = "RefClassGenerator"
   )
 }
-
-#' @export
-print.RefClass <- function(x, ...) {
-  cat(
-    "<", class(x)[1], ">\n",
-    indent(object_summaries(x), 2),
-    sep = ""
-  )
-}
-
-
-#' @export
-print.RefClassGenerator <- function(x, ...) {
-  classname <- x$classname
-  if (is.null(classname)) classname <- "unnamed"
-  cat("<", classname, "> object generator", sep = "")
-}