diff --git a/src/backends/R/rserver/rserver.cpp b/src/backends/R/rserver/rserver.cpp index 05e29e68..6ebb36bb 100644 --- a/src/backends/R/rserver/rserver.cpp +++ b/src/backends/R/rserver/rserver.cpp @@ -1,510 +1,521 @@ /* This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. --- Copyright (C) 2009 Alexander Rieder Copyright (C) 2010 Oleksiy Protas */ // TODO: setStatus in syntax and completions, to be or not to be? // on the one hand comme il faut, on another, causes flickering in UI #include "rserver.h" #include #include "radaptor.h" #include "rcallbacks.h" #include "settings.h" #include #include #include #include #include //R includes #include #include #include #include #define R_INTERFACE_PTRS #include RServer::RServer() : m_isInitialized(false),m_isCompletionAvailable(false) { new RAdaptor(this); m_tmpDir = QDir::tempPath() + QString::fromLatin1("/cantor_rserver-%1").arg(getpid()); QDir dir; dir.mkdir(m_tmpDir); qDebug()<<"storing plots at "<integratePlots()) { qDebug()<<"integrating plots"; newPlotDevice(); } //Loading automatic run scripts foreach (const QString& path, RServerSettings::self()->autorunScripts()) { int errorOccurred=0; if (QFile::exists(path)) R_tryEval(lang2(install("source"),mkString(path.toUtf8().data())),nullptr,&errorOccurred); // TODO: error handling else { qDebug()<<(QLatin1String("Script ")+path+QLatin1String(" not found")); // FIXME: or should we throw a messagebox } } qDebug()<<"done initializing"; // FIXME: other way to search symbols, see listSymbols for details listSymbols(); } //Code from the RInside library void RServer::autoload() { #include "rautoloads.h" /* Autoload default packages and names from autoloads.h * * This function behaves in almost every way like * R's autoload: * function (name, package, reset = FALSE, ...) * { * if (!reset && exists(name, envir = .GlobalEnv, inherits = FALSE)) * stop("an object with that name already exists") * m <- match.call() * m[[1]] <- as.name("list") * newcall <- eval(m, parent.frame()) * newcall <- as.call(c(as.name("autoloader"), newcall)) * newcall$reset <- NULL * if (is.na(match(package, .Autoloaded))) * assign(".Autoloaded", c(package, .Autoloaded), env = .AutoloadEnv) * do.call("delayedAssign", list(name, newcall, .GlobalEnv, * .AutoloadEnv)) * invisible() * } * * What's missing is the updating of the string vector .Autoloaded with * the list of packages, which by my code analysis is useless and only * for informational purposes. * */ //void autoloads(void){ SEXP da, dacall, al, alcall, AutoloadEnv, name, package; int i,j, idx=0, errorOccurred, ptct; /* delayedAssign call*/ PROTECT(da = Rf_findFun(Rf_install("delayedAssign"), R_GlobalEnv)); PROTECT(AutoloadEnv = Rf_findVar(Rf_install(".AutoloadEnv"), R_GlobalEnv)); if (AutoloadEnv == R_NilValue){ qDebug()<<"Cannot find .AutoloadEnv"; //exit(1); } PROTECT(dacall = allocVector(LANGSXP,5)); SETCAR(dacall,da); /* SETCAR(CDR(dacall),name); */ /* arg1: assigned in loop */ /* SETCAR(CDR(CDR(dacall)),alcall); */ /* arg2: assigned in loop */ SETCAR(CDR(CDR(CDR(dacall))),R_GlobalEnv); /* arg3 */ SETCAR(CDR(CDR(CDR(CDR(dacall)))),AutoloadEnv); /* arg3 */ /* autoloader call */ PROTECT(al = Rf_findFun(Rf_install("autoloader"), R_GlobalEnv)); PROTECT(alcall = allocVector(LANGSXP,3)); SET_TAG(alcall, R_NilValue); /* just like do_ascall() does */ SETCAR(alcall,al); /* SETCAR(CDR(alcall),name); */ /* arg1: assigned in loop */ /* SETCAR(CDR(CDR(alcall)),package); */ /* arg2: assigned in loop */ ptct = 5; for(i = 0; i < packc; ++i){ idx += (i != 0)? packobjc[i-1] : 0; for (j = 0; j < packobjc[i]; ++j){ /*printf("autload(%s,%s)\n",packobj[idx+j],pack[i]);*/ PROTECT(name = NEW_CHARACTER(1)); PROTECT(package = NEW_CHARACTER(1)); SET_STRING_ELT(name, 0, COPY_TO_USER_STRING(packobj[idx+j])); SET_STRING_ELT(package, 0, COPY_TO_USER_STRING(pack[i])); /* Set up autoloader call */ PROTECT(alcall = allocVector(LANGSXP,3)); SET_TAG(alcall, R_NilValue); /* just like do_ascall() does */ SETCAR(alcall,al); SETCAR(CDR(alcall),name); SETCAR(CDR(CDR(alcall)),package); /* Setup delayedAssign call */ SETCAR(CDR(dacall),name); SETCAR(CDR(CDR(dacall)),alcall); R_tryEval(dacall,R_GlobalEnv,&errorOccurred); if (errorOccurred){ qDebug()<<"Error calling delayedAssign!"; //exit(1); } ptct += 3; } } UNPROTECT(ptct); /* Initialize the completion libraries if needed, adapted from sys-std.c of R */ // TODO: should we do this or init on demand? // if (completion is needed) // TODO: discuss how to pass parameter { /* First check if namespace is loaded */ if (findVarInFrame(R_NamespaceRegistry,install("utils"))==R_UnboundValue) { /* Then try to load it */ SEXP cmdSexp, cmdexpr; ParseStatus status; int i; const char *p="try(loadNamespace('rcompgen'), silent=TRUE)"; PROTECT(cmdSexp=mkString(p)); cmdexpr=PROTECT(R_ParseVector(cmdSexp,-1,&status,R_NilValue)); if(status==PARSE_OK) { for(i=0;icmd=cmd; expr->hasOtherResults=false; setStatus(RServer::Busy); setCurrentExpression(expr); expr->std_buffer.clear(); expr->err_buffer.clear(); ReturnCode returnCode=RServer::SuccessCode; QString returnText; QStringList neededFiles; //Code to evaluate an R function (taken from RInside library) ParseStatus status; SEXP cmdSexp, cmdexpr = R_NilValue; SEXP result; int i, errorOccurred; QByteArray memBuf; memBuf.append(cmd.toUtf8()); PROTECT(cmdSexp = allocVector(STRSXP, 1)); SET_STRING_ELT(cmdSexp, 0, mkChar((char*)memBuf.data())); cmdexpr = PROTECT(R_ParseVector(cmdSexp, -1, &status, R_NilValue)); switch (status) { case PARSE_OK: qDebug()<<"PARSING "< 1 */ for (i = 0; i < length(cmdexpr); ++i) { result = R_tryEval(VECTOR_ELT(cmdexpr, i), nullptr, &errorOccurred); if (errorOccurred) { qDebug()<<"Error occurred."; break; } // TODO: multiple results } memBuf.clear(); break; case PARSE_INCOMPLETE: /* need to read another line */ qDebug()<<"parse incomplete.."; break; case PARSE_NULL: qDebug()<<"ParseStatus is null: "<std_buffer<<" err: "<err_buffer; //if the command didn't print anything on its own, print the result //TODO: handle some known result types like lists, matrices separately // to make the output look better, by using html (tables etc.) if(expr->std_buffer.isEmpty()&&expr->err_buffer.isEmpty()) { qDebug()<<"printing result..."; SEXP count=PROTECT(R_tryEval(lang2(install("length"),result),nullptr,&errorOccurred)); // TODO: error checks if (*INTEGER(count)==0) qDebug() << "no result, so show nothing"; else Rf_PrintValue(result); UNPROTECT(1); } setCurrentExpression(nullptr); //is this save? if(!expr->err_buffer.isEmpty()) { returnCode=RServer::ErrorCode; returnText=expr->err_buffer; } else { returnCode=RServer::SuccessCode; returnText=expr->std_buffer; } }else { returnCode=RServer::ErrorCode; returnText=i18n("Error Parsing Command"); } if(internal) { qDebug()<<"internal result: "<hasOtherResults=true; newPlotDevice(); neededFiles<hasOtherResults) emit expressionFinished(returnCode, returnText); else showFiles(neededFiles); setStatus(Idle); // FIXME: Calling this every evaluation is probably ugly listSymbols(); } void RServer::completeCommand(const QString& cmd) { // setStatus(RServer::Busy); // TODO: is static okay? guess RServer is a singletone, but ... // TODO: error handling? // TODO: investigate encoding problem // TODO: propage the flexibility of token selection upward // TODO: what if install() fails? investigate // TODO: investigate why errors break the whole foodchain of RServer callbacks in here static SEXP comp_env=R_FindNamespace(mkString("utils")); static SEXP tokenizer_func=install(".guessTokenFromLine"); static SEXP linebuffer_func=install(".assignLinebuffer"); static SEXP buffer_end_func=install(".assignEnd"); static SEXP complete_func=install(".completeToken"); static SEXP retrieve_func=install(".retrieveCompletions"); /* Setting buffer parameters */ int errorOccurred=0; // TODO: error cheks, too lazy to do it now R_tryEval(lang2(linebuffer_func,mkString(cmd.toUtf8().data())),comp_env,&errorOccurred); R_tryEval(lang2(buffer_end_func,ScalarInteger(cmd.size())),comp_env,&errorOccurred); /* Passing the tokenizing work to professionals */ SEXP token=PROTECT(R_tryEval(lang1(tokenizer_func),comp_env,&errorOccurred)); /* Doing the actual stuff */ R_tryEval(lang1(complete_func),comp_env,&errorOccurred); SEXP completions=PROTECT(R_tryEval(lang1(retrieve_func),comp_env,&errorOccurred)); /* Populating the list of completions */ QStringList completionOptions; for (int i=0;i