/* 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 */ }