[rkward-cvs] SF.net SVN: rkward:[3152] branches/2010_10_18_backend_restructuring_branch/ rkward/rbackend

[tfry at users.sourceforge.net]

Revision: 3152
          http://rkward.svn.sourceforge.net/rkward/?rev=3152&view=rev
Author:   tfry
Date:     2010-10-26 14:52:48 +0000 (Tue, 26 Oct 2010)

Log Message:
-----------
Move message handling of plugin commands into R code, and a few minor changes.

Modified Paths:
--------------
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rpackages/rkward/R/internal.R

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp	2010-10-26 11:15:50 UTC (rev 3151)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp	2010-10-26 14:52:48 UTC (rev 3152)
@@ -154,7 +154,7 @@
 void RKTransmitNextUserCommandChunk (unsigned char* buf, int buflen) {
 	RK_TRACE (RBACKEND);
 
-	RK_ASSERT (RThread::repl_status.user_command_transmitted_up_to < RThread::repl_status.user_command_buffer.length ());
+	RK_ASSERT (RThread::repl_status.user_command_transmitted_up_to <= RThread::repl_status.user_command_buffer.length ());	// NOTE: QByteArray::length () does not count the trailing '\0'
 	const char* current_buffer = RThread::repl_status.user_command_buffer.data ();
 	current_buffer += RThread::repl_status.user_command_transmitted_up_to;	// Skip what we have already transmitted
 
@@ -349,6 +349,7 @@
 		} else {
 				if (RunLast) R_dot_Last ();
 		}
+		R_CleanTempDir ();
 	}
 	RThread::this_pointer->killed = true;
 	Rf_error ("Backend dead");	// this jumps us out of the REPL.
@@ -961,7 +962,7 @@
 	// NOTE the command must not be accessed while the mutex is unlocked!
 	// Therefore we copy the data we need, and create a container for the returned data
 	int ctype = command->type ();
-	QByteArray ccommand = current_locale_codec->fromUnicode (command->command ());
+	QString ccommand = command->command ();
 	RData retdata;
 
 	// running user commands is quite different from all other commands and should have been handled by RReadConsole
@@ -970,9 +971,10 @@
 	if (!(ctype & RCommand::Internal)) {
 		MUTEX_UNLOCK;
 	}
+	if (ctype & RCommand::DirectToOutput) runDirectCommand (".rk.capture.messages()");
 
 	repl_status.eval_depth++;
-	SEXP parsed = parseCommand (command->command (), &error);
+	SEXP parsed = parseCommand (ccommand, &error);
 	if (error == NoError) {
 		SEXP exp;
 		PROTECT (exp = runCommandInternalBase (parsed, &error));
@@ -996,6 +998,7 @@
 	}
 	repl_status.eval_depth--;
 
+	if (ctype & RCommand::DirectToOutput) runDirectCommand (".rk.print.captured.messages()");
 	if (!(ctype & RCommand::Internal)) {
 		if (!locked || killed) processX11Events ();
 		MUTEX_LOCK;
@@ -1032,16 +1035,4 @@
 	}
 
 	flushOutput ();
-	if (command->type () & RCommand::DirectToOutput) {
-		QString outp = command->fullOutput();
-
-		if (!outp.isEmpty ()) {
-			// all regular output was sink()ed, i.e. all remaining output is a message/warning/error
-			runDirectCommand (".rk.cat.output (\"<h2>Messages, warnings, or errors:</h2>\\n\")");
-
-			outp.replace ('\\', "\\\\");
-			outp.replace ('"', "\\\"");
-			runDirectCommand ("rk.print.literal (\"" + outp + "\")");
-		}
-	}
 }

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rpackages/rkward/R/internal.R	2010-10-26 11:15:50 UTC (rev 3151)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rpackages/rkward/R/internal.R	2010-10-26 14:52:48 UTC (rev 3152)
@@ -333,6 +333,45 @@
 	.rk.cat.output ("<hr>\n");
 }
 
+# for caputring message output while running a plugin command
+.rk.capture.messages <- function () {
+	if (exists (".rk.capture.messages.sinkfile", envir=as.environment ("package:rkward"), inherits=FALSE)) {
+		# We don't support nesting, so purge it, first
+		.rk.print.captured.messages ()
+	}
+
+	sinkfile <- tempfile ()
+	assign (".rk.capture.messages.sinkfile", sinkfile, envir=as.environment ("package:rkward"))
+	sink (file (sinkfile, open="w"), type="message")
+	assign (".rk.capture.messages.sinknumber", sink.number ("message"), envir=as.environment ("package:rkward"))
+}
+
+.rk.print.captured.messages <- function (clear=TRUE) {
+	if (!exists (".rk.capture.messages.sinkfile", envir=as.environment ("package:rkward"), inherits=FALSE)) return ()
+
+	sinkfile <- get (".rk.capture.messages.sinkfile", envir=as.environment ("package:rkward"), inherits=FALSE)
+	if (file.exists (sinkfile)) {
+		output <- readLines (sinkfile, warn=FALSE)
+		if (length (output) > 0) {
+			.rk.cat.output ("<h2>Messages, warnings, or errors:</h2>\n")
+			rk.print.literal (output)
+		}
+	}
+
+	if (clear) {
+		sinknumber <- get (".rk.capture.messages.sinknumber", envir=as.environment ("package:rkward"), inherits=FALSE)
+		if (sink.number (type="message") > sinknumber) {
+			stop ("Another message sink appears to be in place. Remove that, first")
+		} else if (sink.number (type="message") < sinknumber) {
+			warning ("Message sink has been removed, already.")
+		} else {
+			sink (type="message")	# remove it
+		}
+		if (file.exists (sinkfile)) file.remove (sinkfile)
+		remove (list=".rk.capture.messages.sinkfile", envir=as.environment ("package:rkward"))
+	}
+}
+
 # Start recording commands that are submitted from rkward to R.
 # filename: filename to write to (file will be truncated!).
 # include.sync.commands: Should internal synchronisation commands be included?


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