static OSErr
GetFileSpecs(
char *path, /* The path to query. */
FSSpec *pathSpecPtr, /* Filled with information about path. */
FSSpec *dirSpecPtr, /* Filled with information about path's
* parent directory. */
Boolean *pathExistsPtr, /* Set to true if path actually exists,
* false if it doesn't or there was an
* error reading the specified path. */
Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
* otherwise false. */
{
char *dirName;
OSErr err;
int argc;
char **argv;
long d;
Tcl_DString buffer;
*pathExistsPtr = false;
*pathIsDirectoryPtr = false;
Tcl_DStringInit(&buffer);
Tcl_SplitPath(path, &argc, &argv);
if (argc == 1) {
dirName = ":";
} else {
dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
}
err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
Tcl_DStringFree(&buffer);
ckfree((char *) argv);
if (err == noErr) {
err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
if (err == noErr) {
*pathExistsPtr = true;
err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
} else if (err == fnfErr) {
err = noErr;
}
}
return err;
}
int
TkpInit(
Tcl_Interp *interp) /* Interp to initialize. */
{
char *libDir, *tempPath;
Tcl_DString path;
int result;
/*
* The following does not work with
* safe interps because file exists is restricted.
* to be fixed using [interp issafe] like in Unix & Windows.
*/
static char initCmd[] = "\
proc sourcePath {file} {\n\
global tk_library\n\
if {[catch {uplevel #0 [list source $tk_library:$file.tcl]}] == 0} {\n\
return\n\
}\n\
if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
return\n\
}\n\
rename sourcePath {}\n\
set msg \"can't find $file resource or a usable $file.tcl file\"\n\
append msg \" perhaps you need to install Tk or set your \"\n\
append msg \"TK_LIBRARY environment variable?\"\n\
error $msg\n\
}\n\
sourcePath tk\n\
sourcePath button\n\
sourcePath dialog\n\
sourcePath entry\n\
sourcePath focus\n\
sourcePath listbox\n\
sourcePath menu\n\
sourcePath optMenu\n\
sourcePath palette\n\
sourcePath scale\n\
sourcePath scrlbar\n\
sourcePath tearoff\n\
sourcePath text\n\
sourcePath bgerror\n\
sourcePath msgbox\n\
sourcePath comdlg\n\
rename sourcePath {}";
Tcl_DStringInit(&path);
/*
* The tk_library path can be found in several places. Here is the order
* in which the are searched.
* 1) the variable may already exist
* 2) env array
* 3) System Folder:Extensions:Tool Command Language:
*/
libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
if (libDir == NULL) {
libDir = Tcl_GetVar2(interp, "env", "TK_LIBRARY", TCL_GLOBAL_ONLY);
}
if (libDir == NULL) {
tempPath = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
if (tempPath != NULL) {
Tcl_DString libPath;
char *argv[3];
argv[0] = tempPath;
argv[1] = "Tool Command Language";
Tcl_DStringInit(&libPath);
Tcl_DStringAppend(&libPath, "tk", -1);
Tcl_DStringAppend(&libPath, TK_VERSION, -1);
argv[2] = libPath.string;
Tcl_JoinPath(3, argv, &path);
Tcl_DStringFree(&libPath);
libDir = path.string;
}
}
if (libDir == NULL) {
libDir = "no library";
}
/*
* Assign path to the global Tcl variable tcl_library.
*/
Tcl_SetVar(interp, "tk_library", libDir, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
result = Tcl_Eval(interp, initCmd);
return result;
}
/*
*----------------------------------------------------------------------
*
* TkpGetAppName --
*
* Retrieves the name of the current application from a platform
* specific location. On the Macintosh we look to see if the
* App Name is specified in a resource. If not, the application
* name is the root of the tail of the path contained in the tcl
* variable argv0.
*
* Results:
* Returns the application name in the given Tcl_DString.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TkpGetAppName(
Tcl_Interp *interp, /* The main interpreter. */
Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */
{
int argc;
char **argv = NULL, *name, *p;
Handle h = NULL;
h = GetNamedResource('STR ', "\pTk App Name");
if (h != NULL) {
HLock(h);
Tcl_DStringAppend(namePtr, (*h)+1, **h);
HUnlock(h);
ReleaseResource(h);
return;
}
name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
if (name != NULL) {
Tcl_SplitPath(name, &argc, &argv);
if (argc > 0) {
name = argv[argc-1];
p = strrchr(name, '.');
if (p != NULL) {
*p = '\0';
}
} else {
name = NULL;
}
}
if ((name == NULL) || (*name == 0)) {
name = "tk";
}
Tcl_DStringAppend(namePtr, name, -1);
if (argv != NULL) {
ckfree((char *)argv);
}
}
/*
*----------------------------------------------------------------------
*
* TkpDisplayWarning --
*
* This routines is called from Tk_Main to display warning
* messages that occur during startup.
*
* Results:
* None.
*
* Side effects:
* Displays a message box.
*
*----------------------------------------------------------------------
*/
void
TkpDisplayWarning(
char *msg, /* Message to be displayed. */
char *title) /* Title of warning. */
{
Tcl_DString ds;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, title, -1);
Tcl_DStringAppend(&ds, ": ", -1);
Tcl_DStringAppend(&ds, msg, -1);
panic(Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
}
void
TclpInitLibraryPath(
char **valuePtr,
int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
CONST char *str;
Tcl_DString buffer;
pathPtr = Tcl_NewObj();
/*
* Look for the library relative to the TCL_LIBRARY env variable. If the
* last dirname in the TCL_LIBRARY path does not match the last dirname in
* the installLib variable, use the last dir name of installLib in
* addition to the orginal TCL_LIBRARY path.
*/
str = getenv("TCL_LIBRARY"); /* INTL: Native. */
Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
str = Tcl_DStringValue(&buffer);
if ((str != NULL) && (str[0] != '\0')) {
Tcl_DString ds;
int pathc;
CONST char **pathv;
char installLib[LIBRARY_SIZE];
Tcl_DStringInit(&ds);
/*
* Initialize the substrings used when locating an executable. The
* installLib variable computes the path as though the executable is
* installed.
*/
sprintf(installLib, "lib/tcl%s", TCL_VERSION);
/*
* If TCL_LIBRARY is set, search there.
*/
objPtr = Tcl_NewStringObj(str, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_SplitPath(str, &pathc, &pathv);
if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
/*
* If TCL_LIBRARY is set but refers to a different tcl
* installation than the current version, try fiddling with the
* specified directory to make it refer to this installation by
* removing the old "tclX.Y" and substituting the current version
* string.
*/
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
ckfree((char *) pathv);
}
/*
* Finally, look for the library relative to the compiled-in path. This is
* needed when users install Tcl with an exec-prefix that is different
* from the prefix.
*/
{
#ifdef HAVE_COREFOUNDATION
char tclLibPath[MAXPATHLEN + 1];
if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
str = tclLibPath;
} else
#endif /* HAVE_COREFOUNDATION */
{
/*
* TODO: Pull this value from the TIP 59 table.
*/
str = defaultLibraryDir;
}
if (str[0] != '\0') {
objPtr = Tcl_NewStringObj(str, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
}
}
Tcl_DStringFree(&buffer);
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
*valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
static void
AppendEnvironment(
Tcl_Obj *pathPtr,
const char *lib)
{
int pathc;
WCHAR wBuf[MAX_PATH];
char buf[MAX_PATH * TCL_UTF_MAX];
Tcl_Obj *objPtr;
Tcl_DString ds;
const char **pathv;
char *shortlib;
/*
* The shortlib value needs to be the tail component of the lib path. For
* example, "lib/tcl8.4" -> "tcl8.4" while "usr/share/tcl8.5" -> "tcl8.5".
*/
for (shortlib = (char *) &lib[strlen(lib)-1]; shortlib>lib ; shortlib--) {
if (*shortlib == '/') {
if ((unsigned)(shortlib - lib) == strlen(lib) - 1) {
Tcl_Panic("last character in lib cannot be '/'");
}
shortlib++;
break;
}
}
if (shortlib == lib) {
Tcl_Panic("no '/' character found in lib");
}
/*
* The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that
* this is a unicode string.
*/
if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
buf[0] = '\0';
GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
} else {
ToUtf(wBuf, buf);
}
if (buf[0] != '\0') {
objPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
TclWinNoBackslash(buf);
Tcl_SplitPath(buf, &pathc, &pathv);
/*
* The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8
* chars because I know shortlib is ascii.
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
const char *str;
/*
* TCL_LIBRARY is set but refers to a different tcl installation
* than the current version. Try fiddling with the specified
* directory to make it refer to this installation by removing the
* old "tclX.Y" and substituting the current version string.
*/
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
str = Tcl_JoinPath(pathc, pathv, &ds);
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
} else {
objPtr = Tcl_NewStringObj(buf, -1);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
ckfree((char *) pathv);
}
}
static AP_Result tk_new(AP_World *w, AP_Obj interp_name)
{
AP_Result result;
Tcl_Interp *interp;
result = built_interp(w, &interp, &interp_name);
// Similar to 2009 note above, this cause Tk_Init to fail (tk.tcl not found)
#if 0
{
Tcl_DString path;
const char *elements[3];
Tcl_DStringInit(&path);
elements[0] = library_dir;
#ifdef macintosh
elements[1] = "Tool Command Language";
#else
elements[1] = "lib";
#endif
elements[2] = "tk" TK_VERSION;
Tcl_JoinPath(3, elements, &path);
Tcl_SetVar(interp, (char *)"tk_library", path.string, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
}
#endif
if (result == AP_SUCCESS) {
int r = Tk_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
#ifdef ITCL
r = Itk_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
Tcl_StaticPackage(interp, (char *)"Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
r = Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
(char *)"::itk::*", /* allowOverwrite */ 1);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
r = Tcl_Eval(interp, (char *)"auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }");
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
#endif
/*Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);*/
#ifdef macintosh
//TkMacInitAppleEvents(interp);
//TkMacInitMenus(interp);
//Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
#endif
}
return result;
}
static AP_Result built_interp(AP_World *w, Tcl_Interp **interpretor, AP_Obj *interp_name)
{
Tcl_Interp *interp;
char name[128];
const char *namep;
Tcl_HashEntry *entry;
int is_new, pre_named;
AP_Type type;
int r;
type = AP_ObjType(w, *interp_name);
if (type != AP_VARIABLE && type != AP_ATOM) {
AP_SetStandardError(w, AP_TYPE_ERROR,
AP_NewSymbolFromStr(w, "atom_or_variable"), *interp_name);
goto error;
}
pre_named = (type == AP_ATOM);
#ifdef macintosh
// Tcl_MacSetEventProc(MyConvertEvent);
// SIOUXSetEventVector(MyHandleOneEvent);
#endif
interp = Tcl_CreateInterp();
if (!interp) {
AP_SetStandardError(w, AP_RESOURCE_ERROR, AP_NewSymbolFromStr(w, "tcl_memory"));
goto error;
}
/*
The following was causing a coredump on Mac OS X 10.5, and isn't necessary when
using the OS's Tcl/TK. Turned off for the moment.
TODO figure out why this is crashing on 10.5 - CEH 2009
*/
#if 0
{
Tcl_DString path;
const char *elements[3];
Tcl_DStringInit(&path);
elements[0] = library_dir;
#ifdef macintosh
elements[1] = "Tool Command Language";
#else
elements[1] = "lib";
#endif
elements[2] = "tcl" TCL_VERSION;
Tcl_JoinPath(3, (char **)elements, &path);
Tcl_SetVar(interp, (char *)"tcl_library", path.string, TCL_GLOBAL_ONLY);
Tcl_DStringSetLength(&path, 0);
Tcl_JoinPath(2, (char **)elements, &path);
Tcl_SetVar(interp, (char *)"tcl_pkgPath", path.string, TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
Tcl_SetVar(interp, (char *)"autopath", (char *)"", TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
}
#endif
r = Tcl_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
#ifdef ITCL
r = Itcl_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
Tcl_StaticPackage(interp, (char *)"Itcl", Itcl_Init, Itcl_SafeInit);
r = Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
(char *)"::itcl::*", /* allowOverwrite */ 1);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
r = Tcl_Eval(interp,
(char *)"auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }");
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
#endif
if (pre_named) {
namep = AP_GetAtomStr(w, *interp_name);
} else {
interp_count++;
sprintf(name, "tcl_interp%d", interp_count);
/* handle error */
namep = name;
}
entry = Tcl_CreateHashEntry(&tcl_interp_name_table, namep, &is_new);
if (!entry) {
AP_SetStandardError(w, AP_RESOURCE_ERROR, AP_NewSymbolFromStr(w, "tcl_memory"));
goto error_delete;
}
if (!is_new) {
AP_SetStandardError(w, AP_PERMISSION_ERROR,
AP_NewSymbolFromStr(w, "create"),
AP_NewSymbolFromStr(w, "tcl_interpreter"), *interp_name);
goto error_delete;
}
Tcl_SetHashValue(entry, interp);
if (ALSProlog_Package_Init(interp, w) != TCL_OK) {
AP_SetError(w, AP_NewSymbolFromStr(w, "tcl_create_command_error"));
goto error_delete;
}
*interpretor = interp;
return (pre_named) ? AP_SUCCESS : AP_Unify(w, *interp_name, AP_NewUIAFromStr(w, namep));
error_delete:
Tcl_DeleteInterp(interp);
error:
return AP_EXCEPTION;
}
static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
char *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
HANDLE findHandle;
WIN32_FIND_DATA findData;
int pathArgc, i;
char **pathArgv, **newPathArgv;
char *currentElement, *resultStr;
Tcl_DString resultDString;
int result = TCL_OK;
Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
for (i = 0; i < pathArgc; i++) {
if (strcmp(pathArgv[i], ".") == 0) {
currentElement = ckalloc(strlen(".") + 1);
strcpy(currentElement, ".");
} else if (strcmp(pathArgv[i], "..") == 0) {
currentElement = ckalloc(strlen("..") + 1);
strcpy(currentElement, "..");
} else if ((i == 0) && (pathArgv[i][1] == ':')
&& (strlen(pathArgv[i]) == 3)) {
currentElement = ckalloc(4);
strcpy(currentElement, pathArgv[i]);
} else if ((i == 0) && (pathArgv[i][0] == '/')
&& (pathArgv[i][1] == '/')) {
currentElement = ckalloc(strlen(pathArgv[i]) + 1);
strcpy(currentElement, pathArgv[i]);
} else {
int useLong;
Tcl_DStringInit(&resultDString);
resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
findHandle = FindFirstFile(resultStr, &findData);
if (findHandle == INVALID_HANDLE_VALUE) {
pathArgc = i - 1;
AttributesPosixError(interp, objIndex, fileName, 0);
result = TCL_ERROR;
Tcl_DStringFree(&resultDString);
goto cleanup;
}
if (longShort) {
if (findData.cFileName[0] != '\0') {
useLong = 1;
} else {
useLong = 0;
}
} else {
if (findData.cAlternateFileName[0] == '\0') {
useLong = 1;
} else {
useLong = 0;
}
}
if (useLong) {
currentElement = ckalloc(strlen(findData.cFileName) + 1);
strcpy(currentElement, findData.cFileName);
} else {
currentElement = ckalloc(strlen(findData.cAlternateFileName)
+ 1);
strcpy(currentElement, findData.cAlternateFileName);
}
Tcl_DStringFree(&resultDString);
FindClose(findHandle);
}
newPathArgv[i] = currentElement;
}
Tcl_DStringInit(&resultDString);
resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
*attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
Tcl_DStringFree(&resultDString);
cleanup:
for (i = 0; i < pathArgc; i++) {
ckfree(newPathArgv[i]);
}
ckfree((char *) newPathArgv);
return result;
}
static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
CONST char *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
int pathc, i;
char **pathv, **newv;
char *resultStr;
Tcl_DString resultDString;
int result = TCL_OK;
Tcl_SplitPath(fileName, &pathc, &pathv);
newv = (char **) ckalloc(pathc * sizeof(char *));
if (pathc == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not read \"", fileName,
"\": no such file or directory",
(char *) NULL);
result = TCL_ERROR;
goto cleanup;
}
for (i = 0; i < pathc; i++) {
if ((pathv[i][0] == '/')
|| ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))
|| (strcmp(pathv[i], ".") == 0)
|| (strcmp(pathv[i], "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
* copying the string literally. Uppercase the drive letter,
* just because it looks better under Windows to do so.
*/
simple:
pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));
newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);
lstrcpyA(newv[i], pathv[i]);
} else {
char *str;
TCHAR *nativeName;
Tcl_DString ds;
WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
Tcl_DStringInit(&resultDString);
str = Tcl_JoinPath(i + 1, pathv, &resultDString);
nativeName = Tcl_WinUtfToTChar(str, -1, &ds);
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* FindFirstFile() doesn't like root directories. We
* would only get a root directory here if the caller
* specified "c:" or "c:." and the current directory on the
* drive was the root directory
*/
attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
Tcl_DStringFree(&resultDString);
goto simple;
}
}
Tcl_DStringFree(&ds);
Tcl_DStringFree(&resultDString);
if (handle == INVALID_HANDLE_VALUE) {
pathc = i - 1;
StatError(interp, fileName);
result = TCL_ERROR;
goto cleanup;
}
if (tclWinProcs->useWide) {
nativeName = (TCHAR *) data.w.cAlternateFileName;
if (longShort) {
if (data.w.cFileName[0] != '\0') {
nativeName = (TCHAR *) data.w.cFileName;
}
} else {
if (data.w.cAlternateFileName[0] == '\0') {
nativeName = (TCHAR *) data.w.cFileName;
}
}
} else {
nativeName = (TCHAR *) data.a.cAlternateFileName;
if (longShort) {
if (data.a.cFileName[0] != '\0') {
nativeName = (TCHAR *) data.a.cFileName;
}
} else {
if (data.a.cAlternateFileName[0] == '\0') {
nativeName = (TCHAR *) data.a.cFileName;
}
}
}
/*
* Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
* to dereference nativeName as a Unicode string. I have proven
* to myself that purify is wrong by running the following
* example when nativeName == data.w.cAlternateFileName and
* noting that purify doesn't complain about the first line,
* but does complain about the second.
*
* fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
*/
Tcl_WinTCharToUtf(nativeName, -1, &ds);
newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1);
lstrcpyA(newv[i], Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
FindClose(handle);
}
}
Tcl_DStringInit(&resultDString);
resultStr = Tcl_JoinPath(pathc, newv, &resultDString);
*attributePtrPtr = Tcl_NewStringObj(resultStr,
Tcl_DStringLength(&resultDString));
Tcl_DStringFree(&resultDString);
cleanup:
for (i = 0; i < pathc; i++) {
ckfree(newv[i]);
}
ckfree((char *) newv);
ckfree((char *) pathv);
return result;
}