/* Return NULL on failure */
char* SexpStrVector_getitem(const SEXP sexp, int i) {
if (TYPEOF(sexp) != STRSXP) {
printf("Not an R vector of type STRSXP.\n");
return NULL;
}
if ((i < 0) || (i >= LENGTH(sexp))) {
printf("Out-of-bound.\n");
/*FIXME: return int or NULL ?*/
return NULL;
}
char *res;
SEXP sexp_item;
PROTECT(sexp_item = STRING_ELT(sexp, (R_len_t)i));
cetype_t encoding = Rf_getCharCE(sexp_item);
switch (encoding) {
case CE_UTF8:
res = (char *)translateCharUTF8(sexp_item);
break;
default:
res = (char *)CHAR(sexp_item);
break;
}
UNPROTECT(1);
return res;
}
/* Return NA if not found*/
R_len_t
nameIndex(const SEXP sexp, const char *name) {
SEXP sexp_item, sexp_names;
char *name_item;
PROTECT(sexp_names = getAttrib(sexp, R_NamesSymbol));
R_len_t n = LENGTH(sexp);
R_len_t i;
cetype_t encoding;
int found = 0;
for (i = 0; i < n; i++) {
sexp_item = STRING_ELT(sexp_names, i);
encoding = Rf_getCharCE(sexp_item);
switch (encoding) {
case CE_UTF8:
name_item = (char *)translateCharUTF8(sexp_item);
break;
default:
name_item = (char *)CHAR(sexp_item);
break;
}
if (strcmp(name, name_item)) {
found = 1;
break;
}
}
if (found) {
return i;
} else {
return R_NaInt;
}
}
static SEXP tabExpand(SEXP strings)
{
int i;
char buffer[200], *b;
const char *input;
SEXP result;
PROTECT(strings);
PROTECT(result = allocVector(STRSXP, length(strings)));
for (i = 0; i < length(strings); i++) {
input = CHAR(STRING_ELT(strings, i));
for (b = buffer; *input && (b-buffer < 192); input++) {
if (*input == '\t') do {
*b++ = ' ';
} while (((b-buffer) & 7) != 0);
else *b++ = *input;
}
*b = '\0';
SET_STRING_ELT(result, i, mkCharCE(buffer, Rf_getCharCE(STRING_ELT(strings, i))));
}
UNPROTECT(2);
return result;
}
/* returns string from a CHARSXP making sure that the result is in UTF-8 */
const char *rj_char_utf8(SEXP s) {
if (Rf_getCharCE(s) == CE_UTF8) return CHAR(s);
return Rf_reEnc(CHAR(s), getCharCE(s), CE_UTF8, 0); /* subst. invalid chars: 1=hex, 2=., 3=?, other=skip */
}
