int main (int argc, char **argv) { structRstart rp; Rstart Rp = &rp; char Rversion[25], *RHome; sprintf(Rversion, "%s.%s", R_MAJOR, R_MINOR); if(strcmp(getDLLVersion(), Rversion) != 0) { fprintf(stderr, "Error: R.DLL version does not match\n"); exit(1); } R_setStartTime(); R_DefParams(Rp); if((RHome = get_R_HOME()) == NULL) { fprintf(stderr, "R_HOME must be set in the environment or Registry\n"); exit(1); } Rp->rhome = RHome; Rp->home = getRUser(); Rp->CharacterMode = LinkDLL; Rp->ReadConsole = myReadConsole; Rp->WriteConsole = myWriteConsole; Rp->CallBack = myCallBack; Rp->ShowMessage = askok; Rp->YesNoCancel = askyesnocancel; Rp->Busy = myBusy; Rp->R_Quiet = TRUE; Rp->R_Interactive = FALSE; Rp->RestoreAction = SA_RESTORE; Rp->SaveAction = SA_NOSAVE; R_SetParams(Rp); /* so R_ShowMessage is set */ R_SizeFromEnv(Rp); R_SetParams(Rp); R_set_command_line_arguments(argc, argv); FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE)); signal(SIGBREAK, my_onintr); setup_term_ui(); /* initialize graphapp, eventloop, read Rconsole */ setup_Rmainloop(); #ifdef SIMPLE_CASE run_Rmainloop(); end_Rmainloop(); #else R_ReplDLLinit(); while(R_ReplDLLdo1() > 0) { /* add user actions here if desired */ } /* only get here on EOF (not q()) */ R_CleanUp(SA_DEFAULT, 0, 1); #endif end_Rmainloop(); return 0; }
REmbed::REmbed(const bool verbose, const bool interactive) : verbose(verbose), interactive(interactive) { loaded = false; // need to load the library RLibrary rlib; if (!rlib.load()) { // disable for future appsettings->setValue(GC_EMBED_R, false); rlib.errors.append("\nR has now been disabled in options."); QMessageBox msg(QMessageBox::Information, "Failed to load R library", rlib.errors.join("\n")); msg.exec(); return; } // we need to tell embedded R where to work QString envR_HOME(getenv("R_HOME")); QString configR_HOME = appsettings->value(NULL,GC_R_HOME,"").toString(); if (envR_HOME == "") { if (configR_HOME == "") { qDebug()<<"R HOME not set, R disabled"; return; } else { setenv("R_HOME", configR_HOME.toLatin1().constData(), true); } } // fire up R const char *R_argv[] = {name, "--gui=none", "--no-save", "--no-readline", "--silent", "--vanilla", "--slave"}; int R_argc = sizeof(R_argv) / sizeof(R_argv[0]); Rf_initEmbeddedR(R_argc, (char**)R_argv); R_ReplDLLinit(); // this is to populate the repl console buffers structRstart Rst; R_DefParams(&Rst); #ifdef WIN32 Rst.rhome = getenv("R_HOME"); Rst.home = getRUser(); Rst.CharacterMode = LinkDLL; Rst.ReadConsole = &RTool::R_ReadConsoleWin; Rst.WriteConsole = &RTool::R_WriteConsole; Rst.WriteConsoleEx = &RTool::R_WriteConsoleEx; Rst.CallBack = &RTool::R_ProcessEvents; Rst.ShowMessage = &RTool::R_ShowMessage; Rst.YesNoCancel = &RTool::R_YesNoCancel; Rst.Busy = &RTool::R_Busy; #endif Rst.R_Interactive = (Rboolean) interactive; // sets interactive() to eval to false R_SetParams(&Rst); loaded = true; }
int main (int argc, char **argv) { structRstart rp; Rstart Rp = &rp; char Rversion[25], *RHome; snprintf(Rversion, 25, "%s.%s", R_MAJOR, R_MINOR); if(strcmp(getDLLVersion(), Rversion) != 0) { fprintf(stderr, "Error: R.DLL version does not match\n"); exit(1); } R_setStartTime(); R_DefParams(Rp); if((RHome = get_R_HOME()) == NULL) { fprintf(stderr, "R_HOME must be set in the environment or Registry\n"); exit(1); } Rp->rhome = RHome; Rp->home = getRUser(); Rp->CharacterMode = LinkDLL; Rp->ReadConsole = myReadConsole; Rp->WriteConsole = NULL; /* for illustration purposes we use more flexible WriteConsoleEx */ Rp->WriteConsoleEx = myWriteConsoleEx; Rp->CallBack = myCallBack; Rp->ShowMessage = askok; Rp->YesNoCancel = askyesnocancel; Rp->Busy = myBusy; Rp->R_Quiet = TRUE; Rp->R_Interactive = FALSE; Rp->RestoreAction = SA_RESTORE; Rp->SaveAction = SA_NOSAVE; R_SetParams(Rp); R_set_command_line_arguments(argc, argv); FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE)); signal(SIGBREAK, my_onintr); GA_initapp(0, 0); readconsolecfg(); setup_Rmainloop(); #ifdef SIMPLE_CASE run_Rmainloop(); #else R_ReplDLLinit(); while(R_ReplDLLdo1() > 0) { /* add user actions here if desired */ } /* only get here on EOF (not q()) */ #endif Rf_endEmbeddedR(0); return 0; }
void RInside::repl(){ R_ReplDLLinit(); while( R_ReplDLLdo1() > 0 ) {} }
// TODO: use a vector<string> would make all this a bit more readable void RInside::initialize(const int argc, const char* const argv[], const bool loadRcpp, const bool verbose, const bool interactive) { if (instance_m) { throw std::runtime_error( "can only have one RInside instance" ) ; } else { instance_m = this ; } verbose_m = verbose; // Default is false interactive_m = interactive; // generated from Makevars{.win} #include "RInsideEnvVars.h" #ifdef WIN32 // we need a special case for Windows where users may deploy an RInside binary from CRAN // which will have R_HOME set at compile time to CRAN's value -- so let's try to correct // this here: a) allow user's setting of R_HOME and b) use R's get_R_HOME() function if (getenv("R_HOME") == NULL) { // if on Windows and not set char *rhome = get_R_HOME(); // query it, including registry if (rhome != NULL) { // if something was found setenv("R_HOME", get_R_HOME(), 1); // store what we got as R_HOME } // this will now be used in next blocks } #endif for (int i = 0; R_VARS[i] != NULL; i+= 2) { if (getenv(R_VARS[i]) == NULL) { // if env variable is not yet set if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){ throw std::runtime_error(std::string("Could not set R environment variable ") + std::string(R_VARS[i]) + std::string(" to ") + std::string(R_VARS[i+1])); } } } #ifndef WIN32 R_SignalHandlers = 0; // Don't let R set up its own signal handlers #endif init_tempdir(); const char *R_argv[] = {(char*)programName, "--gui=none", "--no-save", "--no-readline", "--silent", "--vanilla", "--slave"}; int R_argc = sizeof(R_argv) / sizeof(R_argv[0]); Rf_initEmbeddedR(R_argc, (char**)R_argv); #ifndef WIN32 R_CStackLimit = -1; // Don't do any stack checking, see R Exts, '8.1.5 Threading issues' #endif R_ReplDLLinit(); // this is to populate the repl console buffers structRstart Rst; R_DefParams(&Rst); Rst.R_Interactive = (Rboolean) interactive_m; // sets interactive() to eval to false #ifdef WIN32 Rst.rhome = getenv("R_HOME"); // which is set above as part of R_VARS Rst.home = getRUser(); Rst.CharacterMode = LinkDLL; Rst.ReadConsole = myReadConsole; Rst.WriteConsole = myWriteConsole; Rst.CallBack = myCallBack; Rst.ShowMessage = myAskOk; Rst.YesNoCancel = myAskYesNoCancel; Rst.Busy = myBusy; #endif R_SetParams(&Rst); if (true || loadRcpp) { // we always need Rcpp, so load it anyway // Rf_install is used best by first assigning like this so that symbols get into the symbol table // where they cannot be garbage collected; doing it on the fly does expose a minuscule risk of garbage // collection -- with thanks to Doug Bates for the explanation and Luke Tierney for the heads-up SEXP suppressMessagesSymbol = Rf_install("suppressMessages"); SEXP requireSymbol = Rf_install("require"); Rf_eval(Rf_lang2(suppressMessagesSymbol, Rf_lang2(requireSymbol, Rf_mkString("Rcpp"))), R_GlobalEnv); } global_env_m = new Rcpp::Environment(); // member variable for access to R's global environment autoloads(); // loads all default packages, using code autogenerate from Makevars{,.win} if ((argc - optind) > 1){ // for argv vector in Global Env */ Rcpp::CharacterVector s_argv( argv+(1+optind), argv+argc ); assign(s_argv, "argv"); } else { assign(R_NilValue, "argv") ; } init_rand(); // for tempfile() to work correctly */ }
// TODO: use a vector<string> would make all this a bit more readable void RInside::initialize(const int argc, const char* const argv[], const bool loadRcpp) { logTxt("RInside::ctor BEGIN", verbose); if (instance_) { throw std::runtime_error( "can only have one RInside instance" ) ; } else { instance_ = this ; } verbose_m = false; // Default is false // generated as littler.h via from svn/littler/littler.R #include <RInsideEnvVars.h> for (int i = 0; R_VARS[i] != NULL; i+= 2) { if (getenv(R_VARS[i]) == NULL) { // if env variable is not yet set if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){ //perror("ERROR: couldn't set/replace an R environment variable"); //exit(1); throw std::runtime_error(std::string("Could not set R environment variable ") + std::string(R_VARS[i]) + std::string(" to ") + std::string(R_VARS[i+1])); } } } #ifndef WIN32 R_SignalHandlers = 0; // Don't let R set up its own signal handlers #endif #ifdef CSTACK_DEFNS R_CStackLimit = (uintptr_t)-1; // Don't do any stack checking, see R Exts, '8.1.5 Threading issues' #endif init_tempdir(); const char *R_argv[] = {(char*)programName, "--gui=none", "--no-save", "--no-readline", "--silent", "", ""}; const char *R_argv_opt[] = {"--vanilla", "--slave"}; int R_argc = (sizeof(R_argv) - sizeof(R_argv_opt) ) / sizeof(R_argv[0]); Rf_initEmbeddedR(R_argc, (char**)R_argv); R_ReplDLLinit(); // this is to populate the repl console buffers structRstart Rst; R_DefParams(&Rst); Rst.R_Interactive = (Rboolean) FALSE; // sets interactive() to eval to false #ifdef WIN32 Rst.rhome = getenv("R_HOME"); // which is set above as part of R_VARS Rst.home = getRUser(); Rst.CharacterMode = LinkDLL; Rst.ReadConsole = myReadConsole; Rst.WriteConsole = myWriteConsole; Rst.CallBack = myCallBack; Rst.ShowMessage = myAskOk; Rst.YesNoCancel = myAskYesNoCancel; Rst.Busy = myBusy; #endif R_SetParams(&Rst); global_env = R_GlobalEnv ; if (loadRcpp) { // if asked for, load Rcpp (before the autoloads) // Rf_install is used best by first assigning like this so that symbols get into the symbol table // where they cannot be garbage collected; doing it on the fly does expose a minuscule risk of garbage // collection -- with thanks to Doug Bates for the explanation and Luke Tierney for the heads-up SEXP suppressMessagesSymbol = Rf_install("suppressMessages"); SEXP requireSymbol = Rf_install("require"); Rf_eval(Rf_lang2(suppressMessagesSymbol, Rf_lang2(requireSymbol, Rf_mkString("Rcpp"))), R_GlobalEnv); } autoloads(); // loads all default packages if ((argc - optind) > 1){ // for argv vector in Global Env */ Rcpp::CharacterVector s_argv( argv+(1+optind), argv+argc ); assign(s_argv, "argv"); } else { assign(R_NilValue, "argv") ; } init_rand(); // for tempfile() to work correctly */ logTxt("RInside::ctor END", verbose); }
int main(int argc, char **argv){ /* R embedded arguments, and optional arguments to be picked via cmdline switches */ char *R_argv[] = {(char*)programName, "--gui=none", "--no-restore", "--no-save", "--no-readline", "--silent", "", ""}; char *R_argv_opt[] = {"--vanilla", "--slave"}; int R_argc = (sizeof(R_argv) - sizeof(R_argv_opt) ) / sizeof(R_argv[0]); int i, nargv, c, optpos=0, vanilla=0, quick=0, interactive=0, datastdin=0; char *evalstr = NULL; char *libstr = NULL; char *libpathstr = NULL; SEXP s_argv; structRstart Rst; char *datastdincmd = "X <- read.csv(file(\"stdin\"), stringsAsFactors=FALSE);"; static struct option optargs[] = { {"help", no_argument, NULL, 'h'}, {"usage", no_argument, 0, 0}, {"version", no_argument, NULL, 'V'}, {"vanilla", no_argument, NULL, 'v'}, {"eval", required_argument, NULL, 'e'}, {"packages", required_argument, NULL, 'l'}, {"verbose", no_argument, NULL, 'p'}, {"rtemp", no_argument, NULL, 't'}, {"quick", no_argument, NULL, 'q'}, {"interactive", no_argument, NULL, 'i'}, {"datastdin", no_argument, NULL, 'd'}, {"libpath", required_argument, NULL, 'L'}, {0, 0, 0, 0} }; while ((c = getopt_long(argc, argv, "+hVve:npl:L:tqid", optargs, &optpos)) != -1) { switch (c) { case 0: /* numeric 0 is code for a long option */ /* printf ("Got option %s %d", optargs[optpos].name, optpos);*/ switch (optpos) { /* so switch on the position in the optargs struct */ /* cases 0, 2, and 3 can't happen as they are covered by the '-h', */ /* '-V', and '-v' equivalences */ case 1: showUsageAndExit(); break; /* never reached */ case 5: verbose = 1; break; default: printf("Uncovered option position '%d'. Try `%s --help' for help\n", optpos, programName); exit(-1); } break; case 'h': /* -h is the sole short option, cf getopt_long() call */ showHelpAndExit(); break; /* never reached */ case 'e': evalstr = optarg; break; case 'l': libstr = optarg; break; case 'v': vanilla=1; break; case 'p': verbose=1; break; case 'V': showVersionAndExit(); break; /* never reached */ case 't': perSessionTempDir=TRUE; break; case 'q': quick=1; break; case 'i': interactive=1; break; case 'd': datastdin=1; break; case 'L': libpathstr = optarg; break; default: printf("Unknown option '%c'. Try `%s --help' for help\n",(char)c, programName); exit(-1); } } if (vanilla) { R_argv[R_argc++] = R_argv_opt[0]; } if (!verbose) { R_argv[R_argc++] = R_argv_opt[1]; } #ifdef DEBUG printf("R_argc %d sizeof(R_argv) \n", R_argc, sizeof(R_argv)); for (i=0; i<7; i++) { printf("R_argv[%d] = %s\n", i, R_argv[i]); } printf("optind %d, argc %d\n", optind, argc); for (i=0; i<argc; i++) { printf("argv[%d] = %s\n", i, argv[i]); } #endif /* Now, argv[optind] could be a file we want to source -- if we're * in the 'shebang' case -- or it could be an expression from stdin. * So call stat(1) on it, and if its a file we will treat it as such. */ struct stat sbuf; if (optind < argc && evalstr==NULL) { if ((strcmp(argv[optind],"-") != 0) && (stat(argv[optind],&sbuf) != 0)) { perror(argv[optind]); exit(1); } } /* Setenv R_* env vars: insert or replace into environment. */ for (i = 0; R_VARS[i] != NULL; i+= 2){ if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){ perror("ERROR: couldn't set/replace an R environment variable"); exit(1); } } /* We don't require() default packages upon startup; rather, we * set up delayedAssign's instead. see autoloads(). */ if (setenv("R_DEFAULT_PACKAGES","NULL",1) != 0) { perror("ERROR: couldn't set/replace R_DEFAULT_PACKAGES"); exit(1); } R_SignalHandlers = 0; /* Don't let R set up its own signal handlers */ #ifdef CSTACK_DEFNS R_CStackLimit = (uintptr_t)-1; /* Don't do any stack checking, see R Exts, '8.1.5 Threading issues' */ #endif littler_InitTempDir(); /* Set up temporary directoy */ Rf_initEmbeddedR(R_argc, R_argv); /* Initialize the embedded R interpreter */ R_ReplDLLinit(); /* this is to populate the repl console buffers */ if (!interactive) { /* new in littler 0.1.3 */ R_DefParams(&Rst); Rst.R_Interactive = 0; /* sets interactive() to eval to false */ R_SetParams(&Rst); } ptr_R_CleanUp = littler_CleanUp; /* R Exts, '8.1.2 Setting R callbacks */ if (quick != 1) { /* Unless user chose not to load libraries */ autoloads(); /* Force all default package to be dynamically required */ } /* Place any argv arguments into argv vector in Global Environment */ /* if we have an evalstr supplied from -e|--eval, correct for it */ if ((argc - optind - (evalstr==NULL)) >= 1) { int offset = (evalstr==NULL) + (strcmp(argv[optind],"-") == 0); /* Build string vector */ nargv = argc - optind - offset; PROTECT(s_argv = allocVector(STRSXP,nargv)); for (i = 0; i <nargv; i++){ STRING_PTR(s_argv)[i] = mkChar(argv[i+offset+optind]); #ifdef DEBUG printf("Passing %s to R\n", argv[i+offset+optind]); #endif } UNPROTECT(1); setVar(install("argv"),s_argv,R_GlobalEnv); } else { setVar(install("argv"),R_NilValue,R_GlobalEnv); } init_rand(); /* for tempfile() to work correctly */ if (!vanilla) { FILE *fp; char rprofilesite[128]; snprintf(rprofilesite, 110, "%s/etc/Rprofile.site", getenv("R_HOME")); if (fp = fopen(rprofilesite, "r")) { fclose(fp); /* don't actually need it */ #ifdef DEBUG printf("Sourcing %s\n", rprofilesite); #endif source(rprofilesite); } char dotrprofile[128]; snprintf(dotrprofile, 110, "%s/.Rprofile", getenv("HOME")); if (fp = fopen(dotrprofile, "r")) { fclose(fp); /* don't actually need it */ #ifdef DEBUG printf("Sourcing %s\n", dotrprofile); #endif source(dotrprofile); } char *etclittler = "/etc/littler.r"; /* load /etc/litter.r if it exists */ if (fp = fopen(etclittler, "r")) { fclose(fp); /* don't actually need it */ #ifdef DEBUG printf("Sourcing %s\n", etclittler); #endif source(etclittler); } char dotlittler[128]; /* load ~/.litter.r if it exists */ snprintf(dotlittler, 110, "%s/.littler.r", getenv("HOME")); if (fp = fopen(dotlittler, "r")) { fclose(fp); /* don't actually need it */ #ifdef DEBUG printf("Sourcing %s\n", dotlittler); #endif source(dotlittler); } } if (libpathstr != NULL) { /* if requested by user, set libPaths */ char buf[128]; membuf_t pb = init_membuf(512); snprintf(buf, 127 - 12 - strlen(libpathstr), ".libPaths(\"%s\");", libpathstr); parse_eval(&pb, buf, 1); destroy_membuf(pb); } if (libstr != NULL) { /* if requested by user, load libraries */ char *ptr, *token, *strptr; char buf[128]; ptr = token = libstr; membuf_t pb = init_membuf(512); while (token != NULL) { token = strtok_r(ptr, ",", &strptr); ptr = NULL; /* after initial call strtok expects NULL */ if (token != NULL) { snprintf(buf, 127 - 27 - strlen(token), "suppressMessages(library(%s));", token); parse_eval(&pb, buf, 1); } } destroy_membuf(pb); } if (datastdin) { /* if req. by user, read 'dat' from stdin */ membuf_t pb = init_membuf(512); parse_eval(&pb, datastdincmd, 1); destroy_membuf(pb); } /* Now determine which R code to evaluate */ int exit_val = 0; if (evalstr != NULL) { /* we have a command line expression to evaluate */ membuf_t pb = init_membuf(1024); exit_val = parse_eval(&pb, evalstr, 1); destroy_membuf(pb); } else if (optind < argc && (strcmp(argv[optind],"-") != 0)) { /* call R function source(filename) */ exit_val = source(argv[optind]); } else { /* Or read from stdin */ membuf_t lb = init_membuf(1024); membuf_t pb = init_membuf(1024); int lineno = 1; while(readline_stdin(&lb)){ exit_val = parse_eval(&pb,(char*)lb->buf,lineno++); if (exit_val) break; } destroy_membuf(lb); destroy_membuf(pb); } littler_CleanUp(SA_NOSAVE, exit_val, 0); return(0); /* not reached, but making -Wall happy */ }