[education/rkward] /: Rework console preview to also include plots

Thomas Friedrichsmeier null at kde.org
Sun Aug 24 16:08:55 BST 2025


Git commit 033a5f79909792a1cdf589995b70e3692faf10d8 by Thomas Friedrichsmeier.
Committed on 24/08/2025 at 15:06.
Pushed by tfry into branch 'master'.

Rework console preview to also include plots

M  +1    -1    VERSION.cmake
M  +2    -2    rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
M  +1    -1    rkward/rbackend/rpackages/rkward/DESCRIPTION
M  +100  -0    rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
M  +1    -18   rkward/windows/rkcommandeditorwindow.cpp

https://invent.kde.org/education/rkward/-/commit/033a5f79909792a1cdf589995b70e3692faf10d8

diff --git a/VERSION.cmake b/VERSION.cmake
index 326761ad9..c7c7000b6 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+devel1)
+SET(RKVERSION_NUMBER 0.8.1z+0.8.2+devel2)
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
index 88efd8ce6..dbd148b92 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
@@ -223,7 +223,7 @@ 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), ROb(R_BaseEnv));
+	RKRSupport::callSimpleFun2(call_hook_fun, makeString(what), makeInt(static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->devnum + 1), ROb(R_BaseEnv));
 }
 
 static void modified(pDevDesc dev) {
@@ -232,7 +232,7 @@ static void modified(pDevDesc dev) {
 
 static void RKD_Activate(pDevDesc dev);
 SEXP RKGraphicsModRevision(SEXP _devnum) {
-	int devnum = RFn::Rf_asInteger(_devnum);
+	int devnum = RFn::Rf_asInteger(_devnum) - 1;
 	pGEDevDesc gdev = RFn::GEgetDevice(devnum);
 	if (!gdev) RFn::Rf_error("No such device %d", devnum);
 	pDevDesc dev = gdev->dev;
diff --git a/rkward/rbackend/rpackages/rkward/DESCRIPTION b/rkward/rbackend/rpackages/rkward/DESCRIPTION
index 1d19855b5..cddfabf2d 100755
--- a/rkward/rbackend/rpackages/rkward/DESCRIPTION
+++ b/rkward/rbackend/rpackages/rkward/DESCRIPTION
@@ -15,7 +15,7 @@ LazyLoad: yes
 Authors at R: c(person(given="Thomas", family="Friedrichsmeier", email="thomas.friedrichsmeier at kdemail.net", role=c("aut")), person(given="the RKWard", family="team",
                     email="rkward-devel at kde.org", role=c("cre","aut")))
 Version: 0.8.2
-Date: 2025-04-18
+Date: 2025-06-01
 RoxygenNote: 7.3.2
 Collate: 
     'base_overrides.R'
diff --git a/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R b/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
index 5f0ebd385..4bf83f677 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
@@ -280,3 +280,103 @@
 
 	rk.set.output.html.file (x, ...)
 }
+
+# TODO: document me
+#' @export
+rk.eval.as.console.preview <- function(infile, outfile, env=new.env(parent=globalenv()), stop.on.error=FALSE) {
+	## init output file
+	output <- rk.set.output.html.file(outfile, silent=TRUE)
+	on.exit({
+		rk.set.output.html.file(output, silent=TRUE)
+	}, add=TRUE)
+	try(rk.flush.output(ask=FALSE, style="preview", silent=TRUE))
+
+	## set up handling of generated graphics:
+	devs <- list()
+	prevdev <- NULL
+	oldopts <- options() # while at it, save _all_ options. Script might change some, too
+	options(device="RK") # just in case
+
+	# If a device already exists, let's open a new one to avoid touching it, unintentionally
+	# We don't want that to show in the preview, however, which may or may not plot anything at all
+	if (length(dev.list()) > 0) {
+		prevdev <- dev.cur()
+		rk.without.plot.history(RK())
+		devs[[as.character(dev.cur())]] <- RK.revision(dev.cur())
+	}
+
+	hook <- RK.addHook(
+		after.create=function(devnum) {
+			.rk.cat.output("<div align=\"right\">Plot window created</div>");
+			devs[[as.character(devnum)]] <<- RK.revision(devnum)
+		},
+		before.close=function(devnum) {
+			.rk.cat.output("<div align=\"right\">Plot window closed</div>");
+			devs[[as.character(devnum)]] <<- NULL
+		}
+	)
+
+	checkSavePlot <- function() {
+		for (devnum in names(devs)) {
+			currev <- RK.revision(as.numeric(devnum))
+			if (devs[[devnum]] < currev) {
+				cur <- dev.cur()
+				.rk.cat.output("<div align=\"right\"><details><summary>Plot updated (click to show)</summary><p>");
+				#rk.graph.on(width=200, height=200, pointsize=6)
+				rk.graph.on()
+				out <- dev.cur()
+				try({
+					dev.set(as.numeric(devnum))
+					dev.copy(which=out)
+				})
+				rk.graph.off()
+				.rk.cat.output("</p></details></div>");
+				dev.set(cur)
+				devs[[devnum]] <<- currev
+			}
+		}
+	}
+
+	on.exit({
+		RK.removeHook(hook)
+
+		rk.without.plot.history({
+			for (dev in names(devs)) {
+				dev.off(as.numeric(dev))
+			}
+
+			if (!is.null(prevdev)) {
+				dev.set(prevdev)
+			}
+		})
+
+		options(oldopts)
+	}, add=TRUE)
+
+	## parse and evaluate
+	# capture any parse errors
+	exprs <- expression(NULL)
+	rk.capture.output(suppress.messages=TRUE)
+	res <- try({
+		exprs <- parse(infile, keep.source=TRUE)
+	})
+	.rk.cat.output(rk.end.capture.output(TRUE))
+	if(stop.on.error && inherits(res, "try-error")) stop(res)
+
+	# actually do it
+	rk.without.plot.history({
+		for (i in seq_len(length(exprs))) {
+			rk.print.code(as.character(attr(exprs, "srcref")[[i]]))
+			rk.capture.output(suppress.messages=TRUE, suppress.output=TRUE)
+			res <- try({
+				withAutoprint(exprs[[i]], evaluated=TRUE, echo=FALSE, local=env)
+			})
+			.rk.cat.output(rk.end.capture.output(TRUE))
+			checkSavePlot()
+			if(stop.on.error && inherits(res, "try-error")) stop(res)
+		}
+	})
+
+	# clean up is done via on.exit handlers, above
+	invisible()
+}
diff --git a/rkward/windows/rkcommandeditorwindow.cpp b/rkward/windows/rkcommandeditorwindow.cpp
index 9ce7af11e..887ef5713 100644
--- a/rkward/windows/rkcommandeditorwindow.cpp
+++ b/rkward/windows/rkcommandeditorwindow.cpp
@@ -711,24 +711,7 @@ void RKCommandEditorWindow::initPreviewModes() {
 	    i18n("Preview the script as if it was run in the interactive R Console"),
 	    u".R"_s,
 	    [](const QString &infile, const QString &outdir, const QString & /*preview_id*/) {
-		    auto command = QStringLiteral("output <- rk.set.output.html.file(%2, silent=TRUE)\n"
-		                                  "on.exit(rk.set.output.html.file(output, silent=TRUE))\n"
-		                                  "try(rk.flush.output(ask=FALSE, style=\"preview\", silent=TRUE))\n"
-		                                  "exprs <- expression(NULL)\n"
-		                                  "rk.capture.output(suppress.messages=TRUE)\n"
-		                                  "try({\n"
-		                                  "    exprs <- parse (%1, keep.source=TRUE)\n"
-		                                  "})\n"
-		                                  ".rk.cat.output(rk.end.capture.output(TRUE))\n"
-		                                  "for (i in seq_len(length(exprs))) {\n"
-		                                  "    rk.print.code(as.character(attr(exprs, \"srcref\")[[i]]))\n"
-		                                  "    rk.capture.output(suppress.messages=TRUE)\n"
-		                                  "    try({\n"
-		                                  "        withAutoprint(exprs[[i]], evaluated=TRUE, echo=FALSE)\n"
-		                                  "    })\n"
-		                                  "    .rk.cat.output(rk.end.capture.output(TRUE))\n"
-		                                  "}\n"
-		                                  "rk.set.output.html.file(output, silent=TRUE)\n"
+		    auto command = QStringLiteral("rkward:::rk.eval.as.console.preview(%1, %2)\n"
 		                                  "rk.show.html(%2)\n");
 		    return command.arg(RObject::rQuote(infile), RObject::rQuote(outdir + u"/output.html"_s));
 	    }});



More information about the rkward-tracker mailing list