rstudio · wch · Aug 28, 2014 · Aug 28, 2014 · Aug 28, 2014 · Aug 28, 2014
diff --git a/.travis.yml b/.travis.yml
@@ -15,7 +15,7 @@ install:
   - "[ ! -d ~/R ] && mkdir ~/R"
   - echo "options(repos = c(CRAN = 'http://cran.rstudio.com'))" > ~/.Rprofile
   - cd ..; git clone https://github.com/rstudio/htmltools.git; R CMD INSTALL htmltools; cd shiny
-  - Rscript -e "install.packages(c('xtable'), quiet = TRUE)"
+  - Rscript -e "install.packages(c('xtable', 'R6'), quiet = TRUE)"
   - Rscript -e "update.packages(instlib = '~/R', ask = FALSE, quiet = TRUE)"
   - Rscript -e "install.packages('$R_MY_PKG', dep = TRUE, quiet = TRUE)"
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -11,8 +11,7 @@ Description: Shiny makes it incredibly easy to build interactive web
     beautiful, responsive, and powerful applications with minimal effort.
 License: GPL-3
 Depends:
-    R (>= 3.0.0),
-    methods
+    R (>= 3.0.0)
 Imports:
     tools,
     utils,
@@ -21,7 +20,8 @@ Imports:
     RJSONIO,
     xtable,
     digest,
-    htmltools (>= 0.2.6)
+    htmltools (>= 0.2.6),
+    R6 (>= 2.0)
 Suggests:
     datasets,
     Cairo (>= 1.5-5),

diff --git a/NAMESPACE b/NAMESPACE
@@ -187,11 +187,10 @@ export(withMathJax)
 export(withProgress)
 export(withReactiveDomain)
 export(withTags)
-exportClasses(Progress)
+import(R6)
 import(caTools)
 import(digest)
 import(htmltools)
 import(httpuv)
-import(methods)
 import(xtable)
 importFrom(RJSONIO,fromJSON)
diff --git a/R/cache.R b/R/cache.R
@@ -2,18 +2,14 @@
 # files changes on disk. Each time the cache is dirtied, the set of files is
 # cleared. Therefore, the set of files needs to be re-built each time the cached
 # code executes. This approach allows for dynamic dependency graphs.
-CacheContext <- setRefClass(
+CacheContext <- R6Class(
   'CacheContext',
-  fields = list(
-    .dirty = 'logical',
-    .tests = 'list'
-  ),
-  methods = list(
-    initialize = function() {
-      .dirty <<- TRUE
-      # List of functions that return TRUE if dirty
-      .tests <<- list()
-    },
+  portable = FALSE,
+  public = list(
+    .dirty = TRUE,
+    # List of functions that return TRUE if dirty
+    .tests = list(),
+
     addDependencyFile = function(file) {
       if (.dirty)
         return()
@@ -53,7 +49,7 @@ CacheContext <- setRefClass(
     },
     with = function(func) {
       oldCC <- .currentCacheContext$cc
-      .currentCacheContext$cc <- .self
+      .currentCacheContext$cc <- self
       on.exit(.currentCacheContext$cc <- oldCC)
 
       return(func())

diff --git a/R/fileupload.R b/R/fileupload.R
@@ -20,18 +20,18 @@
 # form upload, i.e. traditional HTTP POST-based file upload) doesn't work with
 # the websockets package's HTTP server at the moment.
 
-FileUploadOperation <- setRefClass(
+FileUploadOperation <- R6Class(
   'FileUploadOperation',
-  fields = list(
-    .parent = 'ANY',
-    .id = 'character',
-    .files = 'data.frame',
-    .dir = 'character',
-    .currentFileInfo = 'list',
-    .currentFileData = 'ANY',
-    .pendingFileInfos = 'list'
-  ),
-  methods = list(
+  portable = FALSE,
+  public = list(
+    .parent = NULL,
+    .id = character(0),
+    .files = data.frame(),
+    .dir = character(0),
+    .currentFileInfo = list(),
+    .currentFileData = NULL,
+    .pendingFileInfos = list(),
+
     initialize = function(parent, id, dir, fileInfos) {
       .parent <<- parent
       .id <<- id
@@ -78,15 +78,16 @@ FileUploadOperation <- setRefClass(
 )
 
 #' @include map.R
-FileUploadContext <- setRefClass(
+FileUploadContext <- R6Class(
   'FileUploadContext',
-  fields = list(
-    .basedir = 'character',
-    .operations = 'Map'
-  ),
-  methods = list(
+  portable = FALSE,
+  public = list(
+    .basedir = character(0),
+    .operations = 'Map',
+
     initialize = function(dir=tempdir()) {
       .basedir <<- dir
+      .operations <<- Map$new()
     },
     createUploadOperation = function(fileInfos) {
       while (TRUE) {
@@ -95,7 +96,7 @@ FileUploadContext <- setRefClass(
         if (!dir.create(dir))
           next
 
-        op <- FileUploadOperation$new(.self, id, dir, fileInfos)
+        op <- FileUploadOperation$new(self, id, dir, fileInfos)
         .operations$set(id, op)
         return(id)
       }

diff --git a/R/map.R b/R/map.R
@@ -9,17 +9,17 @@
 # Remove of unknown key does nothing
 # Setting a key twice always results in last-one-wins
 # /TESTS
-Map <- setRefClass(
+Map <- R6Class(
   'Map',
-  fields = list(
-    .env = 'environment'
-  ),
-  methods = list(
+  portable = FALSE,
+  public = list(
+    .env = NULL,
+
     initialize = function() {
       .env <<- new.env(parent=emptyenv())
     },
     get = function(key) {
-      if (.self$containsKey(key))
+      if (self$containsKey(key))
         base::get(key, pos=.env, inherits=FALSE)
     },
     set = function(key, value) {
@@ -32,8 +32,8 @@ Map <- setRefClass(
         set(key, args[[key]])
     },
     remove = function(key) {
-      if (.self$containsKey(key)) {
-        result <- .self$get(key)
+      if (self$containsKey(key)) {
+        result <- self$get(key)
         rm(list = key, pos=.env, inherits=FALSE)
         result
       }
@@ -45,7 +45,7 @@ Map <- setRefClass(
       ls(envir=.env, all.names=TRUE)
     },
     values = function() {
-      mget(.self$keys(), envir=.env, inherits=FALSE)
+      mget(self$keys(), envir=.env, inherits=FALSE)
     },
     clear = function() {
       .env <<- new.env(parent=emptyenv())

diff --git a/R/middleware.R b/R/middleware.R
@@ -222,11 +222,11 @@ staticHandler <- function(root) {
 # return value of `createHttpuvApp` to httpuv's `startServer` function.
 #
 ## ------------------------------------------------------------------------
-HandlerList <- setRefClass("HandlerList",
-  fields = list(
-    handlers = "list"
-  ),
-  methods = list(
+HandlerList <- R6Class("HandlerList",
+  portable = FALSE,
+  public = list(
+    handlers = list(),
+
     add = function(handler, key, tail = FALSE) {
       if (!is.null(handlers[[key]]))
         stop("Key ", key, " already in use")
@@ -256,12 +256,17 @@ HandlerList <- setRefClass("HandlerList",
   )
 )
 
-HandlerManager <- setRefClass("HandlerManager",
-  fields = list(
+HandlerManager <- R6Class("HandlerManager",
+  portable = FALSE,
+  public = list(
     handlers = "HandlerList",
-    wsHandlers = "HandlerList"
-  ),
-  methods = list(
+    wsHandlers = "HandlerList",
+
+    initialize = function() {
+      handlers <<- HandlerList$new()
+      wsHandlers <<- HandlerList$new()
+    },
+
     addHandler = function(handler, key, tail = FALSE) {
       handlers$add(handler, key, tail)
     },

diff --git a/R/priorityqueue.R b/R/priorityqueue.R
@@ -4,15 +4,18 @@
 # elements have the same priority, they are served according to their order in
 # the queue." (http://en.wikipedia.org/wiki/Priority_queue)
 
-PriorityQueue <- setRefClass(
+PriorityQueue <- R6Class(
   'PriorityQueue',
-  fields = list(
+  portable = FALSE,
+  public = list(
     # Keys are priorities, values are subqueues (implemented as list)
     .itemsByPriority = 'Map',
     # Sorted vector (largest first)
-    .priorities = 'numeric'
-  ),
-  methods = list(
+    .priorities = numeric(0),
+
+    initialize = function() {
+      .itemsByPriority <<- Map$new()
+    },
     # Enqueue an item, with the given priority level (must be integer). Higher
     # priority numbers are dequeued earlier than lower.
     enqueue = function(item, priority) {

diff --git a/R/progress.R b/R/progress.R
@@ -64,20 +64,20 @@
 #' })
 #' }
 #' @seealso \code{\link{withProgress}}
-#' @rdname Progress
+#' @format NULL
+#' @usage NULL
 #' @export
-#' @export Progress
-Progress <- setRefClass(
+Progress <- R6Class(
   'Progress',
-  fields = list(
+  portable = FALSE,
+  public = list(
     .session = 'environment',
     .id = 'character',
     .min = 'numeric',
     .max = 'numeric',
     .value = 'ANY',
-    .closed = 'logical'
-  ),
-  methods = list(
+    .closed = 'logical',
+
     initialize = function(session = getDefaultReactiveDomain(), min = 0, max = 1) {
       # A hacky check to make sure the session object is indeed a session object.
       if (is.null(session$onFlush)) stop("'session' is not a session object.")

diff --git a/R/react.R b/R/react.R
@@ -1,19 +1,16 @@
-Context <- setRefClass(
+Context <- R6Class(
   'Context',
-  fields = list(
-    id = 'character',
-    .label = 'character',      # For debug purposes
-    .invalidated = 'logical',
-    .invalidateCallbacks = 'list',
-    .flushCallbacks = 'list',
-    .domain = 'ANY'
-  ),
-  methods = list(
+  portable = FALSE,
+  public = list(
+    id = character(0),
+    .label = character(0),      # For debug purposes
+    .invalidated = FALSE,
+    .invalidateCallbacks = list(),
+    .flushCallbacks = list(),
+    .domain = NULL,
+
     initialize = function(domain, label='', type='other', prevId='') {
       id <<- .getReactiveEnvironment()$nextId()
-      .invalidated <<- FALSE
-      .invalidateCallbacks <<- list()
-      .flushCallbacks <<- list()
       .label <<- label
       .domain <<- domain
       .graphCreateContext(id, label, type, prevId, domain)
@@ -24,7 +21,7 @@ Context <- setRefClass(
         env <- .getReactiveEnvironment()
         .graphEnterContext(id)
         tryCatch(
-          env$runWith(.self, func),
+          env$runWith(self, func),
           finally = .graphExitContext(id)
         )
       })
@@ -56,7 +53,7 @@ Context <- setRefClass(
     addPendingFlush = function(priority) {
       "Tell the reactive environment that this context should be flushed the
         next time flushReact() called."
-      .getReactiveEnvironment()$addPendingFlush(.self, priority)
+      .getReactiveEnvironment()$addPendingFlush(self, priority)
     },
     onFlush = function(func) {
       "Register a function to be called when this context is flushed."
@@ -77,20 +74,17 @@ Context <- setRefClass(
   )
 )
 
-ReactiveEnvironment <- setRefClass(
+ReactiveEnvironment <- R6Class(
   'ReactiveEnvironment',
-  fields = list(
-    .currentContext = 'ANY',
-    .nextId = 'integer',
+  portable = FALSE,
+  public = list(
+    .currentContext = NULL,
+    .nextId = 0L,
     .pendingFlush = 'PriorityQueue',
-    .inFlush = 'logical'
-  ),
-  methods = list(
+    .inFlush = FALSE,
+
     initialize = function() {
-      .currentContext <<- NULL
-      .nextId <<- 0L
       .pendingFlush <<- PriorityQueue$new()
-      .inFlush <<- FALSE
     },
     nextId = function() {
       .nextId <<- .nextId + 1L