#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr, int mode));
static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_FSStatProc *statProc,
Tcl_StatBuf *statPtr));
static char * GetTypeFromMode _ANSI_ARGS_((int mode));
static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
char *varName, Tcl_StatBuf *statPtr));
int
Tcl_BreakObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TCL_BREAK;
}
int
Tcl_CaseObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
register int i;
int body, result, caseObjc;
char *string, *arg;
Tcl_Obj *CONST *caseObjv;
Tcl_Obj *armPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
"string ?in? patList body ... ?default body?");
return TCL_ERROR;
}
string = Tcl_GetString(objv[1]);
body = -1;
arg = Tcl_GetString(objv[2]);
if (strcmp(arg, "in") == 0) {
i = 3;
} else {
i = 2;
}
caseObjc = objc - i;
caseObjv = objv + i;
if (caseObjc == 1) {
Tcl_Obj **newObjv;
Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
caseObjv = newObjv;
}
for (i = 0; i < caseObjc; i += 2) {
int patObjc, j;
CONST char **patObjv;
char *pat;
unsigned char *p;
if (i == (caseObjc - 1)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"extra case pattern with no body", -1);
return TCL_ERROR;
}
pat = Tcl_GetString(caseObjv[i]);
for (p = (unsigned char *) pat; *p != '\0'; p++) {
if (isspace(*p) || (*p == '\\')) {
break;
}
}
if (*p == '\0') {
if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
body = i + 1;
}
if (Tcl_StringMatch(string, pat)) {
body = i + 1;
goto match;
}
continue;
}
result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
if (result != TCL_OK) {
return result;
}
for (j = 0; j < patObjc; j++) {
if (Tcl_StringMatch(string, patObjv[j])) {
body = i + 1;
break;
}
}
ckfree((char *) patObjv);
if (j < patObjc) {
break;
}
}
match:
if (body != -1) {
armPtr = caseObjv[body - 1];
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
char msg[100 + TCL_INTEGER_SPACE];
arg = Tcl_GetString(armPtr);
sprintf(msg,
"\n (\"%.50s\" arm line %d)", arg,
interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
}
return result;
}
return TCL_OK;
}
int
Tcl_CatchObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *varNamePtr = NULL;
int result;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
return TCL_ERROR;
}
if (objc == 3) {
varNamePtr = objv[2];
}
result = Tcl_EvalObjEx(interp, objv[1], 0);
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
Tcl_GetObjResult(interp), 0) == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"couldn't save command result in variable", -1);
return TCL_ERROR;
}
}
Tcl_ResetResult(interp);
Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
return TCL_OK;
}
int
Tcl_CdObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *dir;
int result;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?dirName?");
return TCL_ERROR;
}
if (objc == 2) {
dir = objv[1];
} else {
dir = Tcl_NewStringObj("~",1);
Tcl_IncrRefCount(dir);
}
if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
result = TCL_ERROR;
} else {
result = Tcl_FSChdir(dir);
if (result != TCL_OK) {
Tcl_AppendResult(interp, "couldn't change working directory to \"",
Tcl_GetString(dir), "\": ", Tcl_PosixError(interp), (char *) NULL);
result = TCL_ERROR;
}
}
if (objc != 2) {
Tcl_DecrRefCount(dir);
}
return result;
}
int
Tcl_ConcatObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
if (objc >= 2) {
Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
}
return TCL_OK;
}
int
Tcl_ContinueObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TCL_CONTINUE;
}
int
Tcl_EncodingObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int index, length;
Tcl_Encoding encoding;
char *string;
Tcl_DString ds;
Tcl_Obj *resultPtr;
static CONST char *optionStrings[] = {
"convertfrom", "convertto", "names", "system",
NULL
};
enum options {
ENC_CONVERTFROM, ENC_CONVERTTO, ENC_NAMES, ENC_SYSTEM
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case ENC_CONVERTTO:
case ENC_CONVERTFROM: {
char *name;
Tcl_Obj *data;
if (objc == 3) {
name = NULL;
data = objv[2];
} else if (objc == 4) {
name = Tcl_GetString(objv[2]);
data = objv[3];
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
return TCL_ERROR;
}
encoding = Tcl_GetEncoding(interp, name);
if (!encoding) {
return TCL_ERROR;
}
if ((enum options) index == ENC_CONVERTFROM) {
string = (char *) Tcl_GetByteArrayFromObj(data, &length);
Tcl_ExternalToUtfDString(encoding, string, length, &ds);
Tcl_SetStringObj(Tcl_GetObjResult(interp),
Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
} else {
string = Tcl_GetStringFromObj(data, &length);
Tcl_UtfToExternalDString(encoding, string, length, &ds);
resultPtr = Tcl_GetObjResult(interp);
Tcl_SetByteArrayObj(resultPtr,
(unsigned char *) Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
}
Tcl_FreeEncoding(encoding);
break;
}
case ENC_NAMES: {
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_GetEncodingNames(interp);
break;
}
case ENC_SYSTEM: {
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
return TCL_ERROR;
}
if (objc == 2) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
Tcl_GetEncodingName(NULL), -1);
} else {
return Tcl_SetSystemEncoding(interp,
Tcl_GetStringFromObj(objv[2], NULL));
}
break;
}
}
return TCL_OK;
}
int
Tcl_ErrorObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Interp *iPtr = (Interp *) interp;
char *info;
int infoLen;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
return TCL_ERROR;
}
if (objc >= 3) {
info = Tcl_GetStringFromObj(objv[2], &infoLen);
if (*info != 0) {
Tcl_AddObjErrorInfo(interp, info, infoLen);
iPtr->flags |= ERR_ALREADY_LOGGED;
}
}
if (objc == 4) {
Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
iPtr->flags |= ERROR_CODE_SET;
}
Tcl_SetObjResult(interp, objv[1]);
return TCL_ERROR;
}
int
Tcl_EvalObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int result;
register Tcl_Obj *objPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
return TCL_ERROR;
}
if (objc == 2) {
result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
} else {
objPtr = Tcl_ConcatObj(objc-1, objv+1);
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
char msg[32 + TCL_INTEGER_SPACE];
sprintf(msg, "\n (\"eval\" body line %d)", interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
}
return result;
}
int
Tcl_ExitObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int value;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
return TCL_ERROR;
}
if (objc == 1) {
value = 0;
} else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
return TCL_ERROR;
}
Tcl_Exit(value);
return TCL_OK;
}
int
Tcl_ExprObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
register Tcl_Obj *objPtr;
Tcl_Obj *resultPtr;
register char *bytes;
int length, i, result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
return TCL_ERROR;
}
if (objc == 2) {
result = Tcl_ExprObj(interp, objv[1], &resultPtr);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
Tcl_DecrRefCount(resultPtr);
}
return result;
}
bytes = Tcl_GetStringFromObj(objv[1], &length);
objPtr = Tcl_NewStringObj(bytes, length);
Tcl_IncrRefCount(objPtr);
for (i = 2; i < objc; i++) {
Tcl_AppendToObj(objPtr, " ", 1);
bytes = Tcl_GetStringFromObj(objv[i], &length);
Tcl_AppendToObj(objPtr, bytes, length);
}
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
Tcl_DecrRefCount(resultPtr);
}
Tcl_DecrRefCount(objPtr);
return result;
}
int
Tcl_FileObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int index;
static CONST char *fileOptions[] = {
"atime", "attributes", "channels", "copy",
"delete",
"dirname", "executable", "exists", "extension",
"isdirectory", "isfile", "join", "link",
"lstat", "mtime", "mkdir", "nativename",
"normalize", "owned",
"pathtype", "readable", "readlink", "rename",
"rootname", "separator", "size", "split",
"stat", "system",
"tail", "type", "volumes", "writable",
(char *) NULL
};
enum options {
FILE_ATIME, FILE_ATTRIBUTES, FILE_CHANNELS, FILE_COPY,
FILE_DELETE,
FILE_DIRNAME, FILE_EXECUTABLE, FILE_EXISTS, FILE_EXTENSION,
FILE_ISDIRECTORY, FILE_ISFILE, FILE_JOIN, FILE_LINK,
FILE_LSTAT, FILE_MTIME, FILE_MKDIR, FILE_NATIVENAME,
FILE_NORMALIZE, FILE_OWNED,
FILE_PATHTYPE, FILE_READABLE, FILE_READLINK, FILE_RENAME,
FILE_ROOTNAME, FILE_SEPARATOR, FILE_SIZE, FILE_SPLIT,
FILE_STAT, FILE_SYSTEM,
FILE_TAIL, FILE_TYPE, FILE_VOLUMES, FILE_WRITABLE
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case FILE_ATIME: {
Tcl_StatBuf buf;
struct utimbuf tval;
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 4) {
if (Tcl_GetLongFromObj(interp, objv[3],
(long*)(&buf.st_atime)) != TCL_OK) {
return TCL_ERROR;
}
tval.actime = buf.st_atime;
tval.modtime = buf.st_mtime;
if (Tcl_FSUtime(objv[2], &tval) != 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set access time for file \"",
Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
}
Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
return TCL_OK;
}
case FILE_ATTRIBUTES: {
return TclFileAttrsCmd(interp, objc, objv);
}
case FILE_CHANNELS: {
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
return TCL_ERROR;
}
return Tcl_GetChannelNamesEx(interp,
((objc == 2) ? NULL : Tcl_GetString(objv[2])));
}
case FILE_COPY: {
return TclFileCopyCmd(interp, objc, objv);
}
case FILE_DELETE: {
return TclFileDeleteCmd(interp, objc, objv);
}
case FILE_DIRNAME: {
Tcl_Obj *dirPtr;
if (objc != 3) {
goto only3Args;
}
dirPtr = TclFileDirname(interp, objv[2]);
if (dirPtr == NULL) {
return TCL_ERROR;
} else {
Tcl_SetObjResult(interp, dirPtr);
Tcl_DecrRefCount(dirPtr);
return TCL_OK;
}
}
case FILE_EXECUTABLE: {
if (objc != 3) {
goto only3Args;
}
return CheckAccess(interp, objv[2], X_OK);
}
case FILE_EXISTS: {
if (objc != 3) {
goto only3Args;
}
return CheckAccess(interp, objv[2], F_OK);
}
case FILE_EXTENSION: {
char *fileName, *extension;
if (objc != 3) {
goto only3Args;
}
fileName = Tcl_GetString(objv[2]);
extension = TclGetExtension(fileName);
if (extension != NULL) {
Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1);
}
return TCL_OK;
}
case FILE_ISDIRECTORY: {
int value;
Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
value = 0;
if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
value = S_ISDIR(buf.st_mode);
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_ISFILE: {
int value;
Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
value = 0;
if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
value = S_ISREG(buf.st_mode);
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_JOIN: {
Tcl_Obj *resObj;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
return TCL_ERROR;
}
resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
Tcl_SetObjResult(interp, resObj);
return TCL_OK;
}
case FILE_LINK: {
Tcl_Obj *contents;
int index;
if (objc < 3 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-linktype? linkname ?target?");
return TCL_ERROR;
}
if (objc == 5) {
index = 3;
} else {
index = 2;
}
if (objc > 3) {
int linkAction;
if (objc == 5) {
static CONST char *linkTypes[] = {
"-symbolic", "-hard", NULL
};
if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes,
"switch", 0, &linkAction) != TCL_OK) {
return TCL_ERROR;
}
if (linkAction == 0) {
linkAction = TCL_CREATE_SYMBOLIC_LINK;
} else {
linkAction = TCL_CREATE_HARD_LINK;
}
} else {
linkAction = TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK;
}
if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
return TCL_ERROR;
}
contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
if (contents == NULL) {
if (errno == EEXIST) {
Tcl_AppendResult(interp, "could not create new link \"",
Tcl_GetString(objv[index]),
"\": that path already exists", (char *) NULL);
} else if (errno == ENOENT) {
Tcl_AppendResult(interp, "could not create new link \"",
Tcl_GetString(objv[index]),
"\" since target \"",
Tcl_GetString(objv[index+1]),
"\" doesn't exist",
(char *) NULL);
} else {
Tcl_AppendResult(interp, "could not create new link \"",
Tcl_GetString(objv[index]), "\" pointing to \"",
Tcl_GetString(objv[index+1]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
return TCL_ERROR;
}
} else {
if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
return TCL_ERROR;
}
contents = Tcl_FSLink(objv[index], NULL, 0);
if (contents == NULL) {
Tcl_AppendResult(interp, "could not read link \"",
Tcl_GetString(objv[index]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, contents);
if (objc == 3) {
Tcl_DecrRefCount(contents);
}
return TCL_OK;
}
case FILE_LSTAT: {
char *varName;
Tcl_StatBuf buf;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "name varName");
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
return TCL_ERROR;
}
varName = Tcl_GetString(objv[3]);
return StoreStatData(interp, varName, &buf);
}
case FILE_MTIME: {
Tcl_StatBuf buf;
struct utimbuf tval;
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 4) {
if (Tcl_GetLongFromObj(interp, objv[3],
(long*)(&buf.st_mtime)) != TCL_OK) {
return TCL_ERROR;
}
tval.actime = buf.st_atime;
tval.modtime = buf.st_mtime;
if (Tcl_FSUtime(objv[2], &tval) != 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set modification time for file \"",
Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
}
Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime);
return TCL_OK;
}
case FILE_MKDIR: {
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
return TCL_ERROR;
}
return TclFileMakeDirsCmd(interp, objc, objv);
}
case FILE_NATIVENAME: {
CONST char *fileName;
Tcl_DString ds;
if (objc != 3) {
goto only3Args;
}
fileName = Tcl_GetString(objv[2]);
fileName = Tcl_TranslateFileName(interp, fileName, &ds);
if (fileName == NULL) {
return TCL_ERROR;
}
Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
return TCL_OK;
}
case FILE_NORMALIZE: {
Tcl_Obj *fileName;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "filename");
return TCL_ERROR;
}
fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
Tcl_SetObjResult(interp, fileName);
return TCL_OK;
}
case FILE_OWNED: {
int value;
Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
value = 0;
if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
#if (defined(__WIN32__) || defined(MAC_TCL))
value = 1;
#else
value = (geteuid() == buf.st_uid);
#endif
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_PATHTYPE: {
if (objc != 3) {
goto only3Args;
}
switch (Tcl_FSGetPathType(objv[2])) {
case TCL_PATH_ABSOLUTE:
Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1);
break;
case TCL_PATH_RELATIVE:
Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1);
break;
case TCL_PATH_VOLUME_RELATIVE:
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"volumerelative", -1);
break;
}
return TCL_OK;
}
case FILE_READABLE: {
if (objc != 3) {
goto only3Args;
}
return CheckAccess(interp, objv[2], R_OK);
}
case FILE_READLINK: {
Tcl_Obj *contents;
if (objc != 3) {
goto only3Args;
}
if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
return TCL_ERROR;
}
contents = Tcl_FSLink(objv[2], NULL, 0);
if (contents == NULL) {
Tcl_AppendResult(interp, "could not readlink \"",
Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, contents);
Tcl_DecrRefCount(contents);
return TCL_OK;
}
case FILE_RENAME: {
return TclFileRenameCmd(interp, objc, objv);
}
case FILE_ROOTNAME: {
int length;
char *fileName, *extension;
if (objc != 3) {
goto only3Args;
}
fileName = Tcl_GetStringFromObj(objv[2], &length);
extension = TclGetExtension(fileName);
if (extension == NULL) {
Tcl_SetObjResult(interp, objv[2]);
} else {
Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
(int) (length - strlen(extension)));
}
return TCL_OK;
}
case FILE_SEPARATOR: {
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 2, objv, "?name?");
return TCL_ERROR;
}
if (objc == 2) {
char *separator = NULL;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separator = "/";
break;
case TCL_PLATFORM_WINDOWS:
separator = "\\";
break;
case TCL_PLATFORM_MAC:
separator = ":";
break;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(separator,1));
} else {
Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
if (separatorObj != NULL) {
Tcl_SetObjResult(interp, separatorObj);
} else {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Unrecognised path",-1));
return TCL_ERROR;
}
}
return TCL_OK;
}
case FILE_SIZE: {
Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp),
(Tcl_WideInt) buf.st_size);
return TCL_OK;
}
case FILE_SPLIT: {
if (objc != 3) {
goto only3Args;
}
Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL));
return TCL_OK;
}
case FILE_STAT: {
char *varName;
Tcl_StatBuf buf;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
varName = Tcl_GetString(objv[3]);
return StoreStatData(interp, varName, &buf);
}
case FILE_SYSTEM: {
Tcl_Obj* fsInfo;
if (objc != 3) {
goto only3Args;
}
fsInfo = Tcl_FSFileSystemInfo(objv[2]);
if (fsInfo != NULL) {
Tcl_SetObjResult(interp, fsInfo);
return TCL_OK;
} else {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Unrecognised path",-1));
return TCL_ERROR;
}
}
case FILE_TAIL: {
int splitElements;
Tcl_Obj *splitPtr;
if (objc != 3) {
goto only3Args;
}
splitPtr = Tcl_FSSplitPath(objv[2], &splitElements);
if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) {
Tcl_DecrRefCount(splitPtr);
splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]);
if (splitPtr == NULL) {
return TCL_ERROR;
}
splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
}
if (splitElements > 0) {
if ((splitElements > 1)
|| (Tcl_FSGetPathType(objv[2]) == TCL_PATH_RELATIVE)) {
Tcl_Obj *tail = NULL;
Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail);
Tcl_SetObjResult(interp, tail);
}
}
Tcl_DecrRefCount(splitPtr);
return TCL_OK;
}
case FILE_TYPE: {
Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetStringObj(Tcl_GetObjResult(interp),
GetTypeFromMode((unsigned short) buf.st_mode), -1);
return TCL_OK;
}
case FILE_VOLUMES: {
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_FSListVolumes());
return TCL_OK;
}
case FILE_WRITABLE: {
if (objc != 3) {
goto only3Args;
}
return CheckAccess(interp, objv[2], W_OK);
}
}
only3Args:
Tcl_WrongNumArgs(interp, 2, objv, "name");
return TCL_ERROR;
}
static int
CheckAccess(interp, objPtr, mode)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
int mode;
{
int value;
if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
value = 0;
} else {
value = (Tcl_FSAccess(objPtr, mode) == 0);
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
static int
GetStatBuf(interp, objPtr, statProc, statPtr)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
Tcl_FSStatProc *statProc;
Tcl_StatBuf *statPtr;
{
int status;
if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
return TCL_ERROR;
}
status = (*statProc)(objPtr, statPtr);
if (status < 0) {
if (interp != NULL) {
Tcl_AppendResult(interp, "could not read \"",
Tcl_GetString(objPtr), "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
return TCL_ERROR;
}
return TCL_OK;
}
static int
StoreStatData(interp, varName, statPtr)
Tcl_Interp *interp;
char *varName;
Tcl_StatBuf *statPtr;
{
Tcl_Obj *var = Tcl_NewStringObj(varName, -1);
Tcl_Obj *field = Tcl_NewObj();
Tcl_Obj *value;
register unsigned short mode;
#define STORE_ARY(fieldName, object) \
Tcl_SetStringObj(field, (fieldName), -1); \
value = (object); \
if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \
Tcl_DecrRefCount(var); \
Tcl_DecrRefCount(field); \
Tcl_DecrRefCount(value); \
return TCL_ERROR; \
}
Tcl_IncrRefCount(var);
Tcl_IncrRefCount(field);
STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev));
STORE_ARY("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
STORE_ARY("nlink", Tcl_NewLongObj((long)statPtr->st_nlink));
STORE_ARY("uid", Tcl_NewLongObj((long)statPtr->st_uid));
STORE_ARY("gid", Tcl_NewLongObj((long)statPtr->st_gid));
STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_ST_BLOCKS
STORE_ARY("blocks",Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
mode = (unsigned short) statPtr->st_mode;
STORE_ARY("mode", Tcl_NewIntObj(mode));
STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY
Tcl_DecrRefCount(var);
Tcl_DecrRefCount(field);
return TCL_OK;
}
static char *
GetTypeFromMode(mode)
int mode;
{
if (S_ISREG(mode)) {
return "file";
} else if (S_ISDIR(mode)) {
return "directory";
} else if (S_ISCHR(mode)) {
return "characterSpecial";
} else if (S_ISBLK(mode)) {
return "blockSpecial";
} else if (S_ISFIFO(mode)) {
return "fifo";
#ifdef S_ISLNK
} else if (S_ISLNK(mode)) {
return "link";
#endif
#ifdef S_ISSOCK
} else if (S_ISSOCK(mode)) {
return "socket";
#endif
}
return "unknown";
}
int
Tcl_ForObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int result, value;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
return TCL_ERROR;
}
result = Tcl_EvalObjEx(interp, objv[1], 0);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)");
}
return result;
}
while (1) {
Tcl_ResetResult(interp);
result = Tcl_ExprBooleanObj(interp, objv[2], &value);
if (result != TCL_OK) {
return result;
}
if (!value) {
break;
}
result = Tcl_EvalObjEx(interp, objv[4], 0);
if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
if (result == TCL_ERROR) {
char msg[32 + TCL_INTEGER_SPACE];
sprintf(msg, "\n (\"for\" body line %d)",interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
}
break;
}
result = Tcl_EvalObjEx(interp, objv[3], 0);
if (result == TCL_BREAK) {
break;
} else if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)");
}
return result;
}
}
if (result == TCL_BREAK) {
result = TCL_OK;
}
if (result == TCL_OK) {
Tcl_ResetResult(interp);
}
return result;
}
int
Tcl_ForeachObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int result = TCL_OK;
int i;
int j, maxj;
int v;
int numLists;
Tcl_Obj *bodyPtr;
#define NUM_ARGS 9
Tcl_Obj *(argObjStorage[NUM_ARGS]);
Tcl_Obj **argObjv = argObjStorage;
#define STATIC_LIST_SIZE 4
int indexArray[STATIC_LIST_SIZE];
int varcListArray[STATIC_LIST_SIZE];
Tcl_Obj **varvListArray[STATIC_LIST_SIZE];
int argcListArray[STATIC_LIST_SIZE];
Tcl_Obj **argvListArray[STATIC_LIST_SIZE];
int *index = indexArray;
int *varcList = varcListArray;
Tcl_Obj ***varvList = varvListArray;
int *argcList = argcListArray;
Tcl_Obj ***argvList = argvListArray;
if (objc < 4 || (objc%2 != 0)) {
Tcl_WrongNumArgs(interp, 1, objv,
"varList list ?varList list ...? command");
return TCL_ERROR;
}
if (objc > NUM_ARGS) {
argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
}
for (i = 0; i < objc; i++) {
argObjv[i] = objv[i];
}
numLists = (objc-2)/2;
if (numLists > STATIC_LIST_SIZE) {
index = (int *) ckalloc(numLists * sizeof(int));
varcList = (int *) ckalloc(numLists * sizeof(int));
varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
argcList = (int *) ckalloc(numLists * sizeof(int));
argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
}
for (i = 0; i < numLists; i++) {
index[i] = 0;
varcList[i] = 0;
varvList[i] = (Tcl_Obj **) NULL;
argcList[i] = 0;
argvList[i] = (Tcl_Obj **) NULL;
}
maxj = 0;
for (i = 0; i < numLists; i++) {
result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
&varcList[i], &varvList[i]);
if (result != TCL_OK) {
goto done;
}
if (varcList[i] < 1) {
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"foreach varlist is empty", -1);
result = TCL_ERROR;
goto done;
}
result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
&argcList[i], &argvList[i]);
if (result != TCL_OK) {
goto done;
}
j = argcList[i] / varcList[i];
if ((argcList[i] % varcList[i]) != 0) {
j++;
}
if (j > maxj) {
maxj = j;
}
}
bodyPtr = argObjv[objc-1];
for (j = 0; j < maxj; j++) {
for (i = 0; i < numLists; i++) {
result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
&varcList[i], &varvList[i]);
if (result != TCL_OK) {
panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
}
result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
&argcList[i], &argvList[i]);
if (result != TCL_OK) {
panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
}
for (v = 0; v < varcList[i]; v++) {
int k = index[i]++;
Tcl_Obj *valuePtr, *varValuePtr;
int isEmptyObj = 0;
if (k < argcList[i]) {
valuePtr = argvList[i][k];
} else {
valuePtr = Tcl_NewObj();
isEmptyObj = 1;
}
varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
NULL, valuePtr, 0);
if (varValuePtr == NULL) {
if (isEmptyObj) {
Tcl_DecrRefCount(valuePtr);
}
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't set loop variable: \"",
Tcl_GetString(varvList[i][v]), "\"", (char *) NULL);
result = TCL_ERROR;
goto done;
}
}
}
result = Tcl_EvalObjEx(interp, bodyPtr, 0);
if (result != TCL_OK) {
if (result == TCL_CONTINUE) {
result = TCL_OK;
} else if (result == TCL_BREAK) {
result = TCL_OK;
break;
} else if (result == TCL_ERROR) {
char msg[32 + TCL_INTEGER_SPACE];
sprintf(msg, "\n (\"foreach\" body line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
break;
} else {
break;
}
}
}
if (result == TCL_OK) {
Tcl_ResetResult(interp);
}
done:
if (numLists > STATIC_LIST_SIZE) {
ckfree((char *) index);
ckfree((char *) varcList);
ckfree((char *) argcList);
ckfree((char *) varvList);
ckfree((char *) argvList);
}
if (argObjv != argObjStorage) {
ckfree((char *) argObjv);
}
return result;
#undef STATIC_LIST_SIZE
#undef NUM_ARGS
}
int
Tcl_FormatObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
char *format;
int formatLen;
char *endPtr;
char newFormat[43];
int width;
int precision;
int size;
long intValue;
char *ptrValue = NULL;
double doubleValue;
#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt wideValue;
#endif
int whichValue;
# define INT_VALUE 0
# define CHAR_VALUE 1
# define PTR_VALUE 2
# define DOUBLE_VALUE 3
# define STRING_VALUE 4
# define WIDE_VALUE 5
# define MAX_FLOAT_SIZE 320
Tcl_Obj *resultPtr;
char staticBuf[MAX_FLOAT_SIZE + 1];
char *dst = staticBuf;
int dstSize = MAX_FLOAT_SIZE;
int noPercent;
int objIndex;
int gotXpg = 0;
int gotSequential = 0;
int useShort;
char *end;
int stringLen = 0;
int gotMinus;
int gotPrecision;
int gotZero;
#ifndef TCL_WIDE_INT_IS_LONG
int useWide;
#endif
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
return TCL_ERROR;
}
format = Tcl_GetStringFromObj(objv[1], &formatLen);
endPtr = format + formatLen;
resultPtr = Tcl_NewObj();
objIndex = 2;
while (format < endPtr) {
register char *newPtr = newFormat;
width = precision = noPercent = useShort = 0;
gotZero = gotMinus = gotPrecision = 0;
#ifndef TCL_WIDE_INT_IS_LONG
useWide = 0;
#endif
whichValue = PTR_VALUE;
if (*format != '%') {
ptrValue = format;
while ((*format != '%') && (format < endPtr)) {
format++;
}
size = format - ptrValue;
noPercent = 1;
goto doField;
}
if (format[1] == '%') {
ptrValue = format;
size = 1;
noPercent = 1;
format += 2;
goto doField;
}
*newPtr = '%';
newPtr++;
format++;
if (isdigit(UCHAR(*format))) {
int tmp;
tmp = strtoul(format, &end, 10);
if (*end != '$') {
goto notXpg;
}
format = end+1;
gotXpg = 1;
if (gotSequential) {
goto mixedXPG;
}
objIndex = tmp+1;
if ((objIndex < 2) || (objIndex >= objc)) {
goto badIndex;
}
goto xpgCheckDone;
}
notXpg:
gotSequential = 1;
if (gotXpg) {
goto mixedXPG;
}
xpgCheckDone:
while ((*format == '-') || (*format == '#') || (*format == '0')
|| (*format == ' ') || (*format == '+')) {
if (*format == '-') {
gotMinus = 1;
}
if (*format == '0') {
gotZero = 1;
}
*newPtr = *format;
newPtr++;
format++;
}
if (isdigit(UCHAR(*format))) {
width = strtoul(format, &end, 10);
format = end;
} else if (*format == '*') {
if (objIndex >= objc) {
goto badIndex;
}
if (Tcl_GetIntFromObj(interp,
objv[objIndex], &width) != TCL_OK) {
goto fmtError;
}
if (width < 0) {
width = -width;
*newPtr = '-';
gotMinus = 1;
newPtr++;
}
objIndex++;
format++;
}
if (width > 100000) {
width = 100000;
} else if (width < 0) {
width = 0;
}
if (width != 0) {
TclFormatInt(newPtr, width);
while (*newPtr != 0) {
newPtr++;
}
}
if (*format == '.') {
*newPtr = '.';
newPtr++;
format++;
gotPrecision = 1;
}
if (isdigit(UCHAR(*format))) {
precision = strtoul(format, &end, 10);
format = end;
} else if (*format == '*') {
if (objIndex >= objc) {
goto badIndex;
}
if (Tcl_GetIntFromObj(interp,
objv[objIndex], &precision) != TCL_OK) {
goto fmtError;
}
objIndex++;
format++;
}
if (gotPrecision) {
TclFormatInt(newPtr, precision);
while (*newPtr != 0) {
newPtr++;
}
}
if (*format == 'l') {
#ifndef TCL_WIDE_INT_IS_LONG
useWide = 1;
strcpy(newPtr, TCL_LL_MODIFIER);
newPtr += TCL_LL_MODIFIER_SIZE;
#endif
format++;
} else if (*format == 'h') {
useShort = 1;
*newPtr = 'h';
newPtr++;
format++;
}
*newPtr = *format;
newPtr++;
*newPtr = 0;
if (objIndex >= objc) {
goto badIndex;
}
switch (*format) {
case 'i':
newPtr[-1] = 'd';
case 'd':
case 'o':
case 'u':
case 'x':
case 'X':
#ifndef TCL_WIDE_INT_IS_LONG
if (useWide) {
if (Tcl_GetWideIntFromObj(interp,
objv[objIndex], &wideValue) != TCL_OK) {
goto fmtError;
}
whichValue = WIDE_VALUE;
size = 40 + precision;
break;
}
#endif
if (Tcl_GetLongFromObj(interp,
objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
#if (LONG_MAX > INT_MAX)
newPtr++;
*newPtr = 0;
newPtr[-1] = newPtr[-2];
newPtr[-2] = 'l';
#endif
whichValue = INT_VALUE;
size = 40 + precision;
break;
case 's':
whichValue = STRING_VALUE;
ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
stringLen = Tcl_NumUtfChars(ptrValue, size);
if (gotPrecision && (precision < stringLen)) {
stringLen = precision;
}
size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
if (width > stringLen) {
size += (width - stringLen);
}
break;
case 'c':
if (Tcl_GetLongFromObj(interp,
objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
whichValue = CHAR_VALUE;
size = width + TCL_UTF_MAX;
break;
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
if (Tcl_GetDoubleFromObj(interp,
objv[objIndex], &doubleValue) != TCL_OK) {
goto fmtError;
}
whichValue = DOUBLE_VALUE;
size = MAX_FLOAT_SIZE;
if (precision > 10) {
size += precision;
}
break;
case 0:
Tcl_SetResult(interp,
"format string ended in middle of field specifier",
TCL_STATIC);
goto fmtError;
default: {
char buf[40];
sprintf(buf, "bad field specifier \"%c\"", *format);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
goto fmtError;
}
}
objIndex++;
format++;
doField:
if (width > size) {
size = width;
}
if (noPercent) {
Tcl_AppendToObj(resultPtr, ptrValue, size);
} else {
if (size > dstSize) {
if (dst != staticBuf) {
ckfree(dst);
}
dst = (char *) ckalloc((unsigned) (size + 1));
dstSize = size;
}
switch (whichValue) {
case DOUBLE_VALUE: {
sprintf(dst, newFormat, doubleValue);
break;
}
#ifndef TCL_WIDE_INT_IS_LONG
case WIDE_VALUE: {
sprintf(dst, newFormat, wideValue);
break;
}
#endif
case INT_VALUE: {
if (useShort) {
sprintf(dst, newFormat, (short) intValue);
} else {
sprintf(dst, newFormat, intValue);
}
break;
}
case CHAR_VALUE: {
char *ptr;
char padChar = (gotZero ? '0' : ' ');
ptr = dst;
if (!gotMinus) {
for ( ; --width > 0; ptr++) {
*ptr = padChar;
}
}
ptr += Tcl_UniCharToUtf(intValue, ptr);
for ( ; --width > 0; ptr++) {
*ptr = padChar;
}
*ptr = '\0';
break;
}
case STRING_VALUE: {
char *ptr;
char padChar = (gotZero ? '0' : ' ');
int pad;
ptr = dst;
if (width > stringLen) {
pad = width - stringLen;
} else {
pad = 0;
}
if (!gotMinus) {
while (pad > 0) {
*ptr++ = padChar;
pad--;
}
}
size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
if (size) {
memcpy(ptr, ptrValue, (size_t) size);
ptr += size;
}
while (pad > 0) {
*ptr++ = padChar;
pad--;
}
*ptr = '\0';
break;
}
default: {
sprintf(dst, newFormat, ptrValue);
break;
}
}
Tcl_AppendToObj(resultPtr, dst, -1);
}
}
Tcl_SetObjResult(interp, resultPtr);
if(dst != staticBuf) {
ckfree(dst);
}
return TCL_OK;
mixedXPG:
Tcl_SetResult(interp,
"cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
goto fmtError;
badIndex:
if (gotXpg) {
Tcl_SetResult(interp,
"\"%n$\" argument index out of range", TCL_STATIC);
} else {
Tcl_SetResult(interp,
"not enough arguments for all format specifiers", TCL_STATIC);
}
fmtError:
if(dst != staticBuf) {
ckfree(dst);
}
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}