Attachment "winsearch.patch" to
ticket [1c6f6503d4]
added by
danckaert
2017-05-24 07:34:33.
diff --git a/library/init.tcl b/library/init.tcl
index a202054..9630cb0 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -633,13 +633,6 @@ proc auto_execok name {
set shellBuiltins [list cls copy date del dir echo erase md mkdir \
mklink rd ren rename rmdir start time type ver vol]
- if {[info exists env(PATHEXT)]} {
- # Add an initial ; to have the {} extension check first.
- set execExtensions [split ";$env(PATHEXT)" ";"]
- } else {
- set execExtensions [list {} .com .exe .bat .cmd]
- }
-
if {[string tolower $name] in $shellBuiltins} {
# When this is command.com for some reason on Win2K, Tcl won't
# exec it unless the case is right, which this corrects. COMSPEC
@@ -651,48 +644,13 @@ proc auto_execok name {
return [set auto_execs($name) [list $cmd /c $name]]
}
- if {[llength [file split $name]] != 1} {
- foreach ext $execExtensions {
- set file ${name}${ext}
- if {[file exists $file] && ![file isdirectory $file]} {
- return [set auto_execs($name) [list $file]]
- }
- }
- return ""
- }
-
- set path "[file dirname [info nameof]];.;"
- if {[info exists env(WINDIR)]} {
- set windir $env(WINDIR)
- }
- if {[info exists windir]} {
- if {$tcl_platform(os) eq "Windows NT"} {
- append path "$windir/system32;"
- }
- append path "$windir/system;$windir;"
+ try {
+ tcl::winsearchpath $name
+ } on error {} {
+ return ""
+ } on ok {result} {
+ return [set auto_execs($name) [list [file join $result]]]
}
-
- foreach var {PATH Path path} {
- if {[info exists env($var)]} {
- append path ";$env($var)"
- }
- }
-
- foreach ext $execExtensions {
- unset -nocomplain checked
- foreach dir [split $path {;}] {
- # Skip already checked directories
- if {[info exists checked($dir)] || ($dir eq "")} {
- continue
- }
- set checked($dir) {}
- set file [file join $dir ${name}${ext}]
- if {[file exists $file] && ![file isdirectory $file]} {
- return [set auto_execs($name) [list $file]]
- }
- }
- }
- return ""
}
} else {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 98c7ed5..b461b01 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -640,6 +640,12 @@ TclpSetVariables(
*/
Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
+
+ /*
+ * Create helper function for [auto_execok].
+ */
+ Tcl_CreateObjCommand(interp, "::tcl::winsearchpath", TclWinSearchPathObjCmd,
+ NULL, NULL);
}
/*
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 43799d0..7624af3 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -82,6 +82,9 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
MODULE_SCOPE int TclWinSymLinkDelete(const TCHAR *LinkOriginal,
int linkOnly);
MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *);
+MODULE_SCOPE int TclWinSearchPathObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
MODULE_SCOPE void TclWinFreeAllocCache(void);
MODULE_SCOPE void TclFreeAllocCache(void *);
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 5246d53..ac08653 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1236,6 +1236,48 @@ HasConsole(void)
/*
*--------------------------------------------------------------------
*
+ * TclWinSearchPathObjCmd --
+ *
+ * Search for the specified program and return the full pathname.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int TclWinSearchPathObjCmd(ClientData cd,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int code;
+ char path[MAX_PATH * TCL_UTF_MAX];
+ char* name;
+ Tcl_DString buffer;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&buffer);
+ name = Tcl_TranslateFileName(interp, Tcl_GetString(objv[1]), &buffer);
+ if (name == NULL) {
+ code = TCL_ERROR;
+ } else if (ApplicationType(interp, name, path) == APPL_NONE) {
+ code = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(path, -1));
+ code = TCL_OK;
+ }
+ Tcl_DStringFree(&buffer);
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
* ApplicationType --
*
* Search for the specified program and identify if it refers to a DOS,