The R Project SVN R

Rev

Rev 35493 | Rev 36990 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 35493 Rev 35498
Line 29... Line 29...
29 
#include <Rconnections.h>
 29 
#include <Rconnections.h>
30 
 
 30 
 
31 
extern IoBuffer R_ConsoleIob;
 31 
extern IoBuffer R_ConsoleIob;
32 
/* extern int errno; No longer used */
 32 
/* extern int errno; No longer used */
33 
 
 33 
 
- 
 
 34 
SEXP getParseContext()
- 
 
 35 
{
- 
 
 36 
    int i, last = PARSE_CONTEXT_SIZE;
- 
 
 37 
    char context[PARSE_CONTEXT_SIZE+1];
- 
 
 38 
 
- 
 
 39 
    SEXP ans = R_NilValue, ans2;
- 
 
 40 
    int nn, nnn, nread;
- 
 
 41 
    char c;
- 
 
 42 
 
- 
 
 43 
    context[last] = '\0';
- 
 
 44 
    for (i=R_ParseContextLast; last>0 ; i--) {
- 
 
 45 
	i = i % PARSE_CONTEXT_SIZE;
- 
 
 46 
	context[--last] = R_ParseContext[i];
- 
 
 47 
	if (!context[last]) {
- 
 
 48 
	    last++;
- 
 
 49 
	    break;
- 
 
 50 
	}
- 
 
 51 
    }
- 
 
 52
- 
 
 53 
    nn = 16; /* initially allocate space for 16 lines */
- 
 
 54 
    nnn = nn;
- 
 
 55 
    PROTECT(ans = allocVector(STRSXP, nn));
- 
 
 56 
    c = context[last];
- 
 
 57 
    nread = 0;
- 
 
 58 
    while(c) {
- 
 
 59 
        nread++;
- 
 
 60 
	if(nread >= nn) {
- 
 
 61 
	    ans2 = allocVector(STRSXP, 2*nn);
- 
 
 62 
	    for(i = 0; i < nn; i++)
- 
 
 63 
		SET_STRING_ELT(ans2, i, STRING_ELT(ans, i));
- 
 
 64 
	    nn *= 2;
- 
 
 65 
	    UNPROTECT(1); /* old ans */
- 
 
 66 
	    PROTECT(ans = ans2);
- 
 
 67 
	}
- 
 
 68 
	i = last;
- 
 
 69 
	while((c = context[++i])) {
- 
 
 70 
	    if(c == '\n') break;
- 
 
 71 
	}
- 
 
 72 
	context[i] = '\0';
- 
 
 73 
	SET_STRING_ELT(ans, nread-1, mkChar(context + last));
- 
 
 74 
	last = i+1;
- 
 
 75 
    }
- 
 
 76 
    /* get rid of empty line after last newline */
- 
 
 77 
    if (nread && !length(STRING_ELT(ans, nread-1))) nread--;
- 
 
 78 
    PROTECT(ans2 = allocVector(STRSXP, nread));
- 
 
 79 
    for(i = 0; i < nread; i++)
- 
 
 80 
	SET_STRING_ELT(ans2, i, STRING_ELT(ans, i));
- 
 
 81 
    UNPROTECT(2);
- 
 
 82 
    return ans2;
- 
 
 83 
}
- 
 
 84 
 
- 
 
 85 
void parseError(SEXP call, int linenum)
- 
 
 86 
{
- 
 
 87 
    SEXP context = getParseContext();
- 
 
 88 
    int len = length(context);
- 
 
 89 
    if (linenum) {
- 
 
 90 
	switch (len) {
- 
 
 91 
	case 0: errorcall(call, _("syntax error on line %d"), linenum); break;
- 
 
 92 
	case 1: errorcall(call, _("syntax error at\n%d: %s"),
- 
 
 93 
			    linenum, CHAR(STRING_ELT(context, 0))); break;
- 
 
 94 
	default: errorcall(call, _("syntax error at\n%d: %s\n%d: %s"),
- 
 
 95 
			    linenum-1, CHAR(STRING_ELT(context, len-2)),
- 
 
 96 
			    linenum, CHAR(STRING_ELT(context, len-1))); break;
- 
 
 97 
	}
- 
 
 98 
    } else {
- 
 
 99 
	switch (len) {
- 
 
 100 
	case 0: errorcall(call, _("syntax error"), R_ParseError); break;
- 
 
 101 
	case 1: errorcall(call, _("syntax error in \"%s\""),
- 
 
 102 
			    CHAR(STRING_ELT(context, 0))); break;
- 
 
 103 
	default: errorcall(call, _("syntax error in:\n\"%s\n%s\""),
- 
 
 104 
			    CHAR(STRING_ELT(context, len-2)),
- 
 
 105 
			    CHAR(STRING_ELT(context, len-1))); break;
- 
 
 106 
	}
- 
 
 107 
    }
- 
 
 108 
}
- 
 
 109 
 
34 
/* "do_parse" - the user interface input/output to files.
 110 
/* "do_parse" - the user interface input/output to files.
35 
 
 111 
 
36 
 The internal R_Parse.. functions are defined in ./gram.y (-> gram.c)
 112 
 The internal R_Parse.. functions are defined in ./gram.y (-> gram.c)
37 
 
 113 
 
38 
 .Internal( parse(file, n, text, prompt) )
 114 
 .Internal( parse(file, n, text, prompt) )
Line 66... Line 142...
66 
 
 142 
 
67 
    if (length(text) > 0) {
 143 
    if (length(text) > 0) {
68 
	if (num == NA_INTEGER)
 144 
	if (num == NA_INTEGER)
69 
	    num = -1;
 145 
	    num = -1;
70 
	s = R_ParseVector(text, num, &status);
 146 
	s = R_ParseVector(text, num, &status);
71 
	if (status != PARSE_OK)
 147 
	if (status != PARSE_OK) parseError(call, 0);
72 
	    errorcall(call, _("parse error"));
 - 
 
73 
    }
 148 
    }
74 
    else if (ifile >= 3) {/* file != "" */
 149 
    else if (ifile >= 3) {/* file != "" */
75 
	if (num == NA_INTEGER)
 150 
	if (num == NA_INTEGER)
76 
	    num = -1;
 151 
	    num = -1;
77 
	if(!wasopen)
 152 
	if(!wasopen)
78 
	    if(!con->open(con)) error(_("cannot open the connection"));
 153 
	    if(!con->open(con)) error(_("cannot open the connection"));
79 
	s = R_ParseConn(con, num, &status);
 154 
	s = R_ParseConn(con, num, &status);
80 
	if(!wasopen) con->close(con);
 155 
	if(!wasopen) con->close(con);
81 
	if (status != PARSE_OK)
 - 
 
82 
	    errorcall(call, _("syntax error on line %d"), R_ParseError);
 156 
	if (status != PARSE_OK) parseError(call, R_ParseError);
83 
    }
 157 
    }
84 
    else {
 158 
    else {
85 
	if (num == NA_INTEGER)
 159 
	if (num == NA_INTEGER)
86 
	    num = 1;
 160 
	    num = 1;
87 
	s = R_ParseBuffer(&R_ConsoleIob, num, &status, prompt);
 161 
	s = R_ParseBuffer(&R_ConsoleIob, num, &status, prompt);
88 
	if (status != PARSE_OK)
 162 
	if (status != PARSE_OK) parseError(call, 0);
89 
	    errorcall(call, _("parse error"));
 - 
 
90 
    }
 163 
    }
91 
    UNPROTECT(2);
 164 
    UNPROTECT(2);
92 
    return s;
 165 
    return s;
93 
}
 166 
}
94 
 
 167