diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/tclWinFCmd.c | 268 | ||||
| -rw-r--r-- | win/tclWinFile.c | 443 | ||||
| -rw-r--r-- | win/tclWinInit.c | 91 | ||||
| -rw-r--r-- | win/tclWinPipe.c | 30 |
4 files changed, 623 insertions, 209 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index bf80bf0..230723c 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.8 2000/05/22 23:55:09 hobbs Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.9 2001/07/31 19:12:08 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -103,6 +103,73 @@ static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *errorPtr); +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; +{ + return TclpCreateDirectory(Tcl_FSGetTranslatedPath(NULL, pathPtr)); +} + +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; +{ + return TclpDeleteFile(Tcl_FSGetTranslatedPath(NULL, pathPtr)); +} + +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; +{ + Tcl_DString ds; + int ret; + ret = TclpCopyDirectory(Tcl_FSGetTranslatedPath(NULL,srcPathPtr), + Tcl_FSGetTranslatedPath(NULL,destPathPtr), &ds); + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; +} + +int +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; +{ + return TclpCopyFile(Tcl_FSGetTranslatedPath(NULL,srcPathPtr), + Tcl_FSGetTranslatedPath(NULL,destPathPtr)); +} + +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; +{ + Tcl_DString ds; + int ret; + ret = TclpRemoveDirectory(Tcl_FSGetTranslatedPath(NULL, pathPtr),recursive, &ds); + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; +} + +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; +{ + return TclpRenameFile(Tcl_FSGetTranslatedPath(NULL,srcPathPtr), + Tcl_FSGetTranslatedPath(NULL,destPathPtr)); +} + /* *--------------------------------------------------------------------------- * @@ -1289,6 +1356,106 @@ GetWinFileAttributes( } /* + *--------------------------------------------------------------------------- + * + * TclpNormalizePath -- + * + * This function scans through a path specification and replaces + * it, in place, with a normalized version. On windows this + * means using the 'longname'. + * + * Results: + * The new 'nextCheckpoint' value, giving as far as we could + * understand in the path. + * + * Side effects: + * The pathPtr string, which must contain a valid path, is + * possibly modified in place. + * + *--------------------------------------------------------------------------- + */ + +int +TclpNormalizePath(interp, pathPtr, nextCheckpoint) + Tcl_Interp *interp; + Tcl_DString *pathPtr; + int nextCheckpoint; +{ + char *currentPathEndPosition; + char *lastValidPathEnd = NULL; + char *path = Tcl_DStringValue(pathPtr); + + currentPathEndPosition = path + nextCheckpoint; + + while (1) { + char cur = *currentPathEndPosition; + if (cur == '/' || cur == 0) { + /* Reached directory separator, or end of string */ + Tcl_DString ds; + DWORD attr; + char * nativePath; + nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + Tcl_DStringFree(&ds); + + if (attr == 0xffffffff) { + /* File doesn't exist */ + break; + } + lastValidPathEnd = currentPathEndPosition; + /* File does exist */ + if (cur == 0) { + break; + } + } + currentPathEndPosition++; + } + nextCheckpoint = currentPathEndPosition - path; + if (lastValidPathEnd != NULL) { + /* + * The leading end of the path description was acceptable to + * us. We therefore convert it to its long form, and return + * that. + */ + Tcl_Obj* objPtr = NULL; + int endOfString; + int useLength = lastValidPathEnd - path; + if (*lastValidPathEnd == 0) { + endOfString = 1; + } else { + endOfString = 0; + path[useLength] = 0; + } + /* + * If this returns an error, we have a strange situation; the + * file exists, but we can't get its long name. We will have + * to assume the name we have is ok. + */ + if (ConvertFileNameFormat(interp, 0, path, 1, &objPtr) == TCL_OK) { + /* objPtr now has a refCount of 0 */ + int len; + (void) Tcl_GetStringFromObj(objPtr,&len); + if (!endOfString) { + /* Be nice and fix the string before we clear it */ + path[useLength] = '/'; + Tcl_AppendToObj(objPtr, lastValidPathEnd, -1); + } + nextCheckpoint += (len - useLength); + Tcl_DStringSetLength(pathPtr,0); + path = Tcl_GetStringFromObj(objPtr,&len); + Tcl_DStringAppend(pathPtr,path,len); + /* Free up the objPtr */ + Tcl_DecrRefCount(objPtr); + } else { + if (!endOfString) { + path[useLength] = '/'; + } + } + } + return nextCheckpoint; +} + +/* *---------------------------------------------------------------------- * * ConvertFileNameFormat -- @@ -1449,7 +1616,7 @@ cleanup: * * GetWinFileLongName -- * - * Returns a Tcl_Obj containing the short version of the file + * Returns a Tcl_Obj containing the long version of the file * name. * * Results: @@ -1662,3 +1829,100 @@ TclpListVolumes( } return TCL_OK; } + +/* + *--------------------------------------------------------------------------- + * + * TclpObjNormalizePath -- + * + * This function scans through a path specification and replaces + * it, in place, with a normalized version. On windows this + * means using the 'longname'. + * + * Results: + * The new 'nextCheckpoint' value, giving as far as we could + * understand in the path. + * + * Side effects: + * The pathPtr string, which must contain a valid path, is + * possibly modified in place. + * + *--------------------------------------------------------------------------- + */ + +int +TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) + Tcl_Interp *interp; + Tcl_Obj *pathPtr; + int nextCheckpoint; +{ + char *currentPathEndPosition; + char *lastValidPathEnd = NULL; + char *path = Tcl_GetString(pathPtr); + + currentPathEndPosition = path + nextCheckpoint; + + while (1) { + char cur = *currentPathEndPosition; + if (cur == '/' || cur == 0) { + /* Reached directory separator, or end of string */ + Tcl_DString ds; + DWORD attr; + char * nativePath; + nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + Tcl_DStringFree(&ds); + + if (attr == 0xffffffff) { + /* File doesn't exist */ + break; + } + lastValidPathEnd = currentPathEndPosition; + /* File does exist */ + if (cur == 0) { + break; + } + } + currentPathEndPosition++; + } + nextCheckpoint = currentPathEndPosition - path; + if (lastValidPathEnd != NULL) { + /* + * The leading end of the path description was acceptable to + * us. We therefore convert it to its long form, and return + * that. + */ + Tcl_Obj* objPtr = NULL; + int endOfString; + int useLength = lastValidPathEnd - path; + if (*lastValidPathEnd == 0) { + endOfString = 1; + } else { + endOfString = 0; + path[useLength] = 0; + } + /* + * If this returns an error, we have a strange situation; the + * file exists, but we can't get its long name. We will have + * to assume the name we have is ok. + */ + if (ConvertFileNameFormat(interp, 0, path, 1, &objPtr) == TCL_OK) { + int len; + (void) Tcl_GetStringFromObj(objPtr,&len); + if (!endOfString) { + /* Be nice and fix the string before we clear it */ + path[useLength] = '/'; + Tcl_AppendToObj(objPtr, lastValidPathEnd, -1); + } + nextCheckpoint += (len - useLength); + path = Tcl_GetStringFromObj(objPtr,&len); + Tcl_SetStringObj(pathPtr,path, len); + Tcl_DecrRefCount(objPtr); + } else { + if (!endOfString) { + path[useLength] = '/'; + } + } + } + return nextCheckpoint; +} diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 1038758..c40a0b8 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.10 2001/07/17 19:40:37 mdejong Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.11 2001/07/31 19:12:08 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -89,17 +89,16 @@ TclpFindExecutable(argv0) /* *---------------------------------------------------------------------- * - * TclpMatchFilesTypes -- + * TclpMatchInDirectory -- * * This routine is used by the globbing code to search a * directory for all files which match a given pattern. * * Results: - * If the tail argument is NULL, then the matching files are - * added to the the interp's result. Otherwise, TclDoGlob is called - * recursively for each matching subdirectory. The return value - * is a standard Tcl result indicating whether an error occurred - * in globbing. + * + * The return value is a standard Tcl result indicating whether an + * error occurred in globbing. Errors are left in interp, good + * results are lappended to resultPtr (which must be a valid object) * * Side effects: * None. @@ -107,54 +106,63 @@ TclpFindExecutable(argv0) *---------------------------------------------------------------------- */ int -TclpMatchFilesTypes( - Tcl_Interp *interp, /* Interpreter to receive results. */ - char *separators, /* Directory separators to pass to TclDoGlob. */ - Tcl_DString *dirPtr, /* Contains path to directory to search. */ - char *pattern, /* Pattern to match against. */ - char *tail, /* Pointer to end of pattern. Tail must - * point to a location in pattern and must - * not be static.*/ - GlobTypeData *types) /* Object containing list of acceptable types. - * May be NULL. */ +TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) + Tcl_Interp *interp; /* Interpreter to receive errors. */ + Tcl_Obj *resultPtr; /* List object to lappend results. */ + Tcl_Obj *pathPtr; /* Contains path to directory to search. */ + char *pattern; /* Pattern to match against. */ + Tcl_GlobTypeData *types; /* Object containing list of acceptable types. + * May be NULL. In particular the directory + * flag is very important. */ { char drivePat[] = "?:\\"; const char *message; - char *dir, *newPattern, *root; - int matchDotFiles; - int dirLength, result = TCL_OK; - Tcl_DString dirString, patternString; + char *dir, *root; + int dirLength; + Tcl_DString dirString; DWORD attr, volFlags; HANDLE handle; WIN32_FIND_DATAT data; BOOL found; Tcl_DString ds; + Tcl_DString dsOrig; + char *fileName; TCHAR *nativeName; - Tcl_Obj *resultPtr; - + int matchSpecialDots; + /* * Convert the path to normalized form since some interfaces only * accept backslashes. Also, ensure that the directory ends with a * separator character. */ - dirLength = Tcl_DStringLength(dirPtr); + fileName = Tcl_FSGetTranslatedPath(interp, pathPtr); + if (fileName == NULL) { + return TCL_ERROR; + } + Tcl_DStringInit(&dsOrig); + Tcl_DStringAppend(&dsOrig, fileName, -1); + + dirLength = Tcl_DStringLength(&dsOrig); Tcl_DStringInit(&dirString); if (dirLength == 0) { Tcl_DStringAppend(&dirString, ".\\", 2); } else { char *p; - Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr), - Tcl_DStringLength(dirPtr)); + Tcl_DStringAppend(&dirString, Tcl_DStringValue(&dsOrig), + Tcl_DStringLength(&dsOrig)); 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++; } } dir = Tcl_DStringValue(&dirString); @@ -220,14 +228,20 @@ TclpMatchFilesTypes( } /* - * In Windows, although some volumes may support case sensitivity, Windows - * doesn't honor case. So in globbing we need to ignore the case - * of file names. + * Check to see if the pattern should match the special + * . and .. names, referring to the current directory, + * or the directory above. We need a special check for + * this because paths beginning with a dot are not considered + * hidden on Windows, and so otherwise a relative glob like + * 'glob -join * *' will actually return './. ../..' etc. */ - Tcl_DStringInit(&patternString); - newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern); - Tcl_UtfToLower(newPattern); + if ((pattern[0] == '.') + || ((pattern[0] == '\\') && (pattern[1] == '.'))) { + matchSpecialDots = 1; + } else { + matchSpecialDots = 0; + } /* * We need to check all files in the directory, so append a *.* @@ -245,39 +259,14 @@ TclpMatchFilesTypes( } /* - * Clean up the tail pointer. Leave the tail pointing to the - * first character after the path separator or NULL. - */ - - if (*tail == '\\') { - tail++; - } - if (*tail == '\0') { - tail = NULL; - } else { - tail++; - } - - /* - * Check to see if the pattern needs to compare with dot files. - */ - - if ((newPattern[0] == '.') - || ((pattern[0] == '\\') && (pattern[1] == '.'))) { - matchDotFiles = 1; - } else { - matchDotFiles = 0; - } - - /* * Now iterate over all of the files in the directory. */ - resultPtr = Tcl_GetObjResult(interp); for (found = 1; found != 0; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { TCHAR *nativeMatchResult; char *name, *fname; + int typeOk = 1; if (tclWinProcs->useWide) { nativeName = (TCHAR *) data.w.cFileName; @@ -286,9 +275,17 @@ TclpMatchFilesTypes( } name = Tcl_WinTCharToUtf(nativeName, -1, &ds); + if (!matchSpecialDots) { + /* If it is exactly '.' or '..' then we ignore it */ + if (name[0] == '.') { + if (name[1] == '\0' || (name[1] == '.' && name[2] == '\0')) { + continue; + } + } + } + /* - * Check to see if the file matches the pattern. We need to convert - * the file name to lower case for comparison purposes. Note that we + * Check to see if the file matches the pattern. Note that we * are ignoring the case sensitivity flag because Windows doesn't honor * case even if the volume is case sensitive. If the volume also * doesn't preserve case, then we previously returned the lower case @@ -297,14 +294,9 @@ TclpMatchFilesTypes( * we are returning exactly what we get from the system. */ - Tcl_UtfToLower(name); nativeMatchResult = NULL; - if ((matchDotFiles == 0) && (name[0] == '.')) { - /* - * Ignore hidden files. - */ - } else if (Tcl_StringMatch(name, newPattern) != 0) { + if (Tcl_StringCaseMatch(name, pattern, 1) != 0) { nativeMatchResult = nativeName; } Tcl_DStringFree(&ds); @@ -315,96 +307,98 @@ TclpMatchFilesTypes( /* * If the file matches, then we need to process the remainder of the - * path. If there are more characters to process, then ensure matching - * files are directories and call TclDoGlob. Otherwise, just add the - * file to the result. + * path. */ name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds); - Tcl_DStringAppend(dirPtr, name, -1); + Tcl_DStringAppend(&dsOrig, name, -1); Tcl_DStringFree(&ds); - fname = Tcl_DStringValue(dirPtr); - nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds); + fname = Tcl_DStringValue(&dsOrig); + nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig), &ds); /* * 'attr' represents the attributes of the file, but we only * want to retrieve this info if it is absolutely necessary - * because it is an expensive call. + * because it is an expensive call. Unfortunately, to deal + * with hidden files properly, we must always retrieve it. + * There are more modern Win32 APIs available which we should + * look into. */ - attr = 0; - - if (tail == NULL) { - int typeOk = 1; - if (types != NULL) { - if (types->perm != 0) { - attr = (*tclWinProcs->getFileAttributesProc)(nativeName); - if ( - ((types->perm & TCL_GLOB_PERM_RONLY) && - !(attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_HIDDEN) && - !(attr & FILE_ATTRIBUTE_HIDDEN)) || - ((types->perm & TCL_GLOB_PERM_R) && - (TclpAccess(fname, R_OK) != 0)) || - ((types->perm & TCL_GLOB_PERM_W) && - (TclpAccess(fname, W_OK) != 0)) || - ((types->perm & TCL_GLOB_PERM_X) && - (TclpAccess(fname, X_OK) != 0)) - ) { - typeOk = 0; - } + attr = (*tclWinProcs->getFileAttributesProc)(nativeName); + if (types == NULL) { + /* If invisible, don't return the file */ + if (attr & FILE_ATTRIBUTE_HIDDEN) { + typeOk = 0; + } + } else { + if (attr & FILE_ATTRIBUTE_HIDDEN) { + /* If invisible */ + if ((types->perm == 0) || + !(types->perm & TCL_GLOB_PERM_HIDDEN)) { + typeOk = 0; + } + } else { + /* Visible */ + if (types->perm & TCL_GLOB_PERM_HIDDEN) { + typeOk = 0; } - if (typeOk && types->type != 0) { - struct stat buf; + } + if (typeOk == 1 && types->perm != 0) { + if ( + ((types->perm & TCL_GLOB_PERM_RONLY) && + !(attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_R) && + (TclpAccess(fname, R_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_W) && + (TclpAccess(fname, W_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_X) && + (TclpAccess(fname, X_OK) != 0)) + ) { + typeOk = 0; + } + } + if (typeOk && types->type != 0) { + struct stat buf; + /* + * We must match at least one flag to be listed + */ + typeOk = 0; + if (TclpLstat(fname, &buf) >= 0) { /* - * We must match at least one flag to be listed + * In order bcdpfls as in 'find -t' */ - typeOk = 0; - if (TclpLstat(fname, &buf) >= 0) { - /* - * In order bcdpfls as in 'find -t' - */ - if ( - ((types->type & TCL_GLOB_TYPE_BLOCK) && - S_ISBLK(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_CHAR) && - S_ISCHR(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_DIR) && - S_ISDIR(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_PIPE) && - S_ISFIFO(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_FILE) && - S_ISREG(buf.st_mode)) + if ( + ((types->type & TCL_GLOB_TYPE_BLOCK) && + S_ISBLK(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_CHAR) && + S_ISCHR(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_DIR) && + S_ISDIR(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_PIPE) && + S_ISFIFO(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_FILE) && + S_ISREG(buf.st_mode)) #ifdef S_ISLNK - || ((types->type & TCL_GLOB_TYPE_LINK) && - S_ISLNK(buf.st_mode)) + || ((types->type & TCL_GLOB_TYPE_LINK) && + S_ISLNK(buf.st_mode)) #endif #ifdef S_ISSOCK - || ((types->type & TCL_GLOB_TYPE_SOCK) && - S_ISSOCK(buf.st_mode)) + || ((types->type & TCL_GLOB_TYPE_SOCK) && + S_ISSOCK(buf.st_mode)) #endif - ) { - typeOk = 1; - } - } else { - /* Posix error occurred */ + ) { + typeOk = 1; } - } - } - if (typeOk) { - Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr))); - } - } else { - attr = (*tclWinProcs->getFileAttributesProc)(nativeName); - if (attr & FILE_ATTRIBUTE_DIRECTORY) { - Tcl_DStringAppend(dirPtr, "/", 1); - result = TclDoGlob(interp, separators, dirPtr, tail, types); - if (result != TCL_OK) { - break; + } else { + /* Posix error occurred */ } - } + } + } + if (typeOk) { + Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig))); } /* * Free ds here to ensure that nativeName is valid above. @@ -412,43 +406,25 @@ TclpMatchFilesTypes( Tcl_DStringFree(&ds); - Tcl_DStringSetLength(dirPtr, dirLength); + Tcl_DStringSetLength(&dsOrig, dirLength); } FindClose(handle); Tcl_DStringFree(&dirString); - Tcl_DStringFree(&patternString); + Tcl_DStringFree(&dsOrig); - return result; + return TCL_OK; error: Tcl_DStringFree(&dirString); TclWinConvertError(GetLastError()); Tcl_ResetResult(interp); - Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ", + Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_DStringFree(&dsOrig); return TCL_ERROR; } -/* - * TclpMatchFiles -- - * - * This function is now obsolete. Call the above function - * 'TclpMatchFilesTypes' instead. - */ -int -TclpMatchFiles( - Tcl_Interp *interp, /* Interpreter to receive results. */ - char *separators, /* Directory separators to pass to TclDoGlob. */ - Tcl_DString *dirPtr, /* Contains path to directory to search. */ - char *pattern, /* Pattern to match against. */ - char *tail) /* Pointer to end of pattern. Tail must - * point to a location in pattern and must - * not be static.*/ -{ - return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL); -} - /* *---------------------------------------------------------------------- * @@ -573,6 +549,7 @@ TclpGetUserHome(name, bufferPtr) return result; } + /* *--------------------------------------------------------------------------- @@ -813,7 +790,7 @@ TclpGetCwd(interp, bufferPtr) /* *---------------------------------------------------------------------- * - * TclpStat -- + * TclpObjStat -- * * This function replaces the library version of stat(), fixing * the following bugs: @@ -833,10 +810,10 @@ TclpGetCwd(interp, bufferPtr) *---------------------------------------------------------------------- */ -int -TclpStat(path, statPtr) - CONST char *path; /* Path of file to stat (UTF-8). */ - struct stat *statPtr; /* Filled with results of stat call. */ +int +TclpObjStat(pathPtr, statPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + struct stat *statPtr; /* Filled with results of stat call. */ { Tcl_DString ds; TCHAR *nativePath; @@ -853,12 +830,12 @@ TclpStat(path, statPtr) * call to FindFirstFile() will expand them, matching some other file. */ - if (strpbrk(path, "?*") != NULL) { + if (strpbrk(Tcl_FSGetTranslatedPath(NULL, pathPtr), "?*") != NULL) { Tcl_SetErrno(ENOENT); return -1; } - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); if (handle == INVALID_HANDLE_VALUE) { /* @@ -868,7 +845,6 @@ TclpStat(path, statPtr) attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr == 0xffffffff) { - Tcl_DStringFree(&ds); Tcl_SetErrno(ENOENT); return -1; } @@ -887,7 +863,6 @@ TclpStat(path, statPtr) (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, &nativePart); - Tcl_DStringFree(&ds); fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); dev = -1; @@ -932,7 +907,7 @@ TclpStat(path, statPtr) attr = data.a.dwFileAttributes; mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; - p = strrchr(path, '.'); + p = strrchr(Tcl_FSGetTranslatedPath(NULL, pathPtr), '.'); if (p != NULL) { if ((lstrcmpiA(p, ".exe") == 0) || (lstrcmpiA(p, ".com") == 0) @@ -1093,3 +1068,133 @@ TclWinResolveShortcut(bufferPtr) return 0; } #endif + +Tcl_Obj* +TclpObjGetCwd(interp) + Tcl_Interp *interp; +{ + Tcl_DString ds; + if (TclpGetCwd(interp, &ds) != NULL) { + Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(cwdPtr); + Tcl_DStringFree(&ds); + return cwdPtr; + } else { + return NULL; + } +} + +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; +{ + int result; + TCHAR *nativePath; + + nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); + result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); + + if (result == 0) { + TclWinConvertError(GetLastError()); + return -1; + } + return 0; +} + +int +TclpObjAccess(pathPtr, mode) + Tcl_Obj *pathPtr; + int mode; +{ + TCHAR *nativePath; + DWORD attr; + + nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + + if (attr == 0xffffffff) { + /* + * File doesn't exist. + */ + + TclWinConvertError(GetLastError()); + return -1; + } + + if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { + /* + * File is not writable. + */ + + Tcl_SetErrno(EACCES); + return -1; + } + + if (mode & X_OK) { + CONST char *p; + + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + /* + * Directories are always executable. + */ + + return 0; + } + p = strrchr(Tcl_FSGetTranslatedPath(NULL, pathPtr), '.'); + if (p != NULL) { + p++; + if ((stricmp(p, "exe") == 0) + || (stricmp(p, "com") == 0) + || (stricmp(p, "bat") == 0)) { + /* + * File that ends with .exe, .com, or .bat is executable. + */ + + return 0; + } + } + Tcl_SetErrno(EACCES); + return -1; + } + + return 0; +} + +int +TclpObjLstat(pathPtr, buf) + Tcl_Obj *pathPtr; + struct stat *buf; { + return TclpObjStat(pathPtr,buf); +} + +#ifdef S_IFLNK + +Tcl_Obj* +TclpObjReadlink(pathPtr) + Tcl_Obj *pathPtr; +{ + Tcl_DString ds; + Tcl_Obj* link = NULL; + if (TclpReadlink(Tcl_FSGetTranslatedPath(NULL, pathPtr), &ds) != NULL) { + link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(link); + Tcl_DStringFree(&ds); + } + return link; +} + +#endif + +/* Obsolete, only called from test suite */ +int +TclpStat(path, statPtr) + CONST char *path; /* Path of file to stat (UTF-8). */ + struct stat *statPtr; /* Filled with results of stat call. */ +{ + int retVal; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); + Tcl_IncrRefCount(pathPtr); + retVal = TclpObjStat(pathPtr, statPtr); + Tcl_DecrRefCount(pathPtr); + return retVal; +} diff --git a/win/tclWinInit.c b/win/tclWinInit.c index d657784..a1eb02a 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.26 2001/07/02 20:57:02 dgp Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.27 2001/07/31 19:12:08 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -72,6 +72,11 @@ static char* processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc" }; +/* Used to store the encoding used for binary files */ +static Tcl_Encoding binaryEncoding = NULL; +/* Has the basic library path encoding issue been fixed */ +static int libraryPathEncodingFixed = 0; + /* * The Init script (common to Windows and Unix platforms) is * defined in tkInitScript.h @@ -462,13 +467,18 @@ ToUtf( * Based on the locale, determine the encoding of the operating * system and the default encoding for newly opened files. * - * Called at process initialization time. + * Called at process initialization time, and part way through + * startup, we verify that the initial encodings were correctly + * setup. Depending on Tcl's environment, there may not have been + * enough information first time through (above). * * Results: * None. * * Side effects: - * The Tcl library path is converted from native encoding to UTF-8. + * The Tcl library path is converted from native encoding to UTF-8, + * on the first call, and the encodings may be changed on first or + * second call. * *--------------------------------------------------------------------------- */ @@ -478,45 +488,52 @@ TclpSetInitialEncodings() { CONST char *encoding; char buf[4 + TCL_INTEGER_SPACE]; - int platformId; - Tcl_Obj *pathPtr; - - platformId = TclWinGetPlatformId(); - - TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT); - wsprintfA(buf, "cp%d", GetACP()); - Tcl_SetSystemEncoding(NULL, buf); - - if (platformId != VER_PLATFORM_WIN32_NT) { - pathPtr = TclGetLibraryPath(); - if (pathPtr != NULL) { - int i, objc; - Tcl_Obj **objv; - - objc = 0; - Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); - for (i = 0; i < objc; i++) { - int length; - char *string; - Tcl_DString ds; - - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_ExternalToUtfDString(NULL, string, length, &ds); - Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + if (libraryPathEncodingFixed == 0) { + int platformId; + platformId = TclWinGetPlatformId(); + TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT); + + wsprintfA(buf, "cp%d", GetACP()); + Tcl_SetSystemEncoding(NULL, buf); + + if (platformId != VER_PLATFORM_WIN32_NT) { + Tcl_Obj *pathPtr = TclGetLibraryPath(); + if (pathPtr != NULL) { + int i, objc; + Tcl_Obj **objv; + + objc = 0; + Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); + for (i = 0; i < objc; i++) { + int length; + char *string; + Tcl_DString ds; + + string = Tcl_GetStringFromObj(objv[i], &length); + Tcl_ExternalToUtfDString(NULL, string, length, &ds); + Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + } } } + + libraryPathEncodingFixed = 1; + } else { + wsprintfA(buf, "cp%d", GetACP()); + Tcl_SetSystemEncoding(NULL, buf); } - /* - * Keep this encoding preloaded. The IO package uses it for gets on a - * binary channel. - */ - - encoding = "iso8859-1"; - Tcl_GetEncoding(NULL, encoding); + /* This is only ever called from the startup thread */ + if (binaryEncoding == NULL) { + /* + * Keep this encoding preloaded. The IO package uses it for + * gets on a binary channel. + */ + encoding = "iso8859-1"; + binaryEncoding = Tcl_GetEncoding(NULL, encoding); + } } /* diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 00635cf..432d956 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.17 2001/07/17 01:45:30 hobbs Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.18 2001/07/31 19:12:08 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -767,6 +767,34 @@ TclpCreateTempFile(contents) /* *---------------------------------------------------------------------- * + * TclpTempFileName -- + * + * This function returns a unique filename. + * + * Results: + * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj* +TclpTempFileName() +{ + WCHAR fileName[MAX_PATH]; + + if (TempFileName(fileName) == 0) { + return NULL; + } + + return TclpNativeToNormalized((ClientData) fileName); +} + +/* + *---------------------------------------------------------------------- + * * TclpCreatePipe -- * * Creates an anonymous pipe. |