Add a modifying function for raw rxUi objects (& tests)

NAMESPACE

@@ -8,6 +8,7 @@ S3method("$",rxSymInvCholEnv)
 S3method("$",rxUi)
 S3method("$<-",rxSolve)
 S3method("$<-",rxSymInvCholEnv)
+S3method("$<-",rxUi)
 S3method("+",rxSolve)
 S3method("+",solveRxDll)
 S3method("[",rxSolve)
@@ -139,6 +140,7 @@ S3method(rxUiGet,lhsTheta)
 S3method(rxUiGet,lhsVar)
 S3method(rxUiGet,lstChr)
 S3method(rxUiGet,md5)
+S3method(rxUiGet,model)
 S3method(rxUiGet,modelDesc)
 S3method(rxUiGet,modelFun)
 S3method(rxUiGet,muRefTable)

R/rxUiGet.R

@@ -235,6 +235,7 @@ rxUiGet.iniFun <- function(x, ...) {
 }
 attr(rxUiGet.iniFun, "desc") <- "normalized, quoted `ini()` block"
 
+
 #' @export
 #' @rdname rxUiGet
 rxUiGet.modelFun <- function(x, ...) {
@@ -243,6 +244,11 @@ rxUiGet.modelFun <- function(x, ...) {
 }
 attr(rxUiGet.modelFun, "desc") <- "normalized, quoted `model()` block"
 
+#' @export
+#' @rdname rxUiGet
+rxUiGet.model <- rxUiGet.modelFun
+
+
 #' @export
 #' @rdname rxUiGet
 rxUiGet.modelDesc <- function(x, ...) {
@@ -365,8 +371,15 @@ attr(rxUiGet.covLhs, "desc") <- "cov->lhs translation"
 #' @rdname rxUiGet
 rxUiGet.default <- function(x, ...) {
   .arg <- class(x)[1]
-  if (!exists(.arg, envir=x[[1]])) return(NULL)
-  get(.arg, x[[1]])
+  .ui <- x[[1]]
+  if (!exists(.arg, envir=.ui)) {
+    .meta <- get("meta", envir=.ui)
+    if (exists(.arg, envir=.meta)) {
+      return(get(.arg, envir=.meta))
+    }
+    return(NULL)
+  }
+  get(.arg, .ui)
 }
 
 .rxUiGetEnvInfo <- c("model"="Original Model (with comments if available)",

R/ui-assign-parts.R

@@ -291,3 +291,30 @@
 `RxODE<-` <- function(x, envir=environment(x), value) {
   UseMethod("rxode2<-")
 }
+
+#' @export
+`$<-.rxUi` <- function(x, name, value) {
+  .raw <- inherits(x, "raw")
+  if (!.raw) {
+    assign(name, value, envir=x)
+    return(x)
+  }
+  .x <- x
+  if (name %in% c("ini", "iniDf")) {
+    ini(x) <- value
+    return(x)
+  }
+  if (name == "model") {
+    model(x) <- value
+    return(x)
+  }
+  .x <- rxUiDecompress(.x)
+  if (exists(name, .x)) {
+    stop("'", name, "' is a fixed UI component and should not be overwritten",
+         call.=FALSE)
+  }
+  .meta <- get("meta", .x)
+  assign(name, value, envir=.meta)
+  .x <- rxUiCompress(.x)
+  .x
+}