[education/rkward] /: Change semantic of close-hook, as device is no longer accessible at this
Thomas Friedrichsmeier
null at kde.org
Sun Aug 24 16:08:55 BST 2025
Git commit ac1c548d17e4f745d9a5b207ae41e49e8ebeefad by Thomas Friedrichsmeier.
Committed on 24/08/2025 at 15:06.
Pushed by tfry into branch 'master'.
Change semantic of close-hook, as device is no longer accessible at this
point
Also some first bits of documentation
M +1 -1 VERSION.cmake
M +3 -0 rkward/rbackend/rkrapi.h
M +14 -0 rkward/rbackend/rkrsupport.cpp
M +1 -0 rkward/rbackend/rkrsupport.h
M +7 -3 rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
M +62 -8 rkward/rbackend/rpackages/rkward/R/public_graphics.R
https://invent.kde.org/education/rkward/-/commit/ac1c548d17e4f745d9a5b207ae41e49e8ebeefad
diff --git a/VERSION.cmake b/VERSION.cmake
index c7c7000b6..b0a2d0180 100644
--- a/VERSION.cmake
+++ b/VERSION.cmake
@@ -1,3 +1,3 @@
# DO NOT CHANGE THIS FILE MANUALLY!
# It will be overwritten by scripts/set_dist_version.sh
-SET(RKVERSION_NUMBER 0.8.1z+0.8.2+devel2)
+SET(RKVERSION_NUMBER 0.8.1z+0.8.2+devel3b)
diff --git a/rkward/rbackend/rkrapi.h b/rkward/rbackend/rkrapi.h
index d398c0ac4..c9fbe82ae 100644
--- a/rkward/rbackend/rkrapi.h
+++ b/rkward/rbackend/rkrapi.h
@@ -160,10 +160,12 @@ class RFn : public QObject {
// TODO: This list should be generated, automatically, at compile time
IMPORT_R_API(CDR);
IMPORT_R_API(CDDR);
+ IMPORT_R_API(CDDDR);
IMPORT_R_API(CAR);
IMPORT_R_API(SETCAR);
IMPORT_R_API(GEaddDevice2);
IMPORT_R_API(GEcreateDevDesc);
+ IMPORT_R_API(GEcreateSnapshot)
IMPORT_R_API(GEgetDevice);
IMPORT_R_API(GEplayDisplayList);
IMPORT_R_API(R_CHAR);
@@ -239,6 +241,7 @@ class RFn : public QObject {
IMPORT_R_API(Rf_coerceVector);
IMPORT_R_API(Rf_curDevice);
IMPORT_R_API(Rf_defineVar);
+ IMPORT_R_API(Rf_desc2GEDesc);
IMPORT_R_API(Rf_doesIdle);
IMPORT_R_API(Rf_doIdle);
IMPORT_R_API(Rf_doKeybd);
diff --git a/rkward/rbackend/rkrsupport.cpp b/rkward/rbackend/rkrsupport.cpp
index 98b774558..f780f3e1c 100644
--- a/rkward/rbackend/rkrsupport.cpp
+++ b/rkward/rbackend/rkrsupport.cpp
@@ -49,6 +49,20 @@ SEXP RKRSupport::callSimpleFun2(SEXP fun, SEXP arg1, SEXP arg2, SEXP env) {
return ret;
}
+SEXP RKRSupport::callSimpleFun3(SEXP fun, SEXP arg1, SEXP arg2, SEXP arg3, SEXP env) {
+ SEXP call = RFn::Rf_allocVector(LANGSXP, 4);
+ RFn::Rf_protect(call);
+ RFn::SETCAR(call, fun);
+ RFn::SETCAR(RFn::CDR(call), arg1);
+ RFn::SETCAR(RFn::CDDR(call), arg2);
+ RFn::SETCAR(RFn::CDDDR(call), arg3);
+
+ SEXP ret = RFn::Rf_eval(call, env);
+
+ RFn::Rf_unprotect(1); /* call */
+ return ret;
+}
+
bool RKRSupport::callSimpleBool(SEXP fun, SEXP arg, SEXP env) {
SEXP res = callSimpleFun(fun, arg, env);
if ((RFn::Rf_length(res) < 1) || (RFn::TYPEOF(res) != LGLSXP)) {
diff --git a/rkward/rbackend/rkrsupport.h b/rkward/rbackend/rkrsupport.h
index fb216025f..082bac5f7 100644
--- a/rkward/rbackend/rkrsupport.h
+++ b/rkward/rbackend/rkrsupport.h
@@ -22,6 +22,7 @@ namespace RKRSupport {
SEXP callSimpleFun0(SEXP fun, SEXP env);
SEXP callSimpleFun(SEXP fun, SEXP arg, SEXP env);
SEXP callSimpleFun2(SEXP fun, SEXP arg1, SEXP arg2, SEXP env);
+SEXP callSimpleFun3(SEXP fun, SEXP arg1, SEXP arg2, SEXP arg3, SEXP env);
bool callSimpleBool(SEXP fun, SEXP arg, SEXP env);
QStringList SEXPToStringList(SEXP from_exp);
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
index d0c111c79..6f3896aa1 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
@@ -215,7 +215,7 @@ SEXP makeString(const char *string) {
return ret;
}
-static void callHookFun(const char *what, pDevDesc dev) {
+static void callHookFun(const char *what, pDevDesc dev, SEXP data=ROb(R_NilValue)) {
static SEXP call_hook_fun = nullptr;
if (!call_hook_fun) {
SEXP rkn = makeString("rkward");
@@ -223,7 +223,11 @@ static void callHookFun(const char *what, pDevDesc dev) {
RK_ASSERT(RFn::Rf_isEnvironment(rkwardenv));
call_hook_fun = RFn::Rf_findFun(RFn::Rf_install(".RK.callHook"), rkwardenv);
}
- RKRSupport::callSimpleFun2(call_hook_fun, makeString(what), makeInt(static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->devnum + 1), ROb(R_BaseEnv));
+ if (data == ROb(R_NilValue)) {
+ RKRSupport::callSimpleFun2(call_hook_fun, makeString(what), makeInt(static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->devnum + 1), ROb(R_BaseEnv));
+ } else {
+ RKRSupport::callSimpleFun3(call_hook_fun, makeString(what), makeInt(static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->devnum + 1), data, ROb(R_BaseEnv));
+ }
}
static void modified(pDevDesc dev) {
@@ -466,7 +470,7 @@ static void RKD_MetricInfo(int c, R_GE_gcontext *gc, double *ascent, double *des
static void RKD_Close(pDevDesc dev) {
RK_TRACE(GRAPHICS_DEVICE);
- callHookFun("before.close", dev);
+ callHookFun("after.close", dev, RFn::GEcreateSnapshot(RFn::desc2GEDesc(dev)));
{
RKGraphicsDataStreamWriteGuard guard;
WRITE_HEADER(RKDClose, dev);
diff --git a/rkward/rbackend/rpackages/rkward/R/public_graphics.R b/rkward/rbackend/rpackages/rkward/R/public_graphics.R
index c04f8a8ab..e9fbb72d3 100644
--- a/rkward/rbackend/rpackages/rkward/R/public_graphics.R
+++ b/rkward/rbackend/rpackages/rkward/R/public_graphics.R
@@ -147,8 +147,50 @@
}
-# TODO: document
-RK.addHook <- function(after.create, before.close, before.blank) {
+#' Detect changes in the RKWard native graphics device(s)
+#'
+#' \code{RK.addHook()} registers functions to be called when plot windows are created / closed / blanked.
+#'
+#' \code{RK.removeHook()} removes hook functions previously registered with \code{RK.addHook()}.
+#'
+#' \code{RK.revision()} can be used to detect changes done to an existing \code{RK()} by comparing the
+#' return value of two subsequent calls: If the value has increased, the plot has been touched.
+#'
+#' @param after.create (Omit this argument, if you do not want to set this type of hook.) A function to be called
+#' immediately after a new \code{RK()} device has been created. The function must accept at least one
+#' parameter (the corresponding device number). It is recommended to add \code{...} in addition,
+#' to remain compatible with future extensions.
+#'
+#' @param after.close (Omit this argument, if you do not want to set this type of hook.) Called immediately after a device
+#' is closed. At this point the device may or may not still be visible, but can no longer be accessed.
+#' The function is called with two parameters: the device number, and a snapshot of the most recent
+#' plot (as would have been produced by \code{recordPlot()}; empty, if disabled via \code{dev.control()}.
+#' It is recommended to add a \code{...} argument, in order to remain compatible with future extensions.
+#'
+#' @param before.blank (Omit this argument, if you do not want to set this type of hook.) Called whenever an existing device
+#' is blanked. This usually happens when a new plot is about to be drawn. While this hook is called,
+#' it is still possible to access the old contents.
+#'
+#' @param devnum Device number
+#'
+#' @details The return value of \code{RK.addHook()) may be passed to \code{RK.removeHook()) to remove the hook(s) registered
+#' in that call. No assumptions should be made on the exact nature of that return value (it might be subject to
+#' change in future versions.
+#'
+#' \code{RK.revision()} returns a integer number. This will be 0 for a device that has just been created. If the device
+#' is modified (changes need not necessarily be visible), the next call to \code{RK.revision()} will return a larger
+#' number. The details of how revisions are counted may be subject to change, and in particular they do not give
+#' any information on how much has been changed..
+#'
+#' @seealso \link{RK}
+#' @examples
+#' \dontrun{
+#' ## TODO
+#' }
+#'
+#' @export
+#' @rdname RKdevicehooks
+RK.addHook <- function(after.create, after.close, before.blank) {
if (is.null(.rk.variables$.RKdevhooks$nextid)) .rk.variables$.RKdevhooks$nextid <- 0
id = .rk.variables$.RKdevhooks$nextid
.rk.variables$.RKdevhooks$nextid <- id + 1
@@ -160,8 +202,8 @@ RK.addHook <- function(after.create, before.close, before.blank) {
if (!missing(after.create)) {
appendHook("after.create", after.create, id)
}
- if (!missing(before.close)) {
- appendHook("before.close", before.close, id)
+ if (!missing(after.close)) {
+ appendHook("after.close", after.close, id)
}
if (!missing(before.blank)) {
appendHook("before.blank", before.blank, id)
@@ -169,20 +211,30 @@ RK.addHook <- function(after.create, before.close, before.blank) {
invisible(id)
}
-# TODO: document
+#' @export
+#' @rdname RKdevicehooks
RK.removeHook <- function(handle) {
removeHook <- function(at, id) {
.rk.variables$.RKdevhooks[[at]] <- .rk.variables$.RKdevhooks[[at]][names(.rk.variables$.RKdevhooks[[at]]) != id]
}
removeHook("after.create", handle)
- removeHook("before.close", handle)
+ removeHook("after.close", handle)
removeHook("before.blank", handle)
invisible(NULL)
}
-.RK.callHook <- function(hook, id) {
+# not exported
+.RK.callHook <- function(hook, id, data, ...) {
for (fun in .rk.variables$.RKdevhooks[[hook]]) {
- try({fun(id)})
+ if (hook == "after.close") {
+ # pity it's too late for recordPlot() at this point. We need to re-create things, manually
+ attr(data, "pid") <- Sys.getpid()
+ attr(data, "Rversion") <- getRversion()
+ class(data) <- "recordedplot"
+ try({fun(id, data, ...)})
+ } else {
+ try({fun(id, ...)})
+ }
}
}
@@ -192,6 +244,8 @@ RK.removeHook <- function(handle) {
# The device has been modified, if the returned number has increased.
# NOTE: The magnitude of the increase carries no meaning at all.
# NOTE: Reset to 0 when the device is closed
+#' @export
+#' @rdname RKdevicehooks
RK.revision <- function(device) {
.Call("rk.graphics.mod", as.integer(device), PACKAGE="(embedding)")
}
More information about the rkward-tracker
mailing list