1 /*
2 * ROptions.cpp
3 *
4 * Copyright (C) 2021 by RStudio, PBC
5 *
6 * Unless you have received this program directly from RStudio pursuant
7 * to the terms of a commercial license agreement with RStudio, then
8 * this program is licensed to you under the terms of version 3 of the
9 * GNU Affero General Public License. This program is distributed WITHOUT
10 * ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT,
11 * MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the
12 * AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details.
13 *
14 */
15
16 #define R_INTERNAL_FUNCTIONS
17 #include <r/ROptions.hpp>
18
19 #include <boost/format.hpp>
20
21 #include <core/Log.hpp>
22 #include <shared_core/FilePath.hpp>
23 #include <shared_core/SafeConvert.hpp>
24 #include <core/system/Environment.hpp>
25
26 #include <r/RExec.hpp>
27
28 using namespace rstudio::core;
29
30 namespace rstudio {
31 namespace r {
32 namespace options {
33
34 namespace {
35
36 // last-known width of the build pane, in characters
37 int s_buildWidth = -1;
38
39 } // anonymous namespace
40
saveOptions(const FilePath & filePath)41 Error saveOptions(const FilePath& filePath)
42 {
43 return exec::RFunction(".rs.saveOptions", filePath.getAbsolutePath()).call();
44 }
45
restoreOptions(const FilePath & filePath)46 Error restoreOptions(const FilePath& filePath)
47 {
48 return exec::RFunction(".rs.restoreOptions", filePath.getAbsolutePath()).call();
49 }
50
51 const int kDefaultWidth = 80;
52
setOptionWidth(int width)53 void setOptionWidth(int width)
54 {
55 core::system::setenv("RSTUDIO_CONSOLE_WIDTH",
56 core::safe_convert::numberToString(width));
57
58 boost::format fmt("options(width=%1%)");
59 Error error = r::exec::executeString(boost::str(fmt % width));
60 if (error)
61 LOG_ERROR(error);
62 }
63
getOptionWidth()64 int getOptionWidth()
65 {
66 return getOption<int>("width", kDefaultWidth);
67 }
68
setBuildOptionWidth(int width)69 void setBuildOptionWidth(int width)
70 {
71 s_buildWidth = width;
72 }
73
getBuildOptionWidth()74 int getBuildOptionWidth()
75 {
76 return s_buildWidth;
77 }
78
getOption(const std::string & name)79 SEXP getOption(const std::string& name)
80 {
81 if (!r::exec::isMainThread())
82 {
83 LOG_ERROR_MESSAGE("R.getOption: " + name + " made from non-main thread");
84 return R_NilValue;
85 }
86 return Rf_GetOption(Rf_install(name.c_str()), R_BaseEnv);
87 }
88
setErrorOption(SEXP value)89 SEXP setErrorOption(SEXP value)
90 {
91 SEXP errorTag = Rf_install("error");
92 SEXP option = SYMVALUE(Rf_install(".Options"));
93 while (option != R_NilValue)
94 {
95 // are we removing the option?
96 if (value == R_NilValue)
97 {
98 // remove the error option from the list
99 if (TAG(CDR(option)) == errorTag)
100 {
101 SEXP previous = CAR(CDR(option));
102 SETCDR(option, CDDR(option));
103 return previous;
104 }
105 }
106
107 // is this the error option?
108 if (TAG(option) == errorTag)
109 {
110 // set and return previous value
111 SEXP previous = CAR(option);
112 SETCAR(option, value);
113 return previous;
114 }
115
116 if (CDR(option) == R_NilValue && value != R_NilValue)
117 {
118 // no error option exists at all; add it so we can set the value
119 SETCDR(option, Rf_allocList(1));
120 SETCAR(CDR(option), value);
121 SET_TAG(CDR(option), errorTag);
122 break;
123 }
124
125 // next option
126 option = CDR(option);
127 }
128
129 return R_NilValue;
130 }
131
132 } // namespace options
133 } // namespace r
134 } // namespace rstudio
135
136
137
138