The R Project SVN R

Rev

Rev 18618 | Rev 35189 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 r 1 
/*
2 
 *  R : A Computer Langage for Statistical Data Analysis
3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
12976 pd 4 
 *  Copyright (C) 2001        The R Development Core Team
2 r 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, write to the Free Software
5458 ripley 18 
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
2 r 19 
 */
20 
 
5187 hornik 21 
#ifdef HAVE_CONFIG_H
7701 hornik 22 
#include <config.h>
5187 hornik 23 
#endif
24 
 
11668 ripley 25 
#include <Defn.h>
26 
#include <Fileio.h>
27 
#include <IOStuff.h>
28 
#include <Parse.h>
29 
#include <Rconnections.h>
2 r 30 
 
291 ihaka 31 
extern IoBuffer R_ConsoleIob;
6994 pd 32 
/* extern int errno; No longer used */
2 r 33 
 
6189 maechler 34 
/* "do_parse" - the user interface input/output to files.
2 r 35 
 
6189 maechler 36 
 The internal R_Parse.. functions are defined in ./gram.y (-> gram.c)
2 r 37 
 
6189 maechler 38 
 .Internal( parse(file, n, text, prompt) )
39 
 If there is text then that is read and the other arguments are ignored.
40 
*/
2 r 41 
SEXP do_parse(SEXP call, SEXP op, SEXP args, SEXP env)
42 
{
11656 ripley 43 
    SEXP text, prompt, s;
44 
    Rconnection con;
11668 ripley 45 
    Rboolean wasopen;
25961 ripley 46 
    int ifile, num;
47 
    ParseStatus status;
11656 ripley 48 
 
1839 ihaka 49 
    checkArity(op, args);
50 
    R_ParseError = 0;
51 
    R_ParseCnt = 0;
2 r 52 
 
11656 ripley 53 
    ifile = asInteger(CAR(args));                       args = CDR(args);
54 
 
55 
    con = getConnection(ifile);
56 
    wasopen = con->isopen;
6201 maechler 57 
    num = asInteger(CAR(args));				args = CDR(args);
58 
    PROTECT(text = coerceVector(CAR(args), STRSXP));	args = CDR(args);
59 
    prompt = CAR(args);					args = CDR(args);
1839 ihaka 60 
    if (prompt == R_NilValue)
61 
	PROTECT(prompt);
62 
    else
63 
	PROTECT(prompt = coerceVector(prompt, STRSXP));
64 
 
65 
    if (length(text) > 0) {
66 
	if (num == NA_INTEGER)
67 
	    num = -1;
68 
	s = R_ParseVector(text, num, &status);
69 
	if (status != PARSE_OK)
5731 ripley 70 
	    errorcall(call, "parse error");
1839 ihaka 71 
    }
11656 ripley 72 
    else if (ifile >= 3) {/* file != "" */
1839 ihaka 73 
	if (num == NA_INTEGER)
74 
	    num = -1;
18618 ripley 75 
	if(!wasopen)
76 
	    if(!con->open(con)) error("cannot open the connection");
11656 ripley 77 
	s = R_ParseConn(con, num, &status);
78 
	if(!wasopen) con->close(con);
1839 ihaka 79 
	if (status != PARSE_OK)
5731 ripley 80 
	    errorcall(call, "syntax error on line %d", R_ParseError);
1839 ihaka 81 
    }
82 
    else {
83 
	if (num == NA_INTEGER)
84 
	    num = 1;
85 
	s = R_ParseBuffer(&R_ConsoleIob, num, &status, prompt);
86 
	if (status != PARSE_OK)
5731 ripley 87 
	    errorcall(call, "parse error");
1839 ihaka 88 
    }
11656 ripley 89 
    UNPROTECT(2);
6201 maechler 90 
    return s;
2 r 91 
}
6189 maechler 92 
 
93