static int
TestfindexecutableCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
CONST char **argv) /* Argument strings. */
{
Tcl_Obj *saveName;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" argv0\"", NULL);
return TCL_ERROR;
}
saveName = TclGetObjNameOfExecutable();
Tcl_IncrRefCount(saveName);
TclpFindExecutable(argv[1]);
Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
TclSetObjNameOfExecutable(saveName, NULL);
Tcl_DecrRefCount(saveName);
return TCL_OK;
}
void
TclpFindExecutable(
const char *argv0) /* The value of the application's argv[0]
* (native). */
{
Tcl_Encoding encoding;
#ifdef __CYGWIN__
int length;
char buf[PATH_MAX * 2];
char name[PATH_MAX * TCL_UTF_MAX + 1];
GetModuleFileNameW(NULL, buf, PATH_MAX);
cygwin_conv_path(3, buf, name, PATH_MAX);
length = strlen(name);
if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
/* Strip '.exe' part. */
length -= 4;
}
encoding = Tcl_GetEncoding(NULL, NULL);
TclSetObjNameOfExecutable(
Tcl_NewStringObj(name, length), encoding);
#else
const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
if (argv0 == NULL) {
return;
}
Tcl_DStringInit(&buffer);
name = argv0;
for (p = name; *p != '\0'; p++) {
if (*p == '/') {
/*
* The name contains a slash, so use the name directly without
* doing a path search.
*/
goto gotName;
}
}
p = getenv("PATH"); /* INTL: Native. */
if (p == NULL) {
/*
* There's no PATH environment variable; use the default that is used
* by sh.
*/
p = ":/bin:/usr/bin";
} else if (*p == '\0') {
/*
* An empty path is equivalent to ".".
*/
p = "./";
}
/*
* Search through all the directories named in the PATH variable to see if
* argv[0] is in one of them. If so, use that file name.
*/
while (1) {
while (TclIsSpaceProc(*p)) {
p++;
}
name = p;
while ((*p != ':') && (*p != 0)) {
p++;
}
TclDStringClear(&buffer);
if (p != name) {
Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
TclDStringAppendLiteral(&buffer, "/");
}
}
name = Tcl_DStringAppend(&buffer, argv0, -1);
/*
* INTL: The following calls to access() and stat() should not be
* converted to Tclp routines because they need to operate on native
* strings directly.
*/
if ((access(name, X_OK) == 0) /* INTL: Native. */
&& (TclOSstat(name, &statBuf) == 0) /* INTL: Native. */
&& S_ISREG(statBuf.st_mode)) {
goto gotName;
}
if (*p == '\0') {
break;
} else if (*(p+1) == 0) {
p = "./";
} else {
p++;
}
}
TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
goto done;
/*
* If the name starts with "/" then just store it
*/
gotName:
#ifdef DJGPP
if (name[1] == ':')
#else
if (name[0] == '/')
#endif
{
encoding = Tcl_GetEncoding(NULL, NULL);
Tcl_ExternalToUtfDString(encoding, name, -1, &utfName);
TclSetObjNameOfExecutable(
Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
Tcl_DStringFree(&utfName);
goto done;
}
if (TclpGetCwd(NULL, &cwd) == NULL) {
TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
goto done;
}
/*
* The name is relative to the current working directory. First strip off
* a leading "./", if any, then add the full path name of the current
* working directory.
*/
if ((name[0] == '.') && (name[1] == '/')) {
name += 2;
}
Tcl_DStringInit(&nameString);
Tcl_DStringAppend(&nameString, name, -1);
Tcl_DStringFree(&buffer);
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &buffer);
if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
TclDStringAppendLiteral(&buffer, "/");
}
Tcl_DStringFree(&cwd);
TclDStringAppendDString(&buffer, &nameString);
Tcl_DStringFree(&nameString);
encoding = Tcl_GetEncoding(NULL, NULL);
Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
&utfName);
TclSetObjNameOfExecutable(
Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
Tcl_DStringFree(&utfName);
done:
Tcl_DStringFree(&buffer);
#endif
}
