[rkward-cvs] SF.net SVN: rkward:[3356] trunk/rkward

[tfry at users.sourceforge.net]

Revision: 3356
          http://rkward.svn.sourceforge.net/rkward/?rev=3356&view=rev
Author:   tfry
Date:     2011-01-09 12:22:59 +0000 (Sun, 09 Jan 2011)

Log Message:
-----------
Fix interleaving of R output and stdout/stderr output

Modified Paths:
--------------
    trunk/rkward/ChangeLog
    trunk/rkward/rkward/rbackend/rkfrontendtransmitter.cpp
    trunk/rkward/rkward/rbackend/rkrbackend.cpp
    trunk/rkward/rkward/rbackend/rkrbackendprotocol_shared.h
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R

Modified: trunk/rkward/ChangeLog
===================================================================
--- trunk/rkward/ChangeLog	2010-12-28 21:28:59 UTC (rev 3355)
+++ trunk/rkward/ChangeLog	2011-01-09 12:22:59 UTC (rev 3356)
@@ -1,3 +1,4 @@
+- Fixed: Output generated by external processes (system()) was not shown on the console
 - Fixed: Converting a variable to factor in the editor would drop existing levels, silently, and lead to NAs
 - Fixed: Cursor would keep jumping to the end, when typing a filename in the filename selection field in plugins
 - Fixed: Submit button would not become enabled in "Basic Statistics" plugin

Modified: trunk/rkward/rkward/rbackend/rkfrontendtransmitter.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rkfrontendtransmitter.cpp	2010-12-28 21:28:59 UTC (rev 3355)
+++ trunk/rkward/rkward/rbackend/rkfrontendtransmitter.cpp	2011-01-09 12:22:59 UTC (rev 3356)
@@ -111,12 +111,12 @@
 
 void RKFrontendTransmitter::newProcessOutput () {
 	RK_TRACE (RBACKEND);
-#warning TODO: fix interleaving
+
 	QString output = QString::fromLocal8Bit (backend->readAll ());
 	handleOutput (output, output.size (), ROutput::Warning);
 }
 
-void RKFrontendTransmitter::requestReceived(RBackendRequest* request) {
+void RKFrontendTransmitter::requestReceived (RBackendRequest* request) {
 	RK_TRACE (RBACKEND);
 
 	if (request->type == RBackendRequest::Output) {
@@ -130,6 +130,29 @@
 		RK_ASSERT (request->synchronous);
 		writeRequest (request);	// to tell the backend, that we are keeping up. Also deletes the request.
 		return;
+	} else if (request->type == RBackendRequest::SyncOutput) {
+		RK_ASSERT (request->synchronous);
+
+		QString token = request->params["endtoken"].toString ();
+		writeRequest (request);
+
+		if (!token.isEmpty ()) {
+			QString buffer;
+
+			disconnect (backend, SIGNAL (readyReadStandardOutput ()), this, SLOT (newProcessOutput ()));
+			for (int i=5; i > 0; --i) {		// don't wait forever for the end-token.
+				buffer.append (QString::fromLocal8Bit (backend->readAll ()));
+				if (buffer.endsWith (token)) {
+					buffer = buffer.left (buffer.size () - token.size ());
+					break;
+				}
+				backend->waitForReadyRead (500);
+			}
+			connect (backend, SIGNAL (readyReadStandardOutput ()), this, SLOT (newProcessOutput ()));
+
+			if (!buffer.isEmpty ()) handleOutput (buffer, buffer.size (), ROutput::Warning);
+		}
+		return;
 	}
 
 	RKRBackendEvent* event = new RKRBackendEvent (request);

Modified: trunk/rkward/rkward/rbackend/rkrbackend.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rkrbackend.cpp	2010-12-28 21:28:59 UTC (rev 3355)
+++ trunk/rkward/rkward/rbackend/rkrbackend.cpp	2011-01-09 12:22:59 UTC (rev 3356)
@@ -785,6 +785,25 @@
 	return R_NilValue;
 }
 
+SEXP doSyncOutput (SEXP flushstdout) {
+	RK_TRACE (RBACKEND);
+
+#if (!defined RKWARD_THREADED) && (!defined Q_OS_WIN)
+	const char* token = "##RKOutputEndTag3210723##";	// should be unique enough for practical purposes
+	bool doflushstdout = (RKRSupport::SEXPToInt (flushstdout) != 0);
+
+	RBackendRequest req (true, RBackendRequest::SyncOutput);
+	if (doflushstdout) req.params["endtoken"] = QString (token);
+	RKRBackend::this_pointer->handleRequest (&req);
+	if (doflushstdout) {
+		printf ("%s", token);
+		fflush (stdout);
+	}
+#endif
+
+	return R_NilValue;
+}
+
 // returns the MIME-name of the current locale encoding (from Qt)
 SEXP doLocaleName () {
 	RK_TRACE (RBACKEND);
@@ -893,6 +912,7 @@
 		{ "rk.dialog", (DL_FUNC) &doDialog, 6 },
 		{ "rk.update.locale", (DL_FUNC) &doUpdateLocale, 0 },
 		{ "rk.locale.name", (DL_FUNC) &doLocaleName, 0 },
+		{ "rk.sync.output", (DL_FUNC) &doSyncOutput, 1 },
 		{ 0, 0, 0 }
 	};
 	R_registerRoutines (R_getEmbeddingDllInfo(), NULL, callMethods, NULL, NULL);

Modified: trunk/rkward/rkward/rbackend/rkrbackendprotocol_shared.h
===================================================================
--- trunk/rkward/rkward/rbackend/rkrbackendprotocol_shared.h	2010-12-28 21:28:59 UTC (rev 3355)
+++ trunk/rkward/rkward/rbackend/rkrbackendprotocol_shared.h	2011-01-09 12:22:59 UTC (rev 3356)
@@ -47,6 +47,7 @@
 #ifndef RKWARD_THREADED
 		Output,		/**< A piece of output. Note: If the backend runs in a single process, output is handled in a pull fashion, instead of using requests. */
 		Interrupt,	/**< Interrupt evaluation. This request type originates in the frontend, not the backend (the only one so far). */
+		SyncOutput,	/**< Synchronization of output between R output and stdout. Note: If the backend runs in a single process, the stdout/stderr channel is not supported anyway. */
 #endif
 		OtherRequest		/**< Any other type of request. Note: which requests are in the enum, and which are not has mostly historical reasons. @see params */
 	};

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R	2010-12-28 21:28:59 UTC (rev 3355)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R	2011-01-09 12:22:59 UTC (rev 3356)
@@ -452,8 +452,35 @@
 formals (menu) <- formals (utils::menu)
 .rk.menu.default <- utils::menu
 
+# Add output synchronisation across system(), and system2() calls.
+"system" <- function () {
+	if (intern || ignore.stdout || ignore.stderr) eval (body (.rk.system.default))
+	else {
+		.Call ("rk.sync.output", 0)
+		on.exit (.Call ("rk.sync.output", 1), TRUE)
+		eval (body (.rk.system.default))
+	}
+}
+formals (system) <- formals (base::system)
+.rk.system.default <- base::system
+
+# NOTE: system2 was not introduced before R 2.12.0 (or was it 2.11.0?)
+if (exists ("system2", base::.BaseNamespaceEnv)) {
+	"system2" <- function () {
+		if (stdout == "" && stderr == "") eval (body (.rk.system2.default))
+		else {
+			.Call ("rk.sync.output", 0)
+			on.exit (.Call ("rk.sync.output", 1), TRUE)
+			eval (body (.rk.system2.default))
+		}
+	}
+	formals (system2) <- formals (base::system2)
+	.rk.system2.default <- base::system2
+}
+
 # where masking is not enough, we need to assign in the namespace. This can only be done after package loading,
 # so we have a separate function for that.
+#NOTE: TODO: By now we are replacing so many functions, that it would make sense to create a generic framework for doing such replacements.
 ".rk.fix.assignments" <- function () {
 	assignInNamespace ("menu", menu, envir=as.environment ("package:utils"))
 	assignInNamespace ("select.list", select.list, envir=as.environment ("package:utils"))
@@ -461,6 +488,14 @@
 		unlockBinding ("makeActiveBinding", base::.BaseNamespaceEnv)
 		assign ("makeActiveBinding", rkward::makeActiveBinding, envir=base::.BaseNamespaceEnv)
 	})
+	try ({
+		unlockBinding ("system", base::.BaseNamespaceEnv)
+		assign ("system", rkward::system, envir=base::.BaseNamespaceEnv)
+	})
+	try ({
+		unlockBinding ("system2", base::.BaseNamespaceEnv)
+		assign ("system2", rkward::system, envir=base::.BaseNamespaceEnv)
+	})
 	
 	# call separate assignments functions:
 	if (exists (".rk.fix.assignments.graphics")) eval (body (.rk.fix.assignments.graphics)) # internal_graphics.R


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.