summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/tclWinFCmd.c268
-rw-r--r--win/tclWinFile.c443
-rw-r--r--win/tclWinInit.c91
-rw-r--r--win/tclWinPipe.c30
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.