The R Project SVN R

#include <Rinternals.h>

#include <R_ext/Parse.h>  /* parsing is used in handling escape codes */

static SEXP lang5(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w)

{

    PROTECT(s);

    s = LCONS(s, list4(t, u, v, w));

    UNPROTECT(1);

    return s;

}

static SEXP processEscapes(SEXP x)

{

    SEXP newval, pattern, replacement, expr;

    ParseStatus status;

    /* We process escape sequences in a scalar string by escaping

       unescaped quotes, then quoting the whole thing and parsing it.  This

       is supposed to be equivalent to the R code

       newval <- gsub(perl=TRUE, "(?<!\\\\)((\\\\\\\\)*)\"", "\\1\\\\\"", x)

       newval <- sub('(^.*$)', '"\1"', newval)

       newval <- eval(parse(text=newval))

       We do it this way to avoid extracting the escape handling

       code from the parser.  We need it in C code because this may be executed

       numerous times from C in dataentry.c */

    PROTECT( pattern = mkString("(?<!\\\\)((\\\\\\\\)*)\"") );

    PROTECT( replacement = mkString("\\1\\\\\"") );

    PROTECT( expr = lang5(install("gsub"), ScalarLogical(1), pattern, replacement, x) );

    SET_TAG( CDR(expr), install("perl") );

    PROTECT( newval = eval(expr, R_BaseEnv) );

    PROTECT( pattern = mkString("(^.*$)") );

    PROTECT( replacement = mkString("\"\\1\"") );

    PROTECT( expr = lang4(install("sub"), pattern, replacement, newval) );

    PROTECT( newval = eval(expr, R_BaseEnv) );

    PROTECT( expr = R_ParseVector( newval, 1, &status, R_NilValue) );

    /* We only handle the first entry. If this were available more generally,

       we'd probably want to loop over all of expr */

    if (status == PARSE_OK && length(expr))

	PROTECT( newval = eval(VECTOR_ELT(expr, 0), R_BaseEnv) );

    else

	PROTECT( newval = R_NilValue );  /* protect just so the count doesn't change */

    UNPROTECT(10);

    return newval;

}

		    SEXP newval;

		    PROTECT( newval = mkString(buf) );

		    PROTECT( newval = processEscapes(newval) );

		    if (TYPEOF(newval) == STRSXP && length(newval) == 1)

		    else

			warning("dataentry: parse error on string");

		    UNPROTECT(2);