Improve R pkg rj::tmp utilities
diff --git a/core/org.eclipse.statet.rj.server.rpkg/pkg/R/dataaccess.R b/core/org.eclipse.statet.rj.server.rpkg/pkg/R/dataaccess.R
index 9e0eb10..871f44b 100644
--- a/core/org.eclipse.statet.rj.server.rpkg/pkg/R/dataaccess.R
+++ b/core/org.eclipse.statet.rj.server.rpkg/pkg/R/dataaccess.R
@@ -133,6 +133,10 @@
rowIdxs
}
+sda002.getObject <- function(x.env, x.expr) {
+ eval(expr= x.expr)
+}
+
.getDataLevelValues <- function(x, max = 1000) {
if (is.factor(x)) {
diff --git a/core/org.eclipse.statet.rj.server.rpkg/pkg/R/init.R b/core/org.eclipse.statet.rj.server.rpkg/pkg/R/init.R
index 5b07649..73857cd 100644
--- a/core/org.eclipse.statet.rj.server.rpkg/pkg/R/init.R
+++ b/core/org.eclipse.statet.rj.server.rpkg/pkg/R/init.R
@@ -29,97 +29,6 @@
}
-## Tmp
-
-#' Returns the next available id (a element name with the specified prefix)
-#'
-#' @param prefix prefix of the element name, usually a key for a element type
-#' @param envir optional environment, default is \code{.rj.tmp}
-#' @return the id
-#' @returnType char
-tmp.createId <- function(prefix, envir = .rj.tmp) {
- i <- 1L;
- repeat {
- name <- paste(prefix, i, sep= "")
- if (!exists(name, envir = envir, inherits = FALSE)) {
- assign(name, NULL, envir= envir)
- return(name);
- }
- i <- i + 1L;
- }
-}
-
-tmp.set <- function(name, value, envir = .rj.tmp) {
- assign(name, value, envir= envir)
- return (invisible())
-}
-
-tmp.remove <- function(name, envir = .rj.tmp) {
- if (exists(name, envir= envir, inherits= FALSE)) {
- rm(list= name, envir= envir, inherits= FALSE)
- }
- return (invisible())
-}
-
-tmp.removeAll <- function(id, envir = .rj.tmp) {
- names <- ls(envir= envir, pattern= paste0("^\\Q", id, "\\E"))
- if (length(names)) {
- rm(list= names, envir= envir, inherits= FALSE)
- }
- return (invisible())
-}
-
-tmp.setReverseIndex <- function(name, index, len = NA, envir = .rj.tmp) {
- index = get(index, envir= envir, inherits= FALSE)
- if (is.na(len)) {
- len <- length(index)
- }
- index.r <- rep.int(NA_integer_, len)
- index.r[index] <- 1L:length(index)
- assign(name, index.r, envir= envir)
- return (invisible())
-}
-
-tmp.setWhichIndex <- function(name, filter, envir = .rj.tmp) {
- filter <- get(filter, envir= envir, inherits= FALSE)
- filter <- which(filter)
- assign(name, filter, envir= envir)
- return (invisible())
-}
-
-tmp.setFilteredIndex <- function(name, filter, index, envir = .rj.tmp) {
- filter <- get(filter, envir= envir, inherits= FALSE)
- index <- get(index, envir= envir, inherits= FALSE)
- if (length(dim(index)) > 1L) {
- idx <- index[,1L]
- index <- index[filter[idx],]
- }
- else {
- index <- index[filter[index]]
- }
- assign(name, index, envir= envir)
- return (invisible())
-}
-
-tmp.getFilteredCount <- function(index, filter, envir = .rj.tmp) {
- filter <- get(filter, envir= envir, inherits= FALSE)
- if (missing(index)) {
- return (sum(filter))
- }
- index <- get(index, envir= envir, inherits= FALSE)
- if (length(dim(index)) > 1L) {
- index <- index[,1L]
- }
- return (sum(filter[index]))
-}
-
-tmp.clear <- function(envir = .rj.tmp) {
- toRemove <- ls(envir= envir)
- toRemove <- toRemove[toRemove != "help"] # TODO Remove in RJ-1.2
- rm(list= toRemove, envir= envir)
-}
-
-
## Internal utils
.rj.errorHandler <- function(e) {
diff --git a/core/org.eclipse.statet.rj.server.rpkg/pkg/R/utils.R b/core/org.eclipse.statet.rj.server.rpkg/pkg/R/utils.R
new file mode 100644
index 0000000..08c7f70
--- /dev/null
+++ b/core/org.eclipse.statet.rj.server.rpkg/pkg/R/utils.R
@@ -0,0 +1,109 @@
+ #=============================================================================#
+ # Copyright (c) 2009, 2018 Stephan Wahlbrink and others.
+ #
+ # This program and the accompanying materials are made available under the
+ # terms of the Eclipse Public License 2.0 which is available at
+ # https://www.eclipse.org/legal/epl-2.0, or the Apache License, Version 2.0
+ # which is available at https://www.apache.org/licenses/LICENSE-2.0.
+ #
+ # SPDX-License-Identifier: EPL-2.0 OR Apache-2.0
+ #
+ # Contributors:
+ # Stephan Wahlbrink <sw@wahlbrink.eu> - initial API and implementation
+ #=============================================================================#
+
+
+## Client Utils
+
+
+#' Environment for temporary R objects
+.rj.tmp <- new.env()
+
+#' Returns the next available id (a element name with the specified prefix)
+#'
+#' @param prefix prefix of the element name, usually a key for a element type
+#' @param envir optional environment, default is \code{.rj.tmp}
+#' @return the id
+#' @returnType char
+tmp.createItem <- function(prefix, envir= .rj.tmp) {
+ i <- 1L;
+ repeat {
+ name <- paste0(prefix, i, ".");
+ if (!exists(name, envir= envir, inherits= FALSE)) {
+ assign(name, NULL, envir= envir);
+ return(name);
+ }
+ i <- i + 1L;
+ }
+}
+
+tmp.removeItem <- function(id, envir= .rj.tmp) {
+ names <- ls(envir= envir, pattern= paste0("^\\Q", id, "\\E"));
+ if (length(names)) {
+ rm(list= names, envir= envir, inherits= FALSE);
+ }
+ return (invisible());
+}
+
+tmp.set <- function(name, value, envir= .rj.tmp) {
+ assign(name, value, envir= envir);
+ return (invisible());
+}
+
+tmp.remove <- function(name, envir= .rj.tmp) {
+ if (exists(name, envir= envir, inherits= FALSE)) {
+ rm(list= name, envir= envir, inherits= FALSE);
+ }
+ return (invisible());
+}
+
+tmp.setReverseIndex <- function(name, index, len= NA, envir= .rj.tmp) {
+ index= get(index, envir= envir, inherits= FALSE);
+ if (is.na(len)) {
+ len <- length(index);
+ }
+ index.r <- rep.int(NA_integer_, len);
+ index.r[index] <- 1L:length(index);
+ assign(name, index.r, envir= envir);
+ return (invisible());
+}
+
+tmp.setWhichIndex <- function(name, filter, envir= .rj.tmp) {
+ filter <- get(filter, envir= envir, inherits= FALSE);
+ filter <- which(filter);
+ assign(name, filter, envir= envir);
+ return (invisible());
+}
+
+tmp.setFilteredIndex <- function(name, filter, index, envir= .rj.tmp) {
+ filter <- get(filter, envir= envir, inherits= FALSE);
+ index <- get(index, envir= envir, inherits= FALSE);
+ if (length(dim(index)) > 1L) {
+ idx <- index[,1L];
+ index <- index[filter[idx],];
+ }
+ else {
+ index <- index[filter[index]];
+ }
+ assign(name, index, envir= envir);
+ return (invisible());
+}
+
+tmp.getFilteredCount <- function(index, filter, envir =.rj.tmp) {
+ filter <- get(filter, envir= envir, inherits= FALSE);
+ if (missing(index)) {
+ return (sum(filter));
+ }
+ index <- get(index, envir= envir, inherits= FALSE);
+ if (length(dim(index)) > 1L) {
+ index <- index[,1L];
+ }
+ return (sum(filter[index]));
+}
+
+
+tmp.clear <- function(envir= .rj.tmp) {
+ toRemove <- ls(envir= envir, all.names= TRUE);
+ rm(list= toRemove, envir= envir, inherits= FALSE);
+}
+
