[education/rkward] /: Harmonize naming for C calls, and remove nesting, where it is not needed.
Thomas Friedrichsmeier
null at kde.org
Sat May 18 13:33:40 BST 2024
Git commit 28bfba21daf62b035cfa9c08d69e112095c7008c by Thomas Friedrichsmeier.
Committed on 18/05/2024 at 12:21.
Pushed by tfry into branch 'master'.
Harmonize naming for C calls, and remove nesting, where it is not needed.
M +2 -2 rkward/rbackend/rkrbackend.cpp
M +1 -1 rkward/rbackend/rpackages/rkward/R/base_overrides.R
M +15 -15 rkward/rbackend/rpackages/rkward/R/internal.R
M +1 -1 rkward/rbackend/rpackages/rkward/R/internal_graphics.R
M +5 -5 rkward/rbackend/rpackages/rkward/R/public_graphics.R
M +1 -1 rkward/rbackend/rpackages/rkward/R/rk.edit-functions.R
M +5 -5 rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
M +12 -12 rkward/rbackend/rpackages/rkward/R/rk.output.R
M +1 -1 rkward/rbackend/rpackages/rkward/R/rk.plugin-functions.R
M +1 -1 rkward/rbackend/rpackages/rkward/R/rk.sessionInfo.R
M +2 -2 rkward/rbackend/rpackages/rkward/R/rk.sync-functions.R
M +1 -1 tests/import_export_plugins/git_install.messages.txt
M +1 -1 tests/import_export_plugins/import_csv_overwrite.messages.txt
M +3 -3 tests/rkward_application_tests/rk_output_test.messages.txt
https://invent.kde.org/education/rkward/-/commit/28bfba21daf62b035cfa9c08d69e112095c7008c
diff --git a/rkward/rbackend/rkrbackend.cpp b/rkward/rbackend/rkrbackend.cpp
index b11edfb6c..b3b99f88c 100644
--- a/rkward/rbackend/rkrbackend.cpp
+++ b/rkward/rbackend/rkrbackend.cpp
@@ -876,7 +876,7 @@ void doError (const QString &callstring) {
}
// TODO: Pass nested/sync as a single enum value, in the first place
-SEXP doSubstackCall (SEXP _call, SEXP _args, SEXP _sync, SEXP _nested) {
+SEXP doRCall (SEXP _call, SEXP _args, SEXP _sync, SEXP _nested) {
RK_TRACE (RBACKEND);
RFn::R_CheckUserInterrupt ();
@@ -1092,7 +1092,7 @@ bool RKRBackend::startR () {
// NOTE: Intermediate cast to void* to avoid compiler warning
{ "rk.check.env", (DL_FUNC) (void*) &checkEnv, 1 },
{ "rk.simple", (DL_FUNC) (void*) &doSimpleBackendCall, 1},
- { "rk.call", (DL_FUNC) (void*) &doSubstackCall, 4 },
+ { "rk.call", (DL_FUNC) (void*) &doRCall, 4 },
{ "rk.get.structure", (DL_FUNC) (void*) &doGetStructure, 4 },
{ "rk.get.structure.global", (DL_FUNC) (void*) &doGetGlobalEnvStructure, 3 },
{ "rk.copy.no.eval", (DL_FUNC) (void*) &doCopyNoEval, 4 },
diff --git a/rkward/rbackend/rpackages/rkward/R/base_overrides.R b/rkward/rbackend/rpackages/rkward/R/base_overrides.R
index f3b7a8709..41be0de20 100644
--- a/rkward/rbackend/rpackages/rkward/R/base_overrides.R
+++ b/rkward/rbackend/rpackages/rkward/R/base_overrides.R
@@ -50,7 +50,7 @@
if (!suppressWarnings(base::require(as.character(package), quietly = quietly, character.only = TRUE, ...))) {
if (missing (package)) stop ("No package name given")
rk.capture.output(allow.nesting=FALSE)
- try(.rk.do.call("require", as.character(package)))
+ try(.rk.call.nested("require", as.character(package)))
rk.end.capture.output()
invisible(base::require(as.character(package), quietly = TRUE, character.only = TRUE, ...))
} else {
diff --git a/rkward/rbackend/rpackages/rkward/R/internal.R b/rkward/rbackend/rpackages/rkward/R/internal.R
index 6b8e38db4..e4eef247b 100755
--- a/rkward/rbackend/rpackages/rkward/R/internal.R
+++ b/rkward/rbackend/rpackages/rkward/R/internal.R
@@ -121,15 +121,19 @@
".rk.do.error" <- function () {
# comment in R sources says, it may not be good to query options during error handling. But what can we do, if R_ShowErrorMessages is not longer exported?
if (getOption ("show.error.messages")) {
- .rk.do.simple.call ("error", geterrmessage ())
+ .rk.call.backend("error", geterrmessage())
}
}
-# TODO: replace me
-".rk.do.call" <- function (command, args=NULL) {
- x <- .Call("rk.call", command, args, TRUE, TRUE, PACKAGE="(embedding)");
- if (is.null(x)) invisible(NULL)
- else x
+# C call into the backend process only
+".rk.call.backend" <- function(command, args=NULL) {
+ .Call("rk.simple", c(command, args), PACKAGE="(embedding)")
+}
+
+# Asynchronous call to the frontend. This is faster than .rk.call(.nested), if no return value is needed.
+".rk.call.async" <- function(command, args=NULL) {
+ .Call("rk.call", command, args, FALSE, FALSE, PACKAGE="(embedding)")
+ invisible(NULL)
}
# Synchronous call to the frontend *without* allowing subcommands
@@ -139,15 +143,11 @@
else x
}
-# Asynchronous call to the frontend
-".rk.call.async" <- function(command, args=NULL) {
- .Call("rk.call", command, args, FALSE, FALSE, PACKAGE="(embedding)")
- invisible(NULL)
-}
-
-# TODO: replace me
-".rk.do.simple.call" <- function(command, args=NULL) {
- .Call("rk.simple", c(command, args), PACKAGE="(embedding)")
+# Synchronous call to the frontend *with* allowing subcommands
+".rk.call.nested" <- function (command, args=NULL) {
+ x <- .Call("rk.call", command, args, TRUE, TRUE, PACKAGE="(embedding)");
+ if (is.null(x)) invisible(NULL)
+ else x
}
#' @export
diff --git a/rkward/rbackend/rpackages/rkward/R/internal_graphics.R b/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
index 2e9324de4..609cb6df9 100644
--- a/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
+++ b/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
@@ -100,7 +100,7 @@ assign(".rk.preview.devices", list (), envir=.rk.variables)
rk.record.plot$onDelDevice (devId = which)
# see http://thread.gmane.org/gmane.comp.statistics.rkward.devel/802
- rkward:::.rk.do.call("killDevice", as.character(which))
+ rkward:::.rk.call("killDevice", as.character(which))
ret <- eval(body(rkward:::.rk.backups$dev.off))
diff --git a/rkward/rbackend/rpackages/rkward/R/public_graphics.R b/rkward/rbackend/rpackages/rkward/R/public_graphics.R
index 869aabcd1..31491787d 100644
--- a/rkward/rbackend/rpackages/rkward/R/public_graphics.R
+++ b/rkward/rbackend/rpackages/rkward/R/public_graphics.R
@@ -169,10 +169,10 @@
#' rk.embed.device (grDevices::X11(title="X11 device window"))
#' plot (rnorm (10))
#' }
-"rk.embed.device" <- function (expr) {
- oldd <- dev.cur ()
- .rk.do.call ("startOpenX11", as.character (oldd));
- on.exit (.rk.do.call ("endOpenX11", as.character (dev.cur())));
+"rk.embed.device" <- function(expr) {
+ oldd <- dev.cur()
+ .rk.call("startOpenX11", as.character(oldd));
+ on.exit (.rk.call("endOpenX11", as.character(dev.cur())));
on.exit ({ # This serves to make R do all necessary X11 event processing, _while_ we are in the process of embedding the device in the frontend.
for (i in 1:10) {
if (.rk.variables$devembedded) break
@@ -1024,7 +1024,7 @@
positions [2 * (1:ndevs) - 1] <- devIds
ihP <- sapply (histPositions[devIds], "[[", "pos.cur"); ihP [is.na (ihP)] <- sP.length + 1
positions [2 * (1:ndevs)] <- ihP
- .rk.do.call ("updateDeviceHistory", c (ifelse (enable.plot.hist, sP.length, 0), .get.sP.calls (), positions));
+ .rk.call("updateDeviceHistory", c(ifelse(enable.plot.hist, sP.length, 0), .get.sP.calls(), positions));
}
invisible ()
}
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.edit-functions.R b/rkward/rbackend/rpackages/rkward/R/rk.edit-functions.R
index 2c19eb040..a77023bd3 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.edit-functions.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.edit-functions.R
@@ -34,7 +34,7 @@
#' }
"rk.edit" <- function (x) {
object <- deparse (substitute (x))
- .rk.do.call ("edit", object)
+ .rk.call.nested("edit", object)
}
#' @param name name of the environment to use (optional).
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R b/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
index 87a12c40f..5f0ebd385 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
@@ -84,15 +84,15 @@
#' rk.set.output.html.file(outfile)
#' }
"rk.get.tempfile.name" <- function (prefix="image", extension=".jpg", directory=dirname (rk.get.output.html.file ())) {
- x <- .rk.do.simple.call ("unused.filename", c (prefix, extension, directory))
+ x <- .rk.call.backend("unused.filename", c(prefix, extension, directory))
ret <- x[2]
- names (ret) <- x[1]
+ names(ret) <- x[1]
ret
}
#' @export
-"rk.tempdir" <- function () {
- .rk.do.simple.call ("tempdir")
+"rk.tempdir" <- function() {
+ .rk.call.backend("tempdir")
}
#' @export
@@ -107,7 +107,7 @@
#' @rdname rk.get.tempfile.name
"rk.home" <- function (component="home") {
if(component %in% c("home", "lib")) {
- normalizePath(.rk.do.simple.call ("home", component))
+ normalizePath(.rk.call.backend("home", component))
} else {
stop("Unknown component type");
}
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.output.R b/rkward/rbackend/rpackages/rkward/R/rk.output.R
index 5365fc869..04b2f2f18 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.output.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.output.R
@@ -63,52 +63,52 @@ RK.Output <- setRefClass(Class="RK.Output", fields=list(id="character"),
# The implementation of most of these is not terribly complex, but we need an implementation in the frontend, anyway, so we use that.
activate=function() {
"Set this output as the one that rk.print and other RKWard Output functions will write to."
- .rk.do.call("output", c ("activate", .checkId()))
+ .rk.call.nested("output", c ("activate", .checkId()))
},
isEmpty=function() {
"Returns TRUE, if the output is currently empty."
- .rk.do.call("output", c ("isEmpty", .checkId()))
+ .rk.call.nested("output", c ("isEmpty", .checkId()))
},
isModified=function() {
"Returns TRUE, if this output has any changes that may need saving."
- .rk.do.call("output", c ("isModified", .checkId()))
+ .rk.call.nested("output", c ("isModified", .checkId()))
},
revert=function(discard=NULL) {
"Revert this output to the last saved state. If no previous state is available (never saved, before), clears the output."
- .rk.do.call("output", c ("revert", .checkId(), if(is.null(discard)) "ask" else if(isTRUE(discard)) "force" else "fail"))
+ .rk.call.nested("output", c ("revert", .checkId(), if(is.null(discard)) "ask" else if(isTRUE(discard)) "force" else "fail"))
},
save=function(filename, overwrite=NULL) {
"Save this output, either to the last known save location (if no filename is specified) or to a new location (\"save as\")."
if (missing(filename)) filename <- ""
- .rk.do.call("output", c ("save", .checkId(), if(is.null(overwrite)) "ask" else if(isTRUE(overwrite)) "force" else "fail", filename))
+ .rk.call.nested("output", c ("save", .checkId(), if(is.null(overwrite)) "ask" else if(isTRUE(overwrite)) "force" else "fail", filename))
},
export=function(filename, overwrite=NULL) {
"Save this output, to the specified location, but keep it associated with the previous location (\"save a copy\")."
if (missing(filename)) stop("No file name specified")
- .rk.do.call("output", c ("export", .checkId(), if(is.null(overwrite)) "ask" else if(isTRUE(overwrite)) "force" else "fail", filename))
+ .rk.call.nested("output", c ("export", .checkId(), if(is.null(overwrite)) "ask" else if(isTRUE(overwrite)) "force" else "fail", filename))
},
clear=function(discard=NULL) {
"Clear all content from this output. As with any function in this class, this affects the working copy, only, until you call save. Therefore, by default, the user will be prompted for confirmation
if and only if there are unsaved changes pending."
- .rk.do.call("output", c ("clear", .checkId(), if(is.null(discard)) "ask" else if(isTRUE(discard)) "force" else "fail"))
+ .rk.call.nested("output", c ("clear", .checkId(), if(is.null(discard)) "ask" else if(isTRUE(discard)) "force" else "fail"))
},
close=function(discard=NULL) {
"Forget about this output file, also closing any open views. Note: Trying to call any further methods on this object will fail."
- .rk.do.call("output", c ("close", .checkId(), if(is.null(discard)) "ask" else if(isTRUE(discard)) "force" else "fail"))
+ .rk.call.nested("output", c ("close", .checkId(), if(is.null(discard)) "ask" else if(isTRUE(discard)) "force" else "fail"))
id<<-character(0)
},
view=function(raise=TRUE) {
"Open this output for viewing in the frontend."
- .rk.do.call("output", c ("view", .checkId(), if(isTRUE(raise)) "raise" else ""))
+ .rk.call.nested("output", c ("view", .checkId(), if(isTRUE(raise)) "raise" else ""))
},
.workingDir=function() {
"The path of the working copy of this object. Please don't use this except for automated tests. The internals may be subject to change."
- .rk.do.call("output", c ("workingDir", .checkId()))
+ .rk.call.nested("output", c ("workingDir", .checkId()))
},
filename=function() {
"Return the target filename for this output, i.e. the location where it will be saved, to. This will be an empty string for newly created outputs that have not been saved, yet.
Do not write anything to the target filename, directly! This is purely for information."
- .rk.do.call("output", c ("filename", .checkId()))
+ .rk.call.nested("output", c ("filename", .checkId()))
},
.checkId=function() {
"For internal use: Throws an error, if the id parameter is NULL or too long, returns a length one character vector otherwise."
@@ -122,7 +122,7 @@ Do not write anything to the target filename, directly! This is purely for infor
#' @rdname RK.Output
"rk.output" <- function(filename=NULL, create=FALSE, all=FALSE) {
if(all && (!is.null(filename) || create)) stop("'all' cannot be combined with 'create' or 'filename'")
- id <- .rk.do.call("output", c ("get", if(isTRUE(all)) "all" else "one", if(isTRUE(create)) "create" else "", if(is.null(filename)) "" else as.character(filename)))
+ id <- .rk.call.nested("output", c ("get", if(isTRUE(all)) "all" else "one", if(isTRUE(create)) "create" else "", if(is.null(filename)) "" else as.character(filename)))
ret <- lapply(id, function(id) RK.Output(id=id))
if (all) ret
else ret[[1]]
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.plugin-functions.R b/rkward/rbackend/rpackages/rkward/R/rk.plugin-functions.R
index 072f0caa6..275c483c3 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.plugin-functions.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.plugin-functions.R
@@ -77,7 +77,7 @@
}
# do call
- .rk.do.call ("doPlugin", callstrings)
+ .rk.call.nested("doPlugin", callstrings)
invisible (TRUE)
}
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.sessionInfo.R b/rkward/rbackend/rpackages/rkward/R/rk.sessionInfo.R
index e4c54d4fc..0064c00f1 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.sessionInfo.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.sessionInfo.R
@@ -31,7 +31,7 @@
cat("-- Frontend --\n");
cat(.rk.call("frontendSessionInfo"), sep="\n")
cat("\n-- Backend --\n");
- cat(.rk.do.simple.call("backendSessionInfo"), sep="\n")
+ cat(.rk.call.backend("backendSessionInfo"), sep="\n")
cat("\nR runtime session info:\n")
print(sessionInfo())
}
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.sync-functions.R b/rkward/rbackend/rpackages/rkward/R/rk.sync-functions.R
index 1ddaac751..878b91455 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.sync-functions.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.sync-functions.R
@@ -33,12 +33,12 @@
#' }
"rk.sync" <- function (x) {
object <- deparse (substitute (x))
- .rk.do.call("sync", list(NULL, NULL, object))
+ .rk.call.nested("sync", list(NULL, NULL, object))
}
# should this really be public?
#' @export
#' @rdname rk.sync
"rk.sync.global" <- function () {
- .rk.do.call("sync", rk.check.env.changes(globalenv()))
+ .rk.call.nested("sync", rk.check.env.changes(globalenv()))
}
diff --git a/tests/import_export_plugins/git_install.messages.txt b/tests/import_export_plugins/git_install.messages.txt
index a52c606cc..f1121bdf8 100644
--- a/tests/import_export_plugins/git_install.messages.txt
+++ b/tests/import_export_plugins/git_install.messages.txt
@@ -5,5 +5,5 @@ Warning in system(full, intern = TRUE, ignore.stderr = quiet) :
Error: Failed to install 'unknown package' from Git:
Command failed (128)
In addition: Warning message:
-In .rk.do.call("doPlugin", callstrings) :
+In .rk.call.nested("doPlugin", callstrings) :
Not all specified settings could be applied. Most likely this is because some R objects are no longer present in your current workspace.
diff --git a/tests/import_export_plugins/import_csv_overwrite.messages.txt b/tests/import_export_plugins/import_csv_overwrite.messages.txt
index cded24f60..7cc55ee26 100644
--- a/tests/import_export_plugins/import_csv_overwrite.messages.txt
+++ b/tests/import_export_plugins/import_csv_overwrite.messages.txt
@@ -1,2 +1,2 @@
-Error in .rk.do.call("doPlugin", callstrings) :
+Error in .rk.call.nested("doPlugin", callstrings) :
The plugin could not be auto-submitted with these settings.
diff --git a/tests/rkward_application_tests/rk_output_test.messages.txt b/tests/rkward_application_tests/rk_output_test.messages.txt
index 537c011cd..9e8e30e20 100644
--- a/tests/rkward_application_tests/rk_output_test.messages.txt
+++ b/tests/rkward_application_tests/rk_output_test.messages.txt
@@ -1,6 +1,6 @@
-Error in .rk.do.call("output", c("close", .checkId(), if (is.null(discard)) "ask" else if (isTRUE(discard)) "force" else "fail")) :
+Error in .rk.call.nested("output", c("close", .checkId(), if (is.null(discard)) "ask" else if (isTRUE(discard)) "force" else "fail")) :
Output has been modified. Not closing it.
-Error in .rk.do.call("output", c("revert", .checkId(), if (is.null(discard)) "ask" else if (isTRUE(discard)) "force" else "fail")) :
+Error in .rk.call.nested("output", c("revert", .checkId(), if (is.null(discard)) "ask" else if (isTRUE(discard)) "force" else "fail")) :
User canceled.
-Error in .rk.do.call("output", c("clear", .checkId(), if (is.null(discard)) "ask" else if (isTRUE(discard)) "force" else "fail")) :
+Error in .rk.call.nested("output", c("clear", .checkId(), if (is.null(discard)) "ask" else if (isTRUE(discard)) "force" else "fail")) :
Output is not empty. Not clearing it.
More information about the rkward-tracker
mailing list