1 /*
2 * R : A Computer Language for Statistical Data Analysis
3 * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
4 * Copyright (C) 1998-2020 The R Core Team
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this program; if not, a copy is available at
18 * https://www.R-project.org/Licenses/
19 */
20
21 /* <UTF8> char here is handled as a whole string, but note that
22 fprintf is used */
23
24
25 #ifdef HAVE_CONFIG_H
26 # include <config.h>
27 #endif
28
29 #define R_USE_SIGNALS 1 /* for Parse.h */
30 #include "Defn.h"
31 #include <Internal.h>
32 #include "Print.h"
33 #include "Fileio.h"
34 #include "Parse.h"
35
36 #include <stdio.h>
37 #ifdef Win32
38 # include "run.h"
39 int Rgui_Edit(char *filename, int enc, char *title, int modal);
40 #endif
41
42 #ifdef Unix
43 #define R_INTERFACE_PTRS 1
44 #include <Rinterface.h> /* for editor ptr */
45 #endif
46
47
48 #ifdef HAVE_UNISTD_H
49 # include <unistd.h> /* for unlink() */
50 #endif
51
52 /*
53 * ed, vi etc have 3 parameters. the data, a file and an editor
54 *
55 * If `file' is specified then the given file is used (and not removed on
56 * exit). If `file' is not specified then a temporary file is used; since
57 * only one temporary file is used for an entire session previous
58 * editing is lost. That file is removed at the end of the R session.
59 *
60 * If `data' is specified then it is passed out to be edited; if `data' is not
61 * specified then either `file' (if specified) or the temporary file is used
62 * (thus errors can be re-edited by calling edit a second time with no
63 * arguments).
64 *
65 * If the editor is specified then the specified editor is invoked if
66 * possible and an error message reported otherwise
67 */
68
69 static char *DefaultFileName;
70 static int EdFileUsed = 0;
71
InitEd()72 void attribute_hidden InitEd()
73 {
74 #ifdef Win32
75 DefaultFileName = R_tmpnam2("Redit", R_TempDir, ".R");
76 #else
77 DefaultFileName = R_tmpnam2(NULL, R_TempDir, ".R");
78 #endif
79 }
80
CleanEd()81 void CleanEd()
82 {
83 if(EdFileUsed) unlink(DefaultFileName);
84 }
85
do_edit(SEXP call,SEXP op,SEXP args,SEXP rho)86 SEXP do_edit(SEXP call, SEXP op, SEXP args, SEXP rho)
87 {
88 int i, rc;
89 ParseStatus status;
90 SEXP x, fn, envir, ed, src, srcfile, Rfn;
91 char *filename, *editcmd;
92 const char *cmd;
93 const void *vmaxsave;
94 FILE *fp;
95 #ifdef Win32
96 SEXP ti;
97 char *title;
98 #endif
99
100 checkArity(op, args);
101
102 vmaxsave = vmaxget();
103
104 x = CAR(args); args = CDR(args);
105 if (TYPEOF(x) == CLOSXP) envir = CLOENV(x);
106 else envir = R_NilValue;
107 PROTECT(envir);
108
109 fn = CAR(args); args = CDR(args);
110 if (!isString(fn))
111 error(_("invalid argument to edit()"));
112
113 if (LENGTH(STRING_ELT(fn, 0)) > 0) {
114 const char *ss = translateCharFP(STRING_ELT(fn, 0));
115 filename = R_alloc(strlen(ss), sizeof(char));
116 strcpy(filename, ss);
117 }
118 else filename = DefaultFileName;
119
120 if (x != R_NilValue) {
121 if((fp=R_fopen(R_ExpandFileName(filename), "w")) == NULL)
122 errorcall(call, _("unable to open file"));
123 if (LENGTH(STRING_ELT(fn, 0)) == 0) EdFileUsed++;
124 PROTECT(src = deparse1(x, 0, FORSOURCING)); /* deparse for sourcing, not for display */
125 for (i = 0; i < LENGTH(src); i++)
126 fprintf(fp, "%s\n", translateChar(STRING_ELT(src, i)));
127 UNPROTECT(1); /* src */
128 fclose(fp);
129 }
130 #ifdef Win32
131 ti = CAR(args);
132 #endif
133 args = CDR(args);
134 ed = CAR(args);
135 if (!isString(ed)) errorcall(call, _("argument 'editor' type not valid"));
136 cmd = translateCharFP(STRING_ELT(ed, 0));
137 if (strlen(cmd) == 0) errorcall(call, _("argument 'editor' is not set"));
138 editcmd = R_alloc(strlen(cmd) + strlen(filename) + 6, sizeof(char));
139 #ifdef Win32
140 if (!strcmp(cmd,"internal")) {
141 if (!isString(ti))
142 error(_("'title' must be a string"));
143 if (LENGTH(STRING_ELT(ti, 0)) > 0) {
144 title = R_alloc(strlen(CHAR(STRING_ELT(ti, 0)))+1, sizeof(char));
145 strcpy(title, CHAR(STRING_ELT(ti, 0)));
146 } else {
147 title = R_alloc(strlen(filename)+1, sizeof(char));
148 strcpy(title, filename);
149 }
150 Rgui_Edit(filename, CE_NATIVE, title, 1);
151 }
152 else {
153 /* Quote path if not quoted */
154 if(cmd[0] != '"')
155 sprintf(editcmd, "\"%s\" \"%s\"", cmd, filename);
156 else
157 sprintf(editcmd, "%s \"%s\"", cmd, filename);
158 rc = runcmd(editcmd, CE_NATIVE, 1, 1, NULL, NULL, NULL);
159 if (rc == NOLAUNCH)
160 errorcall(call, _("unable to run editor '%s'"), cmd);
161 if (rc != 0)
162 warningcall(call, _("editor ran but returned error status"));
163 }
164 #else
165 if (ptr_R_EditFile)
166 rc = ptr_R_EditFile(filename);
167 else {
168 sprintf(editcmd, "'%s' '%s'", cmd, filename); // allow for spaces
169 rc = R_system(editcmd);
170 }
171 if (rc != 0)
172 errorcall(call, _("problem with running editor %s"), cmd);
173 #endif
174
175 if (asLogical(GetOption1(install("keep.source")))) {
176 PROTECT(Rfn = findFun(install("readLines"), R_BaseEnv));
177 PROTECT(src = lang2(Rfn, ScalarString(mkChar(R_ExpandFileName(filename)))));
178 PROTECT(src = eval(src, R_BaseEnv));
179 PROTECT(Rfn = findFun(install("srcfilecopy"), R_BaseEnv));
180 PROTECT(srcfile = lang3(Rfn, ScalarString(mkChar("<tmp>")), src));
181 srcfile = eval(srcfile, R_BaseEnv);
182 UNPROTECT(5);
183 } else
184 srcfile = R_NilValue;
185 PROTECT(srcfile);
186
187 /* <FIXME> setup a context to close the file, and parse and eval
188 line by line */
189 if((fp = R_fopen(R_ExpandFileName(filename), "r")) == NULL)
190 errorcall(call, _("unable to open file to read"));
191
192 x = PROTECT(R_ParseFile(fp, -1, &status, srcfile));
193 fclose(fp);
194
195 if (status != PARSE_OK)
196 errorcall(call,
197 _("%s occurred on line %d\n use a command like\n x <- edit()\n to recover"), R_ParseErrorMsg, R_ParseError);
198 R_ResetConsole();
199 { /* can't just eval(x) here */
200 int j, n;
201 SEXP tmp = R_NilValue;
202
203 n = LENGTH(x);
204 for (j = 0 ; j < n ; j++)
205 tmp = eval(VECTOR_ELT(x, j), R_GlobalEnv);
206 x = tmp;
207 }
208 if (TYPEOF(x) == CLOSXP && envir != R_NilValue)
209 SET_CLOENV(x, envir);
210 UNPROTECT(3);
211 vmaxset(vmaxsave);
212 return x;
213 }
214