diff options
author | hobbs <hobbs@noemail.net> | 2003-05-16 01:42:59 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 2003-05-16 01:42:59 (GMT) |
commit | 644c5f25eaa01a96cab8a660e344de57be101b07 (patch) | |
tree | 9937e095207c652f1d4dbf10d30a916106a50f8b /win/tclWinFile.c | |
parent | 613c2eac36dc830a257373aad71b1e0e7dacda62 (diff) | |
download | tcl-644c5f25eaa01a96cab8a660e344de57be101b07.zip tcl-644c5f25eaa01a96cab8a660e344de57be101b07.tar.gz tcl-644c5f25eaa01a96cab8a660e344de57be101b07.tar.bz2 |
* win/tclWinFile.c (TclpMatchInDirectory): revert glob code to
r1.44 as 2003-04-14 optimizations broke Windows98 glob'ing.
FossilOrigin-Name: 68140ba47d9e00ff8ecdd5a86263caa2b7a21527
Diffstat (limited to 'win/tclWinFile.c')
-rw-r--r-- | win/tclWinFile.c | 117 |
1 files changed, 46 insertions, 71 deletions
diff --git a/win/tclWinFile.c b/win/tclWinFile.c index d120742..96ebbb2 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.3 2003/04/14 22:55:12 kennykb Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.4 2003/05/16 01:43:01 hobbs Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -775,97 +775,77 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) DWORD attr; HANDLE handle; WIN32_FIND_DATAT data; - CONST char *dirName; /* utf-8 dir name, later - * with pattern appended */ + CONST char *dirName; int dirLength; int matchSpecialDots; - Tcl_DString ds; /* native encoding of dir, also used - * temporarily for other things. */ + Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ + Tcl_DString dirString; /* utf-8 encoding of dir with \'s */ Tcl_Obj *fileNamePtr; - char lastChar; /* - * Get the normalized path representation - * (the main thing is we dont want any '~' sequences). + * Convert the path to normalized form since some interfaces only + * accept backslashes. Also, ensure that the directory ends with a + * separator character. */ - fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr); + fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } + Tcl_DStringInit(&dsOrig); + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + Tcl_DStringAppend(&dsOrig, dirName, dirLength); + + Tcl_DStringInit(&dirString); + if (dirLength == 0) { + Tcl_DStringAppend(&dirString, ".\\", 2); + } else { + char *p; + + Tcl_DStringAppend(&dirString, dirName, dirLength); + for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { + if (*p == '/') { + *p = '\\'; + } + } + p--; + /* Make sure we have a trailing directory delimiter */ + if ((*p != '\\') && (*p != ':')) { + Tcl_DStringAppend(&dirString, "\\", 1); + Tcl_DStringAppend(&dsOrig, "/", 1); + dirLength++; + } + } + dirName = Tcl_DStringValue(&dirString); /* - * Verify that the specified path exists and - * is actually a directory. + * First verify that the specified path is actually a directory. */ - native = Tcl_FSGetNativePath(pathPtr); - if (native == NULL) { - return TCL_OK; - } + + native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString), + &ds); attr = (*tclWinProcs->getFileAttributesProc)(native); + Tcl_DStringFree(&ds); if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { + Tcl_DStringFree(&dirString); return TCL_OK; } - /* - * Build up the directory name for searching, including - * a trailing directory separator. - */ - - Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); - Tcl_DStringAppend(&dsOrig, dirName, dirLength); - - lastChar = dirName[dirLength -1]; - if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { - Tcl_DStringAppend(&dsOrig, "/", 1); - dirLength++; - } - dirName = Tcl_DStringValue(&dsOrig); - /* - * We need to check all files in the directory, so we append - * '*.*' to the path, unless the pattern we've been given is - * rather simple, when we can use that instead. + * We need to check all files in the directory, so append a *.* + * to the path. */ - if (strpbrk(pattern, "[]\\") == NULL) { - /* - * The pattern is a simple one containing just '*' and/or '?'. - * This means we can get the OS to help us, by passing - * it the pattern. - */ - dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); - } else { - dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); - } + dirName = Tcl_DStringAppend(&dirString, "*.*", 3); native = Tcl_WinUtfToTChar(dirName, -1, &ds); - if (tclWinProcs->findFirstFileExProc == NULL - || (types == NULL) - || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = (*tclWinProcs->findFirstFileProc)(native, &data); - } else { - /* We can be more efficient, for pure directory requests */ - handle = (*tclWinProcs->findFirstFileExProc)(native, - FindExInfoStandard, &data, - FindExSearchLimitToDirectories, NULL, 0); - } + handle = (*tclWinProcs->findFirstFileProc)(native, &data); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { - DWORD err = GetLastError(); - if (err == ERROR_FILE_NOT_FOUND) { - /* - * We used our 'pattern' above, and matched nothing - * This means we just return TCL_OK, indicating - * no results found. - */ - Tcl_DStringFree(&dsOrig); - return TCL_OK; - } - TclWinConvertError(err); + Tcl_DStringFree(&dirString); + TclWinConvertError(GetLastError()); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read directory \"", Tcl_DStringValue(&dsOrig), "\": ", @@ -874,12 +854,6 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) return TCL_ERROR; } - /* - * We may use this later, so we must restore it to its - * length including the directory delimiter - */ - Tcl_DStringSetLength(&dsOrig, dirLength); - /* * Check to see if the pattern should match the special * . and .. names, referring to the current directory, @@ -973,6 +947,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); FindClose(handle); + Tcl_DStringFree(&dirString); Tcl_DStringFree(&dsOrig); return TCL_OK; } |