自学教程：C++ translateChar函数代码示例

FILE *RC_fopen(const SEXP fn, const char *mode, const Rboolean expand){    const void *vmax = vmaxget();    const char *filename = translateChar(fn), *res;    if(fn == NA_STRING || !filename) return NULL;    if(expand) res = R_ExpandFileName(filename);    else res = filename;    vmaxset(vmax);    return fopen(res, mode);}

SEXP RTcl_AssignObjToVar(SEXP args){    const void *vmax = vmaxget();    Tcl_SetVar2Ex(RTcl_interp,		  translateChar(STRING_ELT(CADR(args), 0)),		  NULL,		  (Tcl_Obj *) R_ExternalPtrAddr(CADDR(args)),		  0);    vmaxset(vmax);    return R_NilValue;}

SEXP RTcl_GetArrayElem(SEXP args){    SEXP x, i;    const char *xstr, *istr;    Tcl_Obj *tclobj;    const void *vmax = vmaxget();    x = CADR(args);    i = CADDR(args);    xstr = translateChar(STRING_ELT(x, 0));    istr = translateChar(STRING_ELT(i, 0));    tclobj = Tcl_GetVar2Ex(RTcl_interp, xstr, istr, 0);    vmaxset(vmax);    if (tclobj == NULL)	return R_NilValue;    else	return makeRTclObject(tclobj);}

/* Translates a hex value into it's appropriate index in the array.   In reality, this just turns the first HASH_SIG_FIGS into decimal */uint64_t translate(char *n) {   int count;  uint64_t total = 0, power = 1;  for (count = HASH_SIG_FIGS - 1 ; count >= 0 ; count--) {    total += translateChar(n[count]) * power;    power *= 16;  }  return total;}

SEXP chooseDir(SEXP def, SEXP caption){    const char *p;    char path[MAX_PATH];    if(!isString(def) || length(def) != 1 )	error(_("'default' must be a character string"));    p = translateChar(STRING_ELT(def, 0));    if(strlen(p) >= MAX_PATH) error(_("'default' is overlong"));    strcpy(path, R_ExpandFileName(p));    R_fixbackslash(path);    if(!isString(caption) || length(caption) != 1 )	error(_("'caption' must be a character string"));    p = askcdstring(translateChar(STRING_ELT(caption, 0)), path);    SEXP ans = PROTECT(allocVector(STRSXP, 1));    SET_STRING_ELT(ans, 0, p ? mkChar(p): NA_STRING);    UNPROTECT(1);    return ans;}

apop_data *get_factors(SEXP ls, char const *varname){    int nls = LENGTH(ls);    if (isNull(ls)) return NULL;    //else:    apop_data *out = apop_text_alloc(NULL, nls, 1);    for (int i = 0; i < nls; i++)         apop_text_add(out, i, 0, translateChar(STRING_ELT(ls, i)));    asprintf(&out->names->title, "<categories for %s>", varname);    apop_data_show(out);    return out;}

SEXP attribute_hidden do_dynunload(SEXP call, SEXP op, SEXP args, SEXP env){    char buf[2 * PATH_MAX];    checkArity(op,args);    if (!isString(CAR(args)) || LENGTH(CAR(args)) != 1)	error(_("character argument expected"));    GetFullDLLPath(call, buf, translateChar(STRING_ELT(CAR(args), 0)));    if(!DeleteDLL(buf))	error(_("shared object '%s/' was not loaded"), buf);    return R_NilValue;}

/* Match what EncodeString does with encodings */attribute_hiddenint Rstrlen(SEXP s, int quote){    cetype_t ienc = getCharCE(s);    if (ienc == CE_UTF8 || ienc == CE_BYTES)	return Rstrwid(CHAR(s), LENGTH(s), ienc, quote);    const void *vmax = vmaxget();    const char *p = translateChar(s);    int len = Rstrwid(p, (int)strlen(p), CE_NATIVE, quote);    vmaxset(vmax);    return len;}

/* Returns: */staticenum pmatchpstrmatch(SEXP target, SEXP input, size_t slen){    const char *st = "";    if(target == R_NilValue)	return NO_MATCH;    switch (TYPEOF(target)) {    case SYMSXP:	st = CHAR(PRINTNAME(target));	break;    case CHARSXP:	st = translateChar(target);	break;    }    if(strncmp(st, translateChar(input), slen) == 0)	return (strlen(st) == slen) ?  EXACT_MATCH : PARTIAL_MATCH;    else return NO_MATCH;}

SEXP winDialog(SEXP call, SEXP op, SEXP args, SEXP env){    SEXP message;    const char * type;    int res=YES;    args = CDR(args);    type = translateChar(STRING_ELT(CAR(args), 0));    message = CADR(args);    if(!isString(message) || length(message) != 1 ||       strlen(translateChar(STRING_ELT(message, 0))) > 255)	error(_("invalid '%s' argument"), "message");    if (strcmp(type, "ok")  == 0) {	askok(translateChar(STRING_ELT(message, 0)));	res = 10;    } else if (strcmp(type, "okcancel")  == 0) {	res = askokcancel(translateChar(STRING_ELT(message, 0)));	if(res == YES) res = 2;    } else if (strcmp(type, "yesno")  == 0) {	res = askyesno(translateChar(STRING_ELT(message, 0)));    } else if (strcmp(type, "yesnocancel")  == 0) {	res = askyesnocancel(translateChar(STRING_ELT(message, 0)));    } else	errorcall(call, _("unknown type"));    return ScalarInteger(res);}

int Fonts::charHeight(unsigned char c) {	byte curChar;	if (!_font)		return 0;	// Space is supposed to be handled like the first actual character (which is decimal 33)	curChar = translateChar(c);	assert(curChar < _charCount);	const ImageFrame &img = (*_font)[curChar];	return img._height + img._offset.y + 1;}

SEXP Rsockconnect(SEXP sport, SEXP shost){    if (length(sport) != 1) error("invalid 'socket' argument");    int port = asInteger(sport);    char *host[1];    host[0] = const_cast<char *>( translateChar(STRING_ELT(shost, 0)));    if(!initialized) internet_Init();    if(initialized > 0)	(*ptr->sockconnect)(&port, host);    else	error(_("socket routines cannot be loaded"));    return ScalarInteger(port); // The socket number}

/* utils::loadRconsole */SEXP in_loadRconsole(SEXP sfile){    struct structGUI gui;    const void *vmax = vmaxget();    if (!isString(sfile) || LENGTH(sfile) < 1)	error(_("invalid '%s' argument"), "file");    getActive(&gui);  /* Will get defaults if there's no active console */    if (loadRconsole(&gui, translateChar(STRING_ELT(sfile, 0)))) applyGUI(&gui);    if (strlen(gui.warning)) warning(gui.warning);    vmaxset(vmax);    return R_NilValue;}

SEXP RTcl_ObjFromVar(SEXP args){    Tcl_Obj *tclobj;    const void *vmax = vmaxget();    tclobj = Tcl_GetVar2Ex(RTcl_interp,                           translateChar(STRING_ELT(CADR(args), 0)),                           NULL,                           0);    SEXP res = makeRTclObject(tclobj);    vmaxset(vmax);    return res;}

SEXP attribute_hidden do_unsetenv(SEXP call, SEXP op, SEXP args, SEXP env){    int i, n;    SEXP ans, vars;    checkArity(op, args);    if (!isString(vars = CAR(args)))	error(_("wrong type for argument"));    n = LENGTH(vars);#if defined(HAVE_UNSETENV) || defined(HAVE_PUTENV_UNSET) || defined(HAVE_PUTENV_UNSET2)#ifdef HAVE_UNSETENV    for (i = 0; i < n; i++) unsetenv(translateChar(STRING_ELT(vars, i)));#elif defined(HAVE_PUTENV_UNSET)    for (i = 0; i < n; i++) {	char buf[1000];	snprintf(buf, 1000, "%s",  translateChar(STRING_ELT(vars, i)));	putenv(buf);    }#elif defined(HAVE_PUTENV_UNSET2)# ifdef Win32    for (i = 0; i < n; i++) {	const wchar_t *w = wtransChar(STRING_ELT(vars, i));	wchar_t buf[2*wcslen(w)];	wcscpy(buf, w);	wcscat(buf, L"=");	_wputenv(buf);    }# else    for (i = 0; i < n; i++) {	char buf[1000];	snprintf(buf, 1000, "%s=", translateChar(STRING_ELT(vars, i)));	putenv(buf);    }# endif#endif#elif defined(HAVE_PUTENV) || defined(HAVE_SETENV)    warning(_("this system cannot unset environment variables: setting to /"/""));    n = LENGTH(vars);    for (i = 0; i < n; i++) {#ifdef HAVE_SETENV	setenv(translateChar(STRING_ELT(vars, i)), "", 1);#else	Rputenv(translateChar(STRING_ELT(vars, i)), "");#endif    }#else    warning(_("'Sys.unsetenv' is not available on this system"));#endif    PROTECT(ans = allocVector(LGLSXP, n));    for (i = 0; i < n; i++)	LOGICAL(ans)[i] = !getenv(translateChar(STRING_ELT(vars, i)));    UNPROTECT(1);    return ans;}

SEXP attribute_hidden do_readEnviron(SEXP call, SEXP op, SEXP args, SEXP env){    checkArity(op, args);    SEXP x = CAR(args);    if (!isString(x) || LENGTH(x) != 1)	errorcall(call, _("argument '%s' must be a character string"), "x");    const char *fn = R_ExpandFileName(translateChar(STRING_ELT(x, 0)));    int res = process_Renviron(fn);    if (!res)	warningcall(call, _("file '%s' cannot be opened for reading"), fn);    return ScalarLogical(res != 0);}

SEXP setWinProgressBar(SEXP call, SEXP op, SEXP args, SEXP env){    args = CDR(args);    SEXP ptr = CAR(args);    winprogressbar *pbar;    double value;    pbar = R_ExternalPtrAddr(ptr);    if(!pbar)	error("invalid progressbar -- has it been closed?");    value = pbar->val;    if(!isNull(CADR(args))) {	int iv;	double val = asReal(CADR(args));	SEXP title = CADDR(args), label = CADDDR(args);	if (R_FINITE(val) && val >= pbar->min && val <= pbar->max) {	    iv = pbar->width * (val - pbar->min)/(pbar->max - pbar->min);	    setprogressbar(pbar->pb, iv);	    pbar->val = val;	}	if (!isNull(title)) {	    SEXP ctxt;	    if(!isString(title) || length(title) < 1)		errorcall(call, "invalid '%s' argument", "title");	    ctxt = STRING_ELT(title, 0);	    if (ctxt != NA_STRING)		settext(pbar->wprog, translateChar(ctxt));	}	if(pbar->lab && !isNull(label)) {	    SEXP clab;	    if(!isString(label) || length(label) < 1)		errorcall(call, "invalid '%s' argument", "label");	    clab = STRING_ELT(label, 0);	    if (clab != NA_STRING)		settext(pbar->lab, translateChar(clab));	}    }    return ScalarReal(value);}

attribute_hiddenconst char *EncodeEnvironment(SEXP x){    const void *vmax = vmaxget();    static char ch[1000];    if (x == R_GlobalEnv)	sprintf(ch, "<environment: R_GlobalEnv>");    else if (x == R_BaseEnv)	sprintf(ch, "<environment: base>");    else if (x == R_EmptyEnv)	sprintf(ch, "<environment: R_EmptyEnv>");    else if (R_IsPackageEnv(x))	snprintf(ch, 1000, "<environment: %s>",		translateChar(STRING_ELT(R_PackageEnvName(x), 0)));    else if (R_IsNamespaceEnv(x))	snprintf(ch, 1000, "<environment: namespace:%s>",		translateChar(STRING_ELT(R_NamespaceEnvSpec(x), 0)));    else snprintf(ch, 1000, "<environment: %p>", (void *)x);    vmaxset(vmax);    return ch;}

SEXP winMenuItems(SEXP call, SEXP op, SEXP args, SEXP env){    SEXP mname, ans, ansnames;    menuItems *items;    char errmsg[50];    int i;    args = CDR(args);    if (CharacterMode != RGui)	errorcall(call, _("menu functions can only be used in the GUI"));    mname = CAR(args);    if (!isString(mname) || length(mname) != 1)	error(_("invalid '%s' argument"), "menuname");    items = wingetmenuitems(translateChar(STRING_ELT(mname,0)), errmsg);    if (items->numItems == 0) {	sprintf(msgbuf, _("unable to retrieve items for %s (%s)"),		translateChar(STRING_ELT(mname,0)), errmsg);	freemenuitems(items);	errorcall(call, msgbuf);    }    PROTECT(ans = allocVector(STRSXP, items->numItems));    PROTECT(ansnames = allocVector(STRSXP, items->numItems));    for (i = 0; i < items->numItems; i++) {	SET_STRING_ELT(ans, i, mkChar(items->mItems[i]->action));	SET_STRING_ELT(ansnames, i, mkChar(items->mItems[i]->name));    }    setAttrib(ans, R_NamesSymbol, ansnames);    freemenuitems(items);    UNPROTECT(2);    return(ans);}

SEXP attribute_hidden do_tempfile(SEXP call, SEXP op, SEXP args, SEXP env){    SEXP  ans, pattern, fileext, tempdir;    const char *tn, *td, *te;    char *tm;    int i, n1, n2, n3, slen;    checkArity(op, args);    pattern = CAR(args); n1 = length(pattern); args = CDR(args);    tempdir = CAR(args); n2 = length(tempdir); args = CDR(args);    fileext = CAR(args); n3 = length(fileext);    if (!isString(pattern))	error(_("invalid filename pattern"));    if (!isString(tempdir))	error(_("invalid '%s' value"), "tempdir");    if (!isString(fileext))	error(_("invalid file extension"));    if (n1 < 1)	error(_("no 'pattern'"));    if (n2 < 1)	error(_("no 'tempdir'"));    if (n3 < 1)        error(_("no 'fileext'"));    slen = (n1 > n2) ? n1 : n2;    slen = (n3 > slen) ? n3 : slen;    PROTECT(ans = allocVector(STRSXP, slen));    for(i = 0; i < slen; i++) {	tn = translateChar( STRING_ELT( pattern , i%n1 ) );	td = translateChar( STRING_ELT( tempdir , i%n2 ) );	te = translateChar( STRING_ELT( fileext , i%n3 ) );	/* try to get a new file name */	tm = R_tmpnam2(tn, td, te);	SET_STRING_ELT(ans, i, mkChar(tm));	if(tm) free(tm);    }    UNPROTECT(1);    return (ans);}

SEXP attribute_hidden do_setenv(SEXP call, SEXP op, SEXP args, SEXP env){#if defined(HAVE_PUTENV) || defined(HAVE_SETENV)    int i, n;    SEXP ans, nm, vars;    checkArity(op, args);    if (!isString(nm = CAR(args)))	error(_("wrong type for argument"));    if (!isString(vars = CADR(args)))	error(_("wrong type for argument"));    if(LENGTH(nm) != LENGTH(vars))	error(_("wrong length for argument"));    n = LENGTH(vars);    PROTECT(ans = allocVector(LGLSXP, n));#ifdef HAVE_SETENV    for (i = 0; i < n; i++)	LOGICAL(ans)[i] = setenv(translateChar(STRING_ELT(nm, i)),				 translateChar(STRING_ELT(vars, i)),				 1) == 0;#elif defined(Win32)    for (i = 0; i < n; i++)	LOGICAL(ans)[i] = Rwputenv(wtransChar(STRING_ELT(nm, i)),				   wtransChar(STRING_ELT(vars, i))) == 0;#else    for (i = 0; i < n; i++)	LOGICAL(ans)[i] = Rputenv(translateChar(STRING_ELT(nm, i)),				  translateChar(STRING_ELT(vars, i))) == 0;#endif    UNPROTECT(1);    return ans;#else    error(_("'Sys.setenv' is not available on this system"));    return R_NilValue; /* -Wall */#endif}

SEXP attribute_hidden do_retracemem(SEXP call, SEXP op, SEXP args, SEXP rho){#ifdef R_MEMORY_PROFILING    SEXP object, previous, ans, argList;    char buffer[21];    static SEXP do_retracemem_formals = NULL;    if (do_retracemem_formals == NULL)        do_retracemem_formals = allocFormalsList2(install("x"),						  R_PreviousSymbol);    PROTECT(argList =  matchArgs(do_retracemem_formals, args, call));    if(CAR(argList) == R_MissingArg) SETCAR(argList, R_NilValue);    if(CADR(argList) == R_MissingArg) SETCAR(CDR(argList), R_NilValue);    object = CAR(argList);    if (TYPEOF(object) == CLOSXP ||	TYPEOF(object) == BUILTINSXP ||	TYPEOF(object) == SPECIALSXP)	errorcall(call, _("argument must not be a function"));    previous = CADR(argList);    if(!isNull(previous) && !isString(previous))	    errorcall(call, _("invalid '%s' argument"), "previous");    if (RTRACE(object)) {	snprintf(buffer, 21, "<%p>", (void *) object);	ans = mkString(buffer);    } else {	R_Visible = 0;	ans = R_NilValue;    }    if (previous != R_NilValue){	SET_RTRACE(object, 1);	if (R_current_trace_state()) {	    /* FIXME: previous will have <0x....> whereas other values are	       without the < > */	    Rprintf("tracemem[%s -> %p]: ",		    translateChar(STRING_ELT(previous, 0)), (void *) object);	    memtrace_stack_dump();	}    }    UNPROTECT(1);    return ans;#else    R_Visible = 0; /* for consistency with other case */    return R_NilValue;#endif}

SEXP dotTcl(SEXP args){    SEXP ans;    const char *cmd;    Tcl_Obj *val;    const void *vmax = vmaxget();    if(!isValidString(CADR(args)))	error(_("invalid argument"));    cmd = translateChar(STRING_ELT(CADR(args), 0));    val = tk_eval(cmd);    ans = makeRTclObject(val);    vmaxset(vmax);    return ans;}

SEXP Rsockwrite(SEXP ssock, SEXP sstring){    if (length(ssock) != 1) error("invalid 'socket' argument");    int sock = asInteger(ssock), start = 0, end, len;    char *buf = const_cast<char *>( translateChar(STRING_ELT(sstring, 0))), *abuf[1];    end = len = int( strlen(buf));    abuf[0] = buf;    if(!initialized) internet_Init();    if(initialized > 0)	(*ptr->sockwrite)(&sock, abuf, &start, &end, &len);    else	error(_("socket routines cannot be loaded"));    return ScalarInteger(len);}

/* Are these are always native charset? */Rboolean pmatch(SEXP formal, SEXP tag, Rboolean exact){    const char *f, *t;    const void *vmax = vmaxget();    switch (TYPEOF(formal)) {    case SYMSXP:	f = CHAR(PRINTNAME(formal));	break;    case CHARSXP:	f = CHAR(formal);	break;    case STRSXP:	f = translateChar(STRING_ELT(formal, 0));	break;    default:	goto fail;    }    switch(TYPEOF(tag)) {    case SYMSXP:	t = CHAR(PRINTNAME(tag));	break;    case CHARSXP:	t = CHAR(tag);	break;    case STRSXP:	t = translateChar(STRING_ELT(tag, 0));	break;    default:	goto fail;    }    Rboolean res = psmatch(f, t, exact);    vmaxset(vmax);    return res; fail:    error(_("invalid partial string match"));    return FALSE;/* for -Wall */}

/* utils::shortPathName */SEXP in_shortpath(SEXP paths){    SEXP ans, el;    int i, n = LENGTH(paths);    char tmp[MAX_PATH];    wchar_t wtmp[32768];    DWORD res;    const void *vmax = vmaxget();    if(!isString(paths)) error(_("'path' must be a character vector"));    PROTECT(ans = allocVector(STRSXP, n));    for (i = 0; i < n; i++) {	el = STRING_ELT(paths, i);	if(getCharCE(el) == CE_UTF8) {	    res = GetShortPathNameW(filenameToWchar(el, FALSE), wtmp, 32768);	    if (res && res <= 32768)		wcstoutf8(tmp, wtmp, wcslen(wtmp)+1);	    else		strcpy(tmp, translateChar(el));	    /* documented to return paths using /, which the API call does	       not necessarily do */	    R_fixbackslash(tmp);	    SET_STRING_ELT(ans, i, mkCharCE(tmp, CE_UTF8));	} else {	    res = GetShortPathName(translateChar(el), tmp, MAX_PATH);	    if (res == 0 || res > MAX_PATH) strcpy(tmp, translateChar(el));	    /* documented to return paths using /, which the API call does	       not necessarily do */	    R_fixbackslash(tmp);	    SET_STRING_ELT(ans, i, mkChar(tmp));	}    }    UNPROTECT(1);    vmaxset(vmax);    return ans;}

// formerly in src/main/platform.cSEXP fileedit(SEXP call, SEXP op, SEXP args, SEXP rho){    SEXP fn, ti, ed;    const char **f, **title, *editor;    int i, n;    const void *vmax = vmaxget();    args = CDR(args);    fn = CAR(args); args = CDR(args);    ti = CAR(args); args = CDR(args);    ed = CAR(args);    n = length(fn);    if (!isString(ed) || length(ed) != 1)	error(_("invalid '%s' specification"), "editor");    if (n > 0) {	if (!isString(fn))	    error(_("invalid '%s' specification"), "filename");	f = (const char**) R_alloc(n, sizeof(char*));	title = (const char**) R_alloc(n, sizeof(char*));	/* FIXME convert to UTF-8 on Windows */	for (i = 0; i < n; i++) {	    SEXP el = STRING_ELT(fn, 0);	    if (!isNull(el))#ifdef Win32		f[i] = acopy_string(reEnc(CHAR(el), getCharCE(el), CE_UTF8, 1));#else		f[i] = acopy_string(translateChar(el));#endif	    else		f[i] = "";	    if (!isNull(STRING_ELT(ti, i)))		title[i] = acopy_string(translateChar(STRING_ELT(ti, i)));	    else		title[i] = "";	}    }

int attribute_hidden R_TextBufferInit(TextBuffer *txtb, SEXP text){    int i, k, l, n;    if (isString(text)) {	// translateChar might allocate	void *vmax = vmaxget();	n = length(text);	l = 0;	for (i = 0; i < n; i++) {	    if (STRING_ELT(text, i) != R_NilValue) {		k = int( strlen(translateChar(STRING_ELT(text, i))));		if (k > l)		    l = k;	    }	}	vmaxset(vmax);	txtb->vmax = vmax;	txtb->buf = static_cast<unsigned char *>(RHO_alloc(l+2, sizeof(char))); /* '/n' and '/0' */	txtb->bufp = txtb->buf;	txtb->text = text;	txtb->ntext = n;	txtb->offset = 0;	transferChars(txtb->buf,		      translateChar(STRING_ELT(txtb->text, txtb->offset)));	txtb->offset++;	return 1;    }    else {	txtb->vmax = vmaxget();	txtb->buf = nullptr;	txtb->bufp = nullptr;	txtb->text = R_NilValue;	txtb->ntext = 0;	txtb->offset = 1;	return 0;    }}

static void memtrace_stack_dump(void){    RCNTXT *cptr;    for (cptr = R_GlobalContext; cptr; cptr = cptr->nextcontext) {	if ((cptr->callflag & (CTXT_FUNCTION | CTXT_BUILTIN))	    && TYPEOF(cptr->call) == LANGSXP) {	    SEXP fun = CAR(cptr->call);	    Rprintf("%s ",		    TYPEOF(fun) == SYMSXP ? translateChar(PRINTNAME(fun)) :		    "<Anonymous>");	}    }    Rprintf("/n");}