diff --git a/src/backends/R/rexpression.cpp b/src/backends/R/rexpression.cpp index feaf1277..75789cc9 100644 --- a/src/backends/R/rexpression.cpp +++ b/src/backends/R/rexpression.cpp @@ -1,156 +1,163 @@ /* 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 */ #include "rexpression.h" #include "textresult.h" #include "imageresult.h" #include "helpresult.h" #include "epsresult.h" #include "rsession.h" #include #include #include #include #include #include #include RExpression::RExpression( Cantor::Session* session ) : Cantor::Expression(session) { } RExpression::~RExpression() { } void RExpression::evaluate() { setStatus(Cantor::Expression::Computing); if(command().startsWith(QLatin1Char('?'))) m_isHelpRequest=true; else m_isHelpRequest=false; static_cast(session())->queueExpression(this); } void RExpression::interrupt() { qDebug()<<"interrupting command"; if(status()==Cantor::Expression::Computing) session()->interrupt(); setStatus(Cantor::Expression::Interrupted); } void RExpression::finished(int returnCode, const QString& text) { if(returnCode==RExpression::SuccessCode) { setResult(new Cantor::TextResult(Qt::convertFromPlainText(text))); setStatus(Cantor::Expression::Done); }else if (returnCode==RExpression::ErrorCode) { setResult(new Cantor::TextResult(Qt::convertFromPlainText(text))); setStatus(Cantor::Expression::Error); setErrorMessage(Qt::convertFromPlainText(text)); } } void RExpression::evaluationStarted() { setStatus(Cantor::Expression::Computing); } void RExpression::addInformation(const QString& information) { static_cast(session())->sendInputToServer(information); } void RExpression::showFilesAsResult(const QStringList& files) { qDebug()<<"showing files: "< and & with their html code, so they won't be confused as html tags content.replace( QLatin1Char('<') , QLatin1String("<")); content.replace( QLatin1Char('>') , QLatin1String(">")); content.replace( QLatin1Char('&') , QLatin1String("&")); } qDebug()<<"content: "< 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 // Not making a member to prevent pulling R headers into rserver.h bool htmlVector(SEXP expr, QTextStream& fp) { // TODO TextResult clamps the newlines, beware // fp << "\n"; // TODO move this to some other place and make configurable fp << QLatin1String(""); fp << QLatin1String(""); int leftOnThisRow=25; for (int i=0; i"); fp << QLatin1String(""); leftOnThisRow=25; } QString cellData; switch (TYPEOF(expr)) { case REALSXP: cellData=QString::number(REAL(expr)[i]); break; case INTSXP: cellData=QString::number(INTEGER(expr)[i]); break; case STRSXP: cellData=QLatin1String(CHAR(STRING_ELT(expr,i))); break; default: return false; } fp << QLatin1String(""); // TODO HTML-safening leftOnThisRow--; } fp << QLatin1String(""); fp << QLatin1String("
[1]
[")+QString::number(i+1)+QLatin1String("]")+cellData+QLatin1String("
"); // fp << ""; return true; } 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())),NULL,&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), NULL, &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 spearately // 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),NULL,&errorOccurred)); // TODO: error checks - if (*INTEGER(count)==1) + if (*INTEGER(count)==0) + qDebug() << "no result, so show nothing"; + else if (*INTEGER(count)==1) Rf_PrintValue(result); else { static int htmlresult_id=0; QString fname=QString::fromLatin1("%1/Rtable%2.html").arg(m_tmpDir,QString::number(htmlresult_id++)); QFile fp(fname); if (fp.open(QIODevice::WriteOnly)) { QTextStream s(&fp); bool canProcess=htmlVector(result,s); fp.close(); if (canProcess) { neededFiles<hasOtherResults=true; } else Rf_PrintValue(result); //In case we do not know yet how to display it } } UNPROTECT(1); } setCurrentExpression(0); //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